src/shared/utils.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE a_modes.inc}
  17 unit utils;
  18
  19 interface
  20
  21 uses
  22   SysUtils, Classes;
  23
  24
  25 // ////////////////////////////////////////////////////////////////////////// //
  26 type
  27   TUtf8DecoderFast = packed record
  28   public
  29     const Replacement = $FFFD; // replacement char for invalid unicode
  30     const Accept = 0;
  31     const Reject = 12;
  32
  33   private
  34     state: LongWord;
  35
  36   public
  37     codepoint: LongWord; // decoded codepoint (valid only when decoder is in "complete" state)
  38
  39   public
  40     constructor Create (v: Boolean{fuck you, fpc});
  41
  42     procedure reset (); inline;
  43
  44     function complete (): Boolean; inline; // is current character complete? take `codepoint` then
  45     function invalid (): Boolean; inline;
  46     function completeOrInvalid (): Boolean; inline;
  47
  48     // process one byte, return `true` if codepoint is ready
  49     function decode (b: Byte): Boolean; inline; overload;
  50     function decode (c: AnsiChar): Boolean; inline; overload;
  51   end;
  52
  53
  54 // ////////////////////////////////////////////////////////////////////////// //
  55 function getFilenameExt (const fn: AnsiString): AnsiString;
  56 function setFilenameExt (const fn, ext: AnsiString): AnsiString;
  57 function forceFilenameExt (const fn, ext: AnsiString): AnsiString;
  58
  59 // strips out name from `fn`, leaving trailing slash
  60 function getFilenamePath (const fn: AnsiString): AnsiString;
  61
  62 // ends with '/' or '\'?
  63 function isFilenamePath (const fn: AnsiString): Boolean;
  64
  65 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
  66 // will add slash to `path`, even if `fn` is empty!
  67 function filenameConcat (const path, fn: AnsiString): AnsiString;
  68
  69 // does filename have one of ".wad", ".pk3", ".zip" extensions?
  70 function hasWadExtension (const fn: AnsiString): Boolean;
  71
  72 // does filepath have ".XXX:\" in it?
  73 function isWadPath (const fn: AnsiString): Boolean;
  74
  75 // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip"
  76 function addWadExtension (const fn: AnsiString): AnsiString;
  77
  78 // convert number to strig with nice commas
  79 function Int64ToStrComma (i: Int64): AnsiString;
  80
  81 function UpCase1251 (ch: Char): Char;
  82 function LoCase1251 (ch: Char): Char;
  83
  84 function toLowerCase1251 (const s: AnsiString): AnsiString;
  85
  86 // `true` if strings are equal; ignoring case for cp1251
  87 function StrEquCI1251 (const s0, s1: AnsiString): Boolean;
  88
  89 function utf8Valid (const s: AnsiString): Boolean;
  90
  91 function utf8to1251 (s: AnsiString): AnsiString;
  92
  93 // `pathname` will be modified if path is valid
  94 // `lastIsDir` should be `true` if we are searching for directory
  95 // nobody cares about shitdoze, so i'll use the same code path for it
  96 function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolean;
  97
  98 // they throws
  99 function openDiskFileRO (pathname: AnsiString): TStream;
 100 function createDiskFile (pathname: AnsiString): TStream;
 101
 102 // little endian
 103 procedure writeInt (st: TStream; v: Byte); overload;
 104 procedure writeInt (st: TStream; v: ShortInt); overload;
 105 procedure writeInt (st: TStream; v: Word); overload;
 106 procedure writeInt (st: TStream; v: SmallInt); overload;
 107 procedure writeInt (st: TStream; v: LongWord); overload;
 108 procedure writeInt (st: TStream; v: LongInt); overload;
 109 procedure writeInt (st: TStream; v: Int64); overload;
 110 procedure writeInt (st: TStream; v: UInt64); overload;
 111
 112 function readByte (st: TStream): Byte;
 113 function readShortInt (st: TStream): ShortInt;
 114 function readWord (st: TStream): Word;
 115 function readSmallInt (st: TStream): SmallInt;
 116 function readLongWord (st: TStream): LongWord;
 117 function readLongInt (st: TStream): LongInt;
 118 function readInt64 (st: TStream): Int64;
 119 function readUInt64 (st: TStream): UInt64;
 120
 121 // big endian
 122 procedure writeIntBE (st: TStream; v: Byte); overload;
 123 procedure writeIntBE (st: TStream; v: ShortInt); overload;
 124 procedure writeIntBE (st: TStream; v: Word); overload;
 125 procedure writeIntBE (st: TStream; v: SmallInt); overload;
 126 procedure writeIntBE (st: TStream; v: LongWord); overload;
 127 procedure writeIntBE (st: TStream; v: LongInt); overload;
 128 procedure writeIntBE (st: TStream; v: Int64); overload;
 129 procedure writeIntBE (st: TStream; v: UInt64); overload;
 130
 131 function readByteBE (st: TStream): Byte;
 132 function readShortIntBE (st: TStream): ShortInt;
 133 function readWordBE (st: TStream): Word;
 134 function readSmallIntBE (st: TStream): SmallInt;
 135 function readLongWordBE (st: TStream): LongWord;
 136 function readLongIntBE (st: TStream): LongInt;
 137 function readInt64BE (st: TStream): Int64;
 138 function readUInt64BE (st: TStream): UInt64;
 139
 140
 141 function nmin (a, b: Byte): Byte; inline; overload;
 142 function nmin (a, b: ShortInt): ShortInt; inline; overload;
 143 function nmin (a, b: Word): Word; inline; overload;
 144 function nmin (a, b: SmallInt): SmallInt; inline; overload;
 145 function nmin (a, b: LongWord): LongWord; inline; overload;
 146 function nmin (a, b: LongInt): LongInt; inline; overload;
 147 function nmin (a, b: Int64): Int64; inline; overload;
 148 function nmin (a, b: UInt64): UInt64; inline; overload;
 149 function nmin (a, b: Single): Single; inline; overload;
 150 function nmin (a, b: Double): Double; inline; overload;
 151 function nmin (a, b: Extended): Extended; inline; overload;
 152
 153 function nmax (a, b: Byte): Byte; inline; overload;
 154 function nmax (a, b: ShortInt): ShortInt; inline; overload;
 155 function nmax (a, b: Word): Word; inline; overload;
 156 function nmax (a, b: SmallInt): SmallInt; inline; overload;
 157 function nmax (a, b: LongWord): LongWord; inline; overload;
 158 function nmax (a, b: LongInt): LongInt; inline; overload;
 159 function nmax (a, b: Int64): Int64; inline; overload;
 160 function nmax (a, b: UInt64): UInt64; inline; overload;
 161 function nmax (a, b: Single): Single; inline; overload;
 162 function nmax (a, b: Double): Double; inline; overload;
 163 function nmax (a, b: Extended): Extended; inline; overload;
 164
 165 function nclamp (v, a, b: Byte): Byte; inline; overload;
 166 function nclamp (v, a, b: ShortInt): ShortInt; inline; overload;
 167 function nclamp (v, a, b: Word): Word; inline; overload;
 168 function nclamp (v, a, b: SmallInt): SmallInt; inline; overload;
 169 function nclamp (v, a, b: LongWord): LongWord; inline; overload;
 170 function nclamp (v, a, b: LongInt): LongInt; inline; overload;
 171 function nclamp (v, a, b: Int64): Int64; inline; overload;
 172 function nclamp (v, a, b: UInt64): UInt64; inline; overload;
 173 function nclamp (v, a, b: Single): Single; inline; overload;
 174 function nclamp (v, a, b: Double): Double; inline; overload;
 175 function nclamp (v, a, b: Extended): Extended; inline; overload;
 176
 177
 178 type
 179   TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
 180
 181 // returns formatted string if `writerCB` is `nil`, empty string otherwise
 182 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
 183
 184 function wchar2win (wc: WideChar): AnsiChar; inline;
 185 function utf2win (const s: AnsiString): AnsiString;
 186 function win2utf (const s: AnsiString): AnsiString;
 187 function digitInBase (ch: AnsiChar; base: Integer): Integer;
 188
 189 // returns string in single or double quotes
 190 // single quotes supports only pascal-style '' for single quote char
 191 // double quotes supports c-style escapes
 192 // function will select quote mode automatically
 193 function quoteStr (const s: AnsiString): AnsiString;
 194
 195
 196 type
 197   generic TSimpleList<ItemT> = class
 198   private
 199     //type PItemT = ^ItemT;
 200     type TItemArr = array of ItemT;
 201
 202   public
 203     type
 204       TEnumerator = record
 205       private
 206         mItems: TItemArr;
 207         mCount: Integer;
 208         mCurrent: Integer;
 209       public
 210         constructor Create (const aitems: TItemArr; acount: Integer);
 211         function MoveNext: Boolean;
 212         function getCurrent (): ItemT;
 213         property Current: ItemT read getCurrent;
 214       end;
 215
 216   private
 217     mItems: TItemArr;
 218     mCount: Integer; // can be less than `mItems` size
 219
 220   private
 221     function getAt (idx: Integer): ItemT; inline;
 222     procedure setAt (idx: Integer; const it: ItemT); inline;
 223
 224     function getCapacity (): Integer; inline;
 225     procedure setCapacity (v: Integer); inline;
 226
 227   public
 228     constructor Create (acapacity: Integer=-1);
 229     destructor Destroy (); override;
 230
 231     //WARNING! don't change list contents in `for ... in`!
 232     function GetEnumerator (): TEnumerator;
 233
 234     procedure reset (); inline; // won't resize `mItems`
 235     procedure clear (); inline;
 236
 237     procedure append (constref it: ItemT); inline;
 238     procedure delete (idx: Integer); inline;
 239     function remove (idx: Integer): ItemT; inline;
 240
 241   public
 242     property count: Integer read mCount;
 243     property capacity: Integer read getCapacity write setCapacity;
 244     property at[idx: Integer]: ItemT read getAt write setAt; default;
 245   end;
 246
 247
 248 implementation
 249
 250
 251 // ////////////////////////////////////////////////////////////////////////// //
 252 constructor TSimpleList.TEnumerator.Create (const aitems: TItemArr; acount: Integer);
 253 begin
 254   mItems := aitems;
 255   mCurrent := -1;
 256   mCount := acount;
 257 end;
 258
 259 function TSimpleList.TEnumerator.MoveNext: Boolean;
 260 begin
 261   Inc(mCurrent);
 262   result := (mCurrent < mCount);
 263 end;
 264
 265 function TSimpleList.TEnumerator.getCurrent (): ItemT;
 266 begin
 267   result := mItems[mCurrent];
 268 end;
 269
 270
 271 // ////////////////////////////////////////////////////////////////////////// //
 272 constructor TSimpleList.Create (acapacity: Integer=-1);
 273 begin
 274   mItems := nil;
 275   if (acapacity > 0) then SetLength(mItems, acapacity);
 276   mCount := 0;
 277 end;
 278
 279
 280 destructor TSimpleList.Destroy ();
 281 begin
 282   mItems := nil;
 283   inherited;
 284 end;
 285
 286
 287 function TSimpleList.getCapacity (): Integer; inline;
 288 begin
 289   result := Length(mItems);
 290 end;
 291
 292
 293 procedure TSimpleList.setCapacity (v: Integer); inline;
 294 begin
 295   if (v < mCount) then v := mCount;
 296   if (v <> Length(mItems)) then SetLength(mItems, v);
 297 end;
 298
 299
 300 function TSimpleList.GetEnumerator (): TEnumerator;
 301 begin
 302   if (Length(mItems) > 0) then result := TEnumerator.Create(mItems, mCount)
 303   else result := TEnumerator.Create(nil, -1);
 304 end;
 305
 306
 307 procedure TSimpleList.reset (); inline;
 308 begin
 309   mCount := 0;
 310 end;
 311
 312
 313 procedure TSimpleList.clear (); inline;
 314 begin
 315   mItems := nil;
 316   mCount := 0;
 317 end;
 318
 319
 320 function TSimpleList.getAt (idx: Integer): ItemT; inline;
 321 begin
 322   if (idx >= 0) and (idx < mCount) then result := mItems[idx] else result := Default(ItemT);
 323 end;
 324
 325
 326 procedure TSimpleList.setAt (idx: Integer; const it: ItemT); inline;
 327 begin
 328   if (idx >= 0) and (idx < mCount) then mItems[idx] := it;
 329 end;
 330
 331
 332 procedure TSimpleList.append (constref it: ItemT); inline;
 333 var
 334   newsz: Integer;
 335 begin
 336   if (mCount >= Length(mItems)) then
 337   begin
 338     newsz := mCount+(mCount div 3)+128;
 339     SetLength(mItems, newsz);
 340   end;
 341   mItems[mCount] := it;
 342   Inc(mCount);
 343 end;
 344
 345
 346 procedure TSimpleList.delete (idx: Integer); inline;
 347 var
 348   f: Integer;
 349 begin
 350   if (idx >= 0) and (idx < mCount) then
 351   begin
 352     for f := idx+1 to mCount-1 do mItems[f-1] := mItems[f];
 353   end;
 354 end;
 355
 356
 357 function TSimpleList.remove (idx: Integer): ItemT; inline;
 358 var
 359   f: Integer;
 360 begin
 361   if (idx >= 0) and (idx < mCount) then
 362   begin
 363     result := mItems[idx];
 364     for f := idx+1 to mCount-1 do mItems[f-1] := mItems[f];
 365   end
 366   else
 367   begin
 368     result := Default(ItemT);
 369   end;
 370 end;
 371
 372
 373 // ////////////////////////////////////////////////////////////////////////// //
 374 var
 375   wc2shitmap: array[0..65535] of AnsiChar;
 376   wc2shitmapInited: Boolean = false;
 377
 378
 379 // ////////////////////////////////////////////////////////////////////////// //
 380 const
 381   cp1251: array[0..127] of Word = (
 382     $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
 383     $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
 384     $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
 385     $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
 386     $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
 387     $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
 388     $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
 389     $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
 390   );
 391
 392
 393 procedure initShitMap ();
 394 var
 395   f: Integer;
 396 begin
 397   for f := 0 to High(wc2shitmap) do wc2shitmap[f] := '?';
 398   for f := 0 to 127 do wc2shitmap[f] := AnsiChar(f);
 399   for f := 0 to 127 do wc2shitmap[cp1251[f]] := AnsiChar(f+128);
 400   wc2shitmapInited := true;
 401 end;
 402
 403
 404 // ////////////////////////////////////////////////////////////////////////// //
 405 // fast state-machine based UTF-8 decoder; using 8 bytes of memory
 406 // code points from invalid range will never be valid, this is the property of the state machine
 407 const
 408   // see http://bjoern.hoehrmann.de/utf-8/decoder/dfa/
 409   utf8dfa: array[0..$16c-1] of Byte = (
 410     // maps bytes to character classes
 411     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 00-0f
 412     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 10-1f
 413     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 20-2f
 414     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 30-3f
 415     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 40-4f
 416     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 50-5f
 417     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 60-6f
 418     $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, // 70-7f
 419     $01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01,$01, // 80-8f
 420     $09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09,$09, // 90-9f
 421     $07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07, // a0-af
 422     $07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07,$07, // b0-bf
 423     $08,$08,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02, // c0-cf
 424     $02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02,$02, // d0-df
 425     $0a,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$03,$04,$03,$03, // e0-ef
 426     $0b,$06,$06,$06,$05,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08,$08, // f0-ff
 427     // maps a combination of a state of the automaton and a character class to a state
 428     $00,$0c,$18,$24,$3c,$60,$54,$0c,$0c,$0c,$30,$48,$0c,$0c,$0c,$0c, // 100-10f
 429     $0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$00,$0c,$0c,$0c,$0c,$0c,$00, // 110-11f
 430     $0c,$00,$0c,$0c,$0c,$18,$0c,$0c,$0c,$0c,$0c,$18,$0c,$18,$0c,$0c, // 120-12f
 431     $0c,$0c,$0c,$0c,$0c,$0c,$0c,$18,$0c,$0c,$0c,$0c,$0c,$18,$0c,$0c, // 130-13f
 432     $0c,$0c,$0c,$0c,$0c,$18,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$24, // 140-14f
 433     $0c,$24,$0c,$0c,$0c,$24,$0c,$0c,$0c,$0c,$0c,$24,$0c,$24,$0c,$0c, // 150-15f
 434     $0c,$24,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c,$0c);
 435
 436
 437 // ////////////////////////////////////////////////////////////////////////// //
 438 constructor TUtf8DecoderFast.Create (v: Boolean{fuck you, fpc}); begin state := Accept; codepoint := 0; end;
 439
 440 procedure TUtf8DecoderFast.reset (); inline; begin state := Accept; codepoint := 0; end;
 441
 442 function TUtf8DecoderFast.complete (): Boolean; inline; begin result := (state = Accept); end;
 443 function TUtf8DecoderFast.invalid (): Boolean; inline; begin result := (state = Reject); end;
 444 function TUtf8DecoderFast.completeOrInvalid (): Boolean; inline; begin result := (state = Accept) or (state = Reject); end;
 445
 446 function TUtf8DecoderFast.decode (c: AnsiChar): Boolean; inline; overload; begin result := decode(Byte(c)); end;
 447
 448 function TUtf8DecoderFast.decode (b: Byte): Boolean; inline; overload;
 449 var
 450   tp: LongWord;
 451 begin
 452   if (state = Reject) then begin state := Accept; codepoint := 0; end;
 453   tp := utf8dfa[b];
 454   if (state <> Accept) then codepoint := (b and $3f) or (codepoint shl 6) else codepoint := ($ff shr tp) and b;
 455   state := utf8dfa[256+state+tp];
 456   if (state = Reject) then begin codepoint := Replacement; state := Accept; end;
 457   result := (state = Accept);
 458 end;
 459
 460
 461 // ////////////////////////////////////////////////////////////////////////// //
 462 function wchar2win (wc: WideChar): AnsiChar; inline;
 463 begin
 464   if not wc2shitmapInited then initShitMap();
 465   if (LongWord(wc) > 65535) then result := '?' else result := wc2shitmap[LongWord(wc)];
 466 end;
 467
 468
 469 // ////////////////////////////////////////////////////////////////////////// //
 470 function utf2win (const s: AnsiString): AnsiString;
 471 var
 472   f, c: Integer;
 473   ud: TUtf8DecoderFast;
 474 begin
 475   for f := 1 to Length(s) do
 476   begin
 477     if (Byte(s[f]) > 127) then
 478     begin
 479       ud := TUtf8DecoderFast.Create(true);
 480       result := '';
 481       for c := 1 to Length(s) do
 482       begin
 483         if ud.decode(s[c]) then result += wchar2win(WideChar(ud.codepoint));
 484       end;
 485       exit;
 486     end;
 487   end;
 488   result := s;
 489 end;
 490
 491
 492 function win2utf (const s: AnsiString): AnsiString;
 493 var
 494   f, c: Integer;
 495
 496   function utf8Encode (code: Integer): AnsiString;
 497   begin
 498     if (code < 0) or (code > $10FFFF) then begin result := '?'; exit; end;
 499     if (code <= $7f) then
 500     begin
 501       result := Char(code and $ff);
 502     end
 503     else if (code <= $7FF) then
 504     begin
 505       result := Char($C0 or (code shr 6));
 506       result += Char($80 or (code and $3F));
 507     end
 508     else if (code <= $FFFF) then
 509     begin
 510       result := Char($E0 or (code shr 12));
 511       result += Char($80 or ((code shr 6) and $3F));
 512       result += Char($80 or (code and $3F));
 513     end
 514     else if (code <= $10FFFF) then
 515     begin
 516       result := Char($F0 or (code shr 18));
 517       result += Char($80 or ((code shr 12) and $3F));
 518       result += Char($80 or ((code shr 6) and $3F));
 519       result += Char($80 or (code and $3F));
 520     end
 521     else
 522     begin
 523       result := '?';
 524     end;
 525   end;
 526
 527 begin
 528   for f := 1 to Length(s) do
 529   begin
 530     if (Byte(s[f]) > 127) then
 531     begin
 532       result := '';
 533       for c := 1 to Length(s) do
 534       begin
 535         if (Byte(s[c]) < 128) then
 536         begin
 537           result += s[c];
 538         end
 539         else
 540         begin
 541           result += utf8Encode(cp1251[Byte(s[c])-128])
 542         end;
 543       end;
 544       exit;
 545     end;
 546   end;
 547   result := s;
 548 end;
 549
 550
 551 // ////////////////////////////////////////////////////////////////////////// //
 552 function digitInBase (ch: AnsiChar; base: Integer): Integer;
 553 begin
 554   result := -1;
 555   if (base < 1) or (base > 36) then exit;
 556   if (ch < '0') then exit;
 557   if (base <= 10) then
 558   begin
 559     if (Integer(ch) >= 48+base) then exit;
 560     result := Integer(ch)-48;
 561   end
 562   else
 563   begin
 564     if (ch >= '0') and (ch <= '9') then begin result := Integer(ch)-48; exit; end;
 565     if (ch >= 'a') and (ch <= 'z') then Dec(ch, 32); // poor man's tolower()
 566     if (ch < 'A') or (Integer(ch) >= 65+(base-10)) then exit;
 567     result := Integer(ch)-65+10;
 568   end;
 569 end;
 570
 571
 572 // ////////////////////////////////////////////////////////////////////////// //
 573 function quoteStr (const s: AnsiString): AnsiString;
 574
 575   function squote (const s: AnsiString): AnsiString;
 576   var
 577     f: Integer;
 578   begin
 579     result := '''';
 580     for f := 1 to Length(s) do
 581     begin
 582       if (s[f] = '''') then result += '''';
 583       result += s[f];
 584     end;
 585     result += '''';
 586   end;
 587
 588   function dquote (const s: AnsiString): AnsiString;
 589   var
 590     f: Integer;
 591     ch: AnsiChar;
 592   begin
 593     result := '"';
 594     for f := 1 to Length(s) do
 595     begin
 596       ch := s[f];
 597            if (ch = #0) then result += '\z'
 598       else if (ch = #9) then result += '\t'
 599       else if (ch = #10) then result += '\n'
 600       else if (ch = #13) then result += '\r'
 601       else if (ch = #27) then result += '\e'
 602       else if (ch < ' ') or (ch = #127) then
 603       begin
 604         result += '\x';
 605         result += LowerCase(IntToHex(Integer(ch), 2));
 606       end
 607       else if (ch = '"') or (ch = '\') then
 608       begin
 609         result += '\';
 610         result += ch;
 611       end
 612       else
 613       begin
 614         result += ch;
 615       end;
 616     end;
 617     result += '"';
 618   end;
 619
 620 var
 621   needSingle: Boolean = false;
 622   f: Integer;
 623 begin
 624   for f := 1 to Length(s) do
 625   begin
 626     if (s[f] = '''') then begin needSingle := true; continue; end;
 627     if (s[f] < ' ') or (s[f] = #127) then begin result := dquote(s); exit; end;
 628   end;
 629   if needSingle then result := squote(s) else result := ''''+s+'''';
 630 end;
 631
 632
 633 // ////////////////////////////////////////////////////////////////////////// //
 634 function getFilenameExt (const fn: AnsiString): AnsiString;
 635 var
 636   pos: Integer;
 637   ch: AnsiChar;
 638 begin
 639   pos := Length(fn);
 640   while (pos > 0) do
 641   begin
 642     ch := fn[pos];
 643     if (ch = '.') then
 644     begin
 645       if (pos = Length(fn)) then result := '' else result := Copy(fn, pos, Length(fn)-pos+1);
 646       exit;
 647     end;
 648     if (ch = '/') or (ch = '\') then break;
 649     Dec(pos);
 650   end;
 651   result := ''; // no extension
 652 end;
 653
 654
 655 function setFilenameExt (const fn, ext: AnsiString): AnsiString;
 656 var
 657   pos: Integer;
 658   ch: AnsiChar;
 659 begin
 660   result := fn;
 661   if (Length(ext) = 0) or (ext = '.') then exit;
 662   pos := Length(fn);
 663   while (pos > 0) do
 664   begin
 665     ch := fn[pos];
 666     if (ch = '.') then exit;
 667     if (ch = '/') or (ch = '\') then break;
 668     Dec(pos);
 669   end;
 670   if (ext[1] <> '.') then result += '.';
 671   result += ext;
 672 end;
 673
 674
 675 function forceFilenameExt (const fn, ext: AnsiString): AnsiString;
 676 var
 677   pos: Integer;
 678   ch: AnsiChar;
 679 begin
 680   result := fn;
 681   pos := Length(fn);
 682   while (pos > 0) do
 683   begin
 684     ch := fn[pos];
 685     if (ch = '.') then
 686     begin
 687       if (Length(ext) = 0) or (ext = '.') then
 688       begin
 689         result := Copy(fn, 1, pos-1);
 690       end
 691       else
 692       begin
 693         if (ext[1] = '.') then result := Copy(fn, 1, pos-1) else result := Copy(fn, 1, pos);
 694         result += ext;
 695         exit;
 696       end;
 697     end;
 698     if (ch = '/') or (ch = '\') then break;
 699     Dec(pos);
 700   end;
 701   if (Length(ext) > 0) then
 702   begin
 703     if (ext[1] <> '.') then result += '.';
 704     result += ext;
 705   end;
 706 end;
 707
 708
 709 // strips out name from `fn`, leaving trailing slash
 710 function getFilenamePath (const fn: AnsiString): AnsiString;
 711 var
 712   pos: Integer;
 713   ch: AnsiChar;
 714 begin
 715   if (Length(fn) = 0) then begin result := './'; exit; end;
 716   if (fn[Length(fn)] = '/') or (fn[Length(fn)] = '\') then begin result := fn; exit; end;
 717   pos := Length(fn);
 718   while (pos > 0) do
 719   begin
 720     ch := fn[pos];
 721     if (ch = '/') or (ch = '\') then begin result := Copy(fn, 1, pos); exit; end;
 722     Dec(pos);
 723   end;
 724   result := './'; // no path -> current dir
 725 end;
 726
 727
 728 // ends with '/' or '\'?
 729 function isFilenamePath (const fn: AnsiString): Boolean;
 730 begin
 731   if (Length(fn) = 0) then
 732   begin
 733     result := false;
 734   end
 735   else
 736   begin
 737     result := (fn[Length(fn)] = '/') or (fn[Length(fn)] = '\');
 738   end;
 739 end;
 740
 741
 742 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
 743 // will add slash to `path`, even if `fn` is empty!
 744 function filenameConcat (const path, fn: AnsiString): AnsiString;
 745 var
 746   pos: Integer;
 747 begin
 748   pos := 1;
 749   while (pos <= Length(fn)) and ((fn[pos] = '/') or (fn[pos] = '\')) do Inc(pos);
 750   result := path;
 751   if (Length(result) > 0) and ((result[Length(result)] <> '/') and (result[Length(result)] <> '\')) then result += '/';
 752   if (pos <= Length(fn)) then
 753   begin
 754     result += Copy(fn, pos, Length(fn)-pos+1);
 755     //FIXME: make this faster!
 756     while (Length(result) > 0) and ((result[Length(result)] = '/') or (result[Length(result)] = '\')) do
 757     begin
 758       Delete(result, Length(result), 1);
 759     end;
 760     if (fn[Length(fn)] = '/') or (fn[Length(fn)] = '\') then result += '/';
 761   end;
 762 end;
 763
 764
 765 function hasWadExtension (const fn: AnsiString): Boolean;
 766 var
 767   ext: AnsiString;
 768 begin
 769   ext := getFilenameExt(fn);
 770   result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip');
 771 end;
 772
 773
 774 function addWadExtension (const fn: AnsiString): AnsiString;
 775 begin
 776   result := fn;
 777   if not hasWadExtension(result) then result := result+'.wad';
 778 end;
 779
 780
 781 function isWadPath (const fn: AnsiString): Boolean;
 782 var
 783   pos: Integer;
 784   s: AnsiString;
 785 begin
 786   result := false;
 787   pos := 1;
 788   while (pos <= Length(fn)) do
 789   begin
 790     if (fn[pos] = ':') then
 791     begin
 792       if (Length(fn)-pos < 1) then break;
 793       if (pos-4 > 1) and (fn[pos-4] = '.') and ((fn[pos+1] = '\') or (fn[pos+1] = '/')) then
 794       begin
 795         s := Copy(fn, pos-4, 4);
 796         if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') then
 797         begin
 798           result := true;
 799           exit;
 800         end;
 801       end;
 802     end;
 803     Inc(pos);
 804   end;
 805 end;
 806
 807
 808 function Int64ToStrComma (i: Int64): AnsiString;
 809 var
 810   f: Integer;
 811 begin
 812   Str(i, result);
 813   f := Length(result)+1;
 814   while f > 4 do
 815   begin
 816     Dec(f, 3); Insert(',', result, f);
 817   end;
 818 end;
 819
 820
 821 function UpCase1251 (ch: Char): Char;
 822 begin
 823   if ch < #128 then
 824   begin
 825     if (ch >= 'a') and (ch <= 'z') then Dec(ch, 32);
 826   end
 827   else
 828   begin
 829     if (ch >= #224) and (ch <= #255) then
 830     begin
 831       Dec(ch, 32);
 832     end
 833     else
 834     begin
 835       case ch of
 836         #184, #186, #191: Dec(ch, 16);
 837         #162, #179: Dec(ch);
 838       end;
 839     end;
 840   end;
 841   result := ch;
 842 end;
 843
 844
 845 function LoCase1251 (ch: Char): Char;
 846 begin
 847   if ch < #128 then
 848   begin
 849     if (ch >= 'A') and (ch <= 'Z') then Inc(ch, 32);
 850   end
 851   else
 852   begin
 853     if (ch >= #192) and (ch <= #223) then
 854     begin
 855       Inc(ch, 32);
 856     end
 857     else
 858     begin
 859       case ch of
 860         #168, #170, #175: Inc(ch, 16);
 861         #161, #178: Inc(ch);
 862       end;
 863     end;
 864   end;
 865   result := ch;
 866 end;
 867
 868
 869 function StrEquCI1251 (const s0, s1: AnsiString): Boolean;
 870 var
 871   i: Integer;
 872 begin
 873   result := false;
 874   if length(s0) <> length(s1) then exit;
 875   for i := 1 to length(s0) do if UpCase1251(s0[i]) <> UpCase1251(s1[i]) then exit;
 876   result := true;
 877 end;
 878
 879
 880 function toLowerCase1251 (const s: AnsiString): AnsiString;
 881 var
 882   f: Integer;
 883   ch: AnsiChar;
 884 begin
 885   for ch in s do
 886   begin
 887     if (ch <> LoCase1251(ch)) then
 888     begin
 889       result := '';
 890       SetLength(result, Length(s));
 891       for f := 1 to Length(s) do result[f] := LoCase1251(s[f]);
 892       exit;
 893     end;
 894   end;
 895   // nothing to do
 896   result := s;
 897 end;
 898
 899
 900 // ////////////////////////////////////////////////////////////////////////// //
 901 // utils
 902 // `ch`: utf8 start
 903 // -1: invalid utf8
 904 function utf8CodeLen (ch: Word): Integer;
 905 begin
 906   if ch < $80 then begin result := 1; exit; end;
 907   if (ch and $FE) = $FC then begin result := 6; exit; end;
 908   if (ch and $FC) = $F8 then begin result := 5; exit; end;
 909   if (ch and $F8) = $F0 then begin result := 4; exit; end;
 910   if (ch and $F0) = $E0 then begin result := 3; exit; end;
 911   if (ch and $E0) = $C0 then begin result := 2; exit; end;
 912   result := -1; // invalid
 913 end;
 914
 915
 916 function utf8Valid (const s: AnsiString): Boolean;
 917 var
 918   pos, len: Integer;
 919 begin
 920   result := false;
 921   pos := 1;
 922   while pos <= length(s) do
 923   begin
 924     len := utf8CodeLen(Byte(s[pos]));
 925     if len < 1 then exit; // invalid sequence start
 926     if pos+len-1 > length(s) then exit; // out of chars in string
 927     Dec(len);
 928     Inc(pos);
 929     // check other sequence bytes
 930     while len > 0 do
 931     begin
 932       if (Byte(s[pos]) and $C0) <> $80 then exit;
 933       Dec(len);
 934       Inc(pos);
 935     end;
 936   end;
 937   result := true;
 938 end;
 939
 940
 941 // ////////////////////////////////////////////////////////////////////////// //
 942 const
 943   uni2wint: array [128..255] of Word = (
 944     $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
 945     $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
 946     $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
 947     $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
 948     $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
 949     $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
 950     $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
 951     $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
 952   );
 953
 954
 955 function decodeUtf8Char (s: AnsiString; var pos: Integer): char;
 956 var
 957   b, c: Integer;
 958 begin
 959   (* The following encodings are valid, except for the 5 and 6 byte
 960    * combinations:
 961    *  0xxxxxxx
 962    *  110xxxxx 10xxxxxx
 963    *  1110xxxx 10xxxxxx 10xxxxxx
 964    *  11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
 965    *  111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
 966    *  1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
 967    *)
 968   result := '?';
 969   if pos > length(s) then exit;
 970
 971   b := Byte(s[pos]);
 972   Inc(pos);
 973   if b < $80 then begin result := char(b); exit; end;
 974
 975   // mask out unused bits
 976        if (b and $FE) = $FC then b := b and $01
 977   else if (b and $FC) = $F8 then b := b and $03
 978   else if (b and $F8) = $F0 then b := b and $07
 979   else if (b and $F0) = $E0 then b := b and $0F
 980   else if (b and $E0) = $C0 then b := b and $1F
 981   else exit; // invalid utf8
 982
 983   // now continue
 984   while pos <= length(s) do
 985   begin
 986     c := Byte(s[pos]);
 987     if (c and $C0) <> $80 then break; // no more
 988     b := b shl 6;
 989     b := b or (c and $3F);
 990     Inc(pos);
 991   end;
 992
 993   // done, try 1251
 994   for c := 128 to 255 do if uni2wint[c] = b then begin result := char(c and $FF); exit; end;
 995   // alas
 996 end;
 997
 998
 999 function utf8to1251 (s: AnsiString): AnsiString;
1000 var
1001   pos: Integer;
1002 begin
1003   if not utf8Valid(s) then begin result := s; exit; end;
1004   pos := 1;
1005   while pos <= length(s) do
1006   begin
1007     if Byte(s[pos]) >= $80 then break;
1008     Inc(pos);
1009   end;
1010   if pos > length(s) then begin result := s; exit; end; // nothing to do here
1011   result := '';
1012   pos := 1;
1013   while pos <= length(s) do result := result+decodeUtf8Char(s, pos);
1014 end;
1015
1016
1017 // ////////////////////////////////////////////////////////////////////////// //
1018 // `pathname` will be modified if path is valid
1019 // `lastIsDir` should be `true` if we are searching for directory
1020 // nobody cares about shitdoze, so i'll use the same code path for it
1021 function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolean;
1022 var
1023   sr: TSearchRec;
1024   npt: AnsiString;
1025   newname: AnsiString = '';
1026   curname: AnsiString;
1027   wantdir: Boolean;
1028   attr: LongInt;
1029   foundher: Boolean;
1030 begin
1031   npt := pathname;
1032   result := (length(npt) > 0);
1033   if (length(npt) > 0) and ((npt[1] = '/') or (npt[1] = '\')) then newname := '/';
1034   while length(npt) > 0 do
1035   begin
1036     // remove trailing slashes
1037     while (length(npt) > 0) and ((npt[1] = '/') or (npt[1] = '\')) do Delete(npt, 1, 1);
1038     if length(npt) = 0 then break;
1039     // extract name
1040     curname := '';
1041     while (length(npt) > 0) and (npt[1] <> '/') and (npt[1] <> '\') do
1042     begin
1043       curname := curname+npt[1];
1044       Delete(npt, 1, 1);
1045     end;
1046     // remove trailing slashes again
1047     while (length(npt) > 0) and ((npt[1] = '/') or (npt[1] = '\')) do Delete(npt, 1, 1);
1048     wantdir := lastIsDir or (length(npt) > 0); // do we want directory here?
1049     //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1050     // try the easiest case first
1051     attr := FileGetAttr(newname+curname);
1052     if attr <> -1 then
1053     begin
1054       if wantdir = ((attr and faDirectory) <> 0) then
1055       begin
1056         // i found her!
1057         newname := newname+curname;
1058         if wantdir then newname := newname+'/';
1059         continue;
1060       end;
1061     end;
1062     //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1063     // alas, either not found, or invalid attributes
1064     foundher := false;
1065     try
1066       if FindFirst(newname+'*', faAnyFile, sr) = 0 then
1067       repeat
1068         if (wantdir = ((sr.attr and faDirectory) <> 0)) and StrEquCI1251(sr.name, curname) then
1069         begin
1070           // i found her!
1071           newname := newname+sr.name;
1072           if wantdir then newname := newname+'/';
1073           foundher := true;
1074           break;
1075         end;
1076       until FindNext(sr) <> 0;
1077     finally
1078       FindClose(sr);
1079     end;
1080     if not foundher then begin newname := ''; result := false; break; end;
1081   end;
1082   if result then pathname := newname;
1083 end;
1084
1085
1086 function openDiskFileRO (pathname: AnsiString): TStream;
1087 begin
1088   if not findFileCI(pathname) then raise Exception.Create('can''t open file "'+pathname+'"');
1089   result := TFileStream.Create(pathname, fmOpenRead or {fmShareDenyWrite}fmShareDenyNone);
1090 end;
1091
1092 function createDiskFile (pathname: AnsiString): TStream;
1093 var
1094   path: AnsiString;
1095 begin
1096   path := ExtractFilePath(pathname);
1097   if length(path) > 0 then
1098   begin
1099     if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1100   end;
1101   result := TFileStream.Create(path+ExtractFileName(pathname), fmCreate);
1102 end;
1103
1104
1105 procedure writeIntegerLE (st: TStream; vp: Pointer; size: Integer);
1106 {$IFDEF ENDIAN_LITTLE}
1107 begin
1108   st.writeBuffer(vp^, size);
1109 end;
1110 {$ELSE}
1111 var
1112   p: PByte;
1113 begin
1114   p := PByte(vp)+size-1;
1115   while size > 0 do
1116   begin
1117     st.writeBuffer(p^, 1);
1118     Dec(size);
1119     Dec(p);
1120   end;
1121 end;
1122 {$ENDIF}
1123
1124 procedure writeIntegerBE (st: TStream; vp: Pointer; size: Integer);
1125 {$IFDEF ENDIAN_LITTLE}
1126 var
1127   p: PByte;
1128 begin
1129   p := PByte(vp)+size-1;
1130   while size > 0 do
1131   begin
1132     st.writeBuffer(p^, 1);
1133     Dec(size);
1134     Dec(p);
1135   end;
1136 end;
1137 {$ELSE}
1138 begin
1139   st.writeBuffer(vp^, size);
1140 end;
1141 {$ENDIF}
1142
1143 procedure writeInt (st: TStream; v: Byte); overload; begin writeIntegerLE(st, @v, 1); end;
1144 procedure writeInt (st: TStream; v: ShortInt); overload; begin writeIntegerLE(st, @v, 1); end;
1145 procedure writeInt (st: TStream; v: Word); overload; begin writeIntegerLE(st, @v, 2); end;
1146 procedure writeInt (st: TStream; v: SmallInt); overload; begin writeIntegerLE(st, @v, 2); end;
1147 procedure writeInt (st: TStream; v: LongWord); overload; begin writeIntegerLE(st, @v, 4); end;
1148 procedure writeInt (st: TStream; v: LongInt); overload; begin writeIntegerLE(st, @v, 4); end;
1149 procedure writeInt (st: TStream; v: Int64); overload; begin writeIntegerLE(st, @v, 8); end;
1150 procedure writeInt (st: TStream; v: UInt64); overload; begin writeIntegerLE(st, @v, 8); end;
1151
1152 procedure writeIntBE (st: TStream; v: Byte); overload; begin writeIntegerBE(st, @v, 1); end;
1153 procedure writeIntBE (st: TStream; v: ShortInt); overload; begin writeIntegerBE(st, @v, 1); end;
1154 procedure writeIntBE (st: TStream; v: Word); overload; begin writeIntegerBE(st, @v, 2); end;
1155 procedure writeIntBE (st: TStream; v: SmallInt); overload; begin writeIntegerBE(st, @v, 2); end;
1156 procedure writeIntBE (st: TStream; v: LongWord); overload; begin writeIntegerBE(st, @v, 4); end;
1157 procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(st, @v, 4); end;
1158 procedure writeIntBE (st: TStream; v: Int64); overload; begin writeIntegerBE(st, @v, 8); end;
1159 procedure writeIntBE (st: TStream; v: UInt64); overload; begin writeIntegerBE(st, @v, 8); end;
1160
1161
1162 procedure readIntegerLE (st: TStream; vp: Pointer; size: Integer);
1163 {$IFDEF ENDIAN_LITTLE}
1164 begin
1165   st.readBuffer(vp^, size);
1166 end;
1167 {$ELSE}
1168 var
1169   p: PByte;
1170 begin
1171   p := PByte(vp)+size-1;
1172   while size > 0 do
1173   begin
1174     st.readBuffer(p^, 1);
1175     Dec(size);
1176     Dec(p);
1177   end;
1178 end;
1179 {$ENDIF}
1180
1181 procedure readIntegerBE (st: TStream; vp: Pointer; size: Integer);
1182 {$IFDEF ENDIAN_LITTLE}
1183 var
1184   p: PByte;
1185 begin
1186   p := PByte(vp)+size-1;
1187   while size > 0 do
1188   begin
1189     st.readBuffer(p^, 1);
1190     Dec(size);
1191     Dec(p);
1192   end;
1193 end;
1194 {$ELSE}
1195 begin
1196   st.readBuffer(vp^, size);
1197 end;
1198 {$ENDIF}
1199
1200 function readByte (st: TStream): Byte; begin readIntegerLE(st, @result, 1); end;
1201 function readShortInt (st: TStream): ShortInt; begin readIntegerLE(st, @result, 1); end;
1202 function readWord (st: TStream): Word; begin readIntegerLE(st, @result, 2); end;
1203 function readSmallInt (st: TStream): SmallInt; begin readIntegerLE(st, @result, 2); end;
1204 function readLongWord (st: TStream): LongWord; begin readIntegerLE(st, @result, 4); end;
1205 function readLongInt (st: TStream): LongInt; begin readIntegerLE(st, @result, 4); end;
1206 function readInt64 (st: TStream): Int64; begin readIntegerLE(st, @result, 8); end;
1207 function readUInt64 (st: TStream): UInt64; begin readIntegerLE(st, @result, 8); end;
1208
1209 function readByteBE (st: TStream): Byte; begin readIntegerBE(st, @result, 1); end;
1210 function readShortIntBE (st: TStream): ShortInt; begin readIntegerBE(st, @result, 1); end;
1211 function readWordBE (st: TStream): Word; begin readIntegerBE(st, @result, 2); end;
1212 function readSmallIntBE (st: TStream): SmallInt; begin readIntegerBE(st, @result, 2); end;
1213 function readLongWordBE (st: TStream): LongWord; begin readIntegerBE(st, @result, 4); end;
1214 function readLongIntBE (st: TStream): LongInt; begin readIntegerBE(st, @result, 4); end;
1215 function readInt64BE (st: TStream): Int64; begin readIntegerBE(st, @result, 8); end;
1216 function readUInt64BE (st: TStream): UInt64; begin readIntegerBE(st, @result, 8); end;
1217
1218
1219 // ////////////////////////////////////////////////////////////////////////// //
1220 function nmin (a, b: Byte): Byte; inline; overload; begin if (a < b) then result := a else result := b; end;
1221 function nmin (a, b: ShortInt): ShortInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1222 function nmin (a, b: Word): Word; inline; overload; begin if (a < b) then result := a else result := b; end;
1223 function nmin (a, b: SmallInt): SmallInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1224 function nmin (a, b: LongWord): LongWord; inline; overload; begin if (a < b) then result := a else result := b; end;
1225 function nmin (a, b: LongInt): LongInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1226 function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then result := a else result := b; end;
1227 function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end;
1228 function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end;
1229 function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end;
1230 function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end;
1231
1232 function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end;
1233 function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1234 function nmax (a, b: Word): Word; inline; overload; begin if (a > b) then result := a else result := b; end;
1235 function nmax (a, b: SmallInt): SmallInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1236 function nmax (a, b: LongWord): LongWord; inline; overload; begin if (a > b) then result := a else result := b; end;
1237 function nmax (a, b: LongInt): LongInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1238 function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then result := a else result := b; end;
1239 function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end;
1240 function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end;
1241 function nmax (a, b: Double): Double; inline; overload; begin if (a > b) then result := a else result := b; end;
1242 function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end;
1243
1244 function nclamp (v, a, b: Byte): Byte; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
1245 function nclamp (v, a, b: ShortInt): ShortInt; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
1246 function nclamp (v, a, b: Word): Word; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
1247 function nclamp (v, a, b: SmallInt): SmallInt; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
1248 function nclamp (v, a, b: LongWord): LongWord; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
1249 function nclamp (v, a, b: LongInt): LongInt; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
1250 function nclamp (v, a, b: Int64): Int64; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
1251 function nclamp (v, a, b: UInt64): UInt64; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
1252 function nclamp (v, a, b: Single): Single; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
1253 function nclamp (v, a, b: Double): Double; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
1254 function nclamp (v, a, b: Extended): Extended; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end;
1255
1256
1257 // ////////////////////////////////////////////////////////////////////////// //
1258 {$IFDEF WINDOWS}
1259 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf';
1260 {$ELSE}
1261 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'libc' name 'snprintf';
1262 {$ENDIF}
1263
1264
1265 (*
1266 procedure conwriter (constref buf; len: SizeUInt);
1267 var
1268   ss: ShortString;
1269   slen: Integer;
1270   b: PByte;
1271 begin
1272   if (len < 1) then exit;
1273   b := PByte(@buf);
1274   while (len > 0) do
1275   begin
1276     if (len > 255) then slen := 255 else slen := Integer(len);
1277     Move(b^, ss[1], len);
1278     ss[0] := AnsiChar(slen);
1279     write(ss);
1280     b += slen;
1281     len -= slen;
1282   end;
1283 end;
1284 *)
1285
1286
1287 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1288 const
1289   PadSpaces: AnsiString = '                                                                       ';
1290   PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
1291 var
1292   curarg: Integer = 0; // current arg in `args`
1293   sign, fmtch: AnsiChar;
1294   zeropad: Boolean;
1295   width, prec: Integer; // width and precision
1296   spos, epos: Integer;
1297   ch: AnsiChar;
1298   strbuf: array[0..256] of AnsiChar;
1299   strblen: SizeUInt;
1300   fmtbuf: array[0..256] of AnsiChar;
1301   fmtblen: Integer;
1302   pclen: Integer;
1303   pc: PAnsiChar;
1304   ccname: ShortString;
1305
1306   procedure writer (constref buf; len: SizeUInt);
1307   var
1308     ss: ShortString;
1309     slen: Integer;
1310     b: PByte;
1311   begin
1312     if (len < 1) then exit;
1313     b := PByte(@buf);
1314     if assigned(writerCB) then
1315     begin
1316       writerCB(b^, len);
1317     end
1318     else
1319     begin
1320       while (len > 0) do
1321       begin
1322         if (len > 255) then slen := 255 else slen := Integer(len);
1323         Move(b^, ss[1], slen);
1324         ss[0] := AnsiChar(slen);
1325         result += ss;
1326         b += slen;
1327         len -= slen;
1328       end;
1329     end;
1330   end;
1331
1332   procedure xwrite (const s: AnsiString);
1333   begin
1334     if (Length(s) > 0) then writer(PAnsiChar(s)^, Length(s));
1335   end;
1336
1337   procedure putFmtChar (ch: AnsiChar);
1338   begin
1339     fmtbuf[fmtblen] := ch;
1340     Inc(fmtblen);
1341   end;
1342
1343   procedure putFmtInt (n: Integer);
1344   var
1345     len: SizeUInt;
1346   begin
1347     len := snprintf(@fmtbuf[fmtblen], Length(fmtbuf)-fmtblen, '%d', n);
1348     if (len > 0) then Inc(fmtblen, len);
1349   end;
1350
1351   procedure buildCFormat (const pfx: AnsiString='');
1352   var
1353     f: Integer;
1354   begin
1355     fmtblen := 0;
1356     for f := 1 to Length(pfx) do putFmtChar(pfx[f]);
1357     putFmtChar('%');
1358     if (sign <> ' ') then putFmtChar(sign);
1359     if (width >= 0) then
1360     begin
1361       if (zeropad) then putFmtChar('0');
1362       putFmtInt(width);
1363       if (prec >= 0) then
1364       begin
1365         putFmtChar('.');
1366         putFmtInt(prec);
1367       end;
1368     end;
1369     putFmtChar(fmtch);
1370     fmtbuf[fmtblen] := #0;
1371   end;
1372
1373   procedure writeStrBuf ();
1374   begin
1375     if (strblen > 0) then writer(strbuf, strblen);
1376   end;
1377
1378   function i642str (n: Int64; hex: Boolean; hexup: Boolean): PAnsiChar;
1379   var
1380     neg: Boolean;
1381     xpos: Integer;
1382   begin
1383     if (n = $8000000000000000) then
1384     begin
1385       if hex then snprintf(@strbuf[0], Length(strbuf), '-8000000000000000')
1386       else snprintf(@strbuf[0], Length(strbuf), '-9223372036854775808');
1387       result := @strbuf[0];
1388     end
1389     else
1390     begin
1391       neg := (n < 0);
1392       if neg then n := -n;
1393       xpos := High(strbuf);
1394       strbuf[xpos] := #0; Dec(xpos);
1395       repeat
1396         if not hex then
1397         begin
1398           strbuf[xpos] := AnsiChar((n mod 10)+48);
1399           Dec(xpos);
1400           n := n div 10;
1401         end
1402         else
1403         begin
1404           if (n mod 16 > 9) then
1405           begin
1406             strbuf[xpos] := AnsiChar((n mod 16)+48+7);
1407             if not hexup then Inc(strbuf[xpos], 32);
1408           end
1409           else strbuf[xpos] := AnsiChar((n mod 16)+48);
1410           Dec(xpos);
1411           n := n div 16;
1412         end;
1413       until (n = 0);
1414       if neg then begin strbuf[xpos] := '-'; Dec(xpos); end;
1415       result := @strbuf[xpos+1];
1416     end;
1417   end;
1418
1419   function ui642str (n: UInt64; hex: Boolean; hexup: Boolean): PAnsiChar;
1420   var
1421     xpos: Integer;
1422   begin
1423     xpos := High(strbuf);
1424     strbuf[xpos] := #0; Dec(xpos);
1425     repeat
1426       if not hex then
1427       begin
1428         strbuf[xpos] := AnsiChar((n mod 10)+48);
1429         Dec(xpos);
1430         n := n div 10;
1431       end
1432       else
1433       begin
1434         if (n mod 16 > 9) then
1435         begin
1436           strbuf[xpos] := AnsiChar((n mod 16)+48+7);
1437           if not hexup then Inc(strbuf[xpos], 32);
1438         end
1439         else strbuf[xpos] := AnsiChar((n mod 16)+48);
1440         Dec(xpos);
1441         n := n div 16;
1442       end;
1443     until (n = 0);
1444     result := @strbuf[xpos+1];
1445   end;
1446
1447   procedure indent (len: Integer);
1448   var
1449     ilen: Integer;
1450   begin
1451     while (len > 0) do
1452     begin
1453       if (len > Length(PadSpaces)) then ilen := Length(PadSpaces) else ilen := len;
1454       writer(PAnsiChar(PadSpaces)^, ilen);
1455       Dec(len, ilen);
1456     end;
1457   end;
1458
1459   procedure indent0 (len: Integer);
1460   var
1461     ilen: Integer;
1462   begin
1463     while (len > 0) do
1464     begin
1465       if (len > Length(PadZeroes)) then ilen := Length(PadZeroes) else ilen := len;
1466       writer(PAnsiChar(PadZeroes)^, ilen);
1467       Dec(len, ilen);
1468     end;
1469   end;
1470
1471 begin
1472   result := '';
1473   spos := 1;
1474   while (spos <= Length(fmt)) do
1475   begin
1476     // print literal part
1477     epos := spos;
1478     while (epos <= Length(fmt)) and (fmt[epos] <> '%') do Inc(epos);
1479     // output literal part
1480     if (epos > spos) then
1481     begin
1482       if (epos > Length(fmt)) then
1483       begin
1484         writer((PAnsiChar(fmt)+spos-1)^, epos-spos);
1485         break;
1486       end;
1487            if (epos+1 > Length(fmt)) then Inc(epos) // last percent, output literally
1488       else if (fmt[epos+1] = '%') then // special case
1489       begin
1490         Inc(epos);
1491         writer((PAnsiChar(fmt)+spos-1)^, epos-spos);
1492         spos := epos+1;
1493       end
1494       else
1495       begin
1496         writer((PAnsiChar(fmt)+spos-1)^, epos-spos);
1497         spos := epos;
1498       end;
1499       continue;
1500     end;
1501     // check if we have argument for this format string
1502     if (curarg > High(args)) then
1503     begin
1504       xwrite('<OUT OF ARGS>');
1505       writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1);
1506       break;
1507     end;
1508     // skip percent
1509     if (spos+1 > Length(fmt)) then break; // oops
1510     assert(fmt[spos] = '%');
1511     Inc(spos);
1512     // parse format; check for sign
1513          if (fmt[spos] = '-') then begin sign := '-'; Inc(spos); end
1514     else if (fmt[spos] = '+') then begin sign := '+'; Inc(spos); end
1515     else sign := ' ';
1516     // parse width
1517     if (spos > Length(fmt)) then begin xwrite('<INVALID FORMAT>'); break; end;
1518     if (sign <> ' ') or ((fmt[spos] >= '0') and (fmt[spos] <= '9')) then
1519     begin
1520       if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1521       zeropad := (fmt[spos] = '0');
1522       width := 0;
1523       while (spos <= Length(fmt)) do
1524       begin
1525         ch := fmt[spos];
1526         if (ch < '0') or (ch > '9') then break;
1527         width := width*10+Integer(ch)-48;
1528         Inc(spos);
1529       end;
1530     end
1531     else
1532     begin
1533       width := -1;
1534       zeropad := false;
1535     end;
1536     // parse precision
1537     prec := -1;
1538     if (spos <= Length(fmt)) and (fmt[spos] = '.') then
1539     begin
1540       Inc(spos);
1541       if (spos > Length(fmt)) then begin xwrite('<INVALID FORMAT>'); break; end;
1542       if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1543       prec := 0;
1544       while (spos <= Length(fmt)) do
1545       begin
1546         ch := fmt[spos];
1547         if (ch < '0') or (ch > '9') then break;
1548         prec := prec*10+Integer(ch)-48;
1549         Inc(spos);
1550       end;
1551     end;
1552     // get format char
1553     if (spos > Length(fmt)) then begin xwrite('<INVALID FORMAT>'); break; end;
1554     fmtch := fmt[spos];
1555     Inc(spos);
1556     // done parsing format, check for valid format chars
1557     if not (fmtch in ['s','u','d','x','X','p','f','g','c']) then begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1558     // now write formatted string
1559     case args[curarg].VType of
1560       vtInteger: // args[curarg].VInteger
1561         begin
1562           if not (fmtch in ['s','u','d','x','X']) then begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1563           if (fmtch = 's') then fmtch := 'd';
1564           buildCFormat();
1565           strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], args[curarg].VInteger);
1566           writeStrBuf();
1567         end;
1568       vtBoolean: // args[curarg].VBoolean
1569         case fmtch of
1570           's':
1571             begin
1572               buildCFormat();
1573               if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], 'true')
1574               else strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], 'false');
1575               writeStrBuf();
1576             end;
1577           'c':
1578             begin
1579               buildCFormat();
1580               if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], AnsiChar('t'))
1581               else strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], AnsiChar('f'));
1582               writeStrBuf();
1583             end;
1584           'u', 'd', 'x', 'X':
1585             begin
1586               buildCFormat();
1587               strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(args[curarg].VBoolean));
1588               writeStrBuf();
1589             end;
1590           else
1591             begin
1592               xwrite('<INVALID FORMAT CHAR>');
1593               writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1);
1594               break;
1595             end;
1596         end;
1597       vtChar: // args[curarg].VChar
1598         case fmtch of
1599           's', 'c':
1600             begin
1601               fmtch := 'c';
1602               buildCFormat();
1603               strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], args[curarg].VChar);
1604               writeStrBuf();
1605             end;
1606           'u', 'd', 'x', 'X':
1607             begin
1608               buildCFormat();
1609               strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(args[curarg].VChar));
1610               writeStrBuf();
1611             end;
1612           else
1613             begin
1614               xwrite('<INVALID FORMAT CHAR>');
1615               writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1);
1616               break;
1617             end;
1618         end;
1619       //vtWideChar: begin end; // args[curarg].VWideChar (WideChar)
1620       vtExtended: // args[curarg].VExtended^
1621         case fmtch of
1622           's', 'g':
1623             begin
1624               fmtch := 'g';
1625               buildCFormat();
1626               strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Double(args[curarg].VExtended^));
1627               writeStrBuf();
1628             end;
1629           'f':
1630             begin
1631               buildCFormat();
1632               strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Double(args[curarg].VExtended^));
1633               writeStrBuf();
1634             end;
1635           'd':
1636             begin
1637               buildCFormat();
1638               strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(trunc(args[curarg].VExtended^)));
1639               writeStrBuf();
1640             end;
1641           'u', 'x', 'X':
1642             begin
1643               buildCFormat();
1644               strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], LongWord(trunc(args[curarg].VExtended^)));
1645               writeStrBuf();
1646             end;
1647           else
1648             begin
1649               xwrite('<INVALID FORMAT CHAR>');
1650               writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1);
1651               break;
1652             end;
1653         end;
1654       vtString: // args[curarg].VString^ (PShortString)
1655         begin
1656           if (sign <> '-') then indent(width-Length(args[curarg].VString^));
1657           writer(args[curarg].VString^[1], Length(args[curarg].VString^));
1658           if (sign = '-') then indent(width-Length(args[curarg].VString^));
1659         end;
1660       vtPointer: // args[curarg].VPointer
1661         case fmtch of
1662           's':
1663             begin
1664               fmtch := 'x';
1665               if (width < 8) then width := 8;
1666               zeropad := true;
1667               buildCFormat('0x');
1668               strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], PtrUInt(args[curarg].VPointer));
1669               writeStrBuf();
1670             end;
1671           'u', 'd', 'x', 'p', 'X':
1672             begin
1673               if (fmtch = 'p') then fmtch := 'x';
1674               if (width < 8) then width := 8;
1675               zeropad := true;
1676               buildCFormat('0x');
1677               strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], PtrUInt(args[curarg].VPointer));
1678               writeStrBuf();
1679             end;
1680           else
1681             begin
1682               xwrite('<INVALID FORMAT CHAR>');
1683               writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1);
1684               break;
1685             end;
1686         end;
1687       vtPChar: // args[curarg].VPChar
1688         if (args[curarg].VPChar = nil) then
1689         begin
1690           if (sign <> '-') then indent(width-3);
1691           xwrite('nil');
1692           if (sign = '-') then indent(width-3);
1693         end
1694         else
1695         begin
1696           pclen := 0;
1697           while (args[curarg].VPChar[pclen] <> #0) do Inc(pclen);
1698           if (sign <> '-') then indent(width-pclen);
1699           writer(args[curarg].VPChar^, pclen);
1700           if (sign = '-') then indent(width-pclen);
1701         end;
1702       vtObject: // args[curarg].VObject.Classname (TObject)
1703         begin
1704           if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := '<nil>';
1705           if (sign <> '-') then indent(width-Length(ccname));
1706           xwrite(ccname);
1707           if (sign = '-') then indent(width-Length(ccname));
1708         end;
1709       vtClass: // args[curarg].VClass.Classname (TClass)
1710         begin
1711           if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := '<nil>';
1712           if (sign <> '-') then indent(width-Length(ccname));
1713           xwrite(ccname);
1714           if (sign = '-') then indent(width-Length(ccname));
1715         end;
1716       //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
1717       vtAnsiString: // AnsiString(args[curarg].VAnsiString) (Pointer)
1718         begin
1719           if (sign <> '-') then indent(width-Length(AnsiString(args[curarg].VAnsiString)));
1720           xwrite(AnsiString(args[curarg].VAnsiString));
1721           if (sign = '-') then indent(width-Length(AnsiString(args[curarg].VAnsiString)));
1722         end;
1723       //vtCurrency: begin end; // args[curarg].VCurrency (PCurrency)
1724       //vtVariant: begin end; // args[curarg].VVariant^ (PVariant)
1725       //vtInterface: begin end; // args[curarg].VInterface (Pointer);
1726       //vtWideString: begin end; // args[curarg].VWideString (Pointer);
1727       vtInt64: // args[curarg].VInt64^ (PInt64)
1728         begin
1729           case fmtch of
1730             's','d','u': pc := i642str(args[curarg].VInt64^, false, false);
1731             'x': pc := i642str(args[curarg].VInt64^, true, false);
1732             'X': pc := i642str(args[curarg].VInt64^, true, true);
1733             else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1734           end;
1735           pclen := 0;
1736           while (pc[pclen] <> #0) do Inc(pclen);
1737           if (sign <> '-') and (width > pclen) then
1738           begin
1739             if zeropad then
1740             begin
1741               if (pc[0] = '-') or (pc[0] = '+') then
1742               begin
1743                 writer(pc^, 1);
1744                 indent0(width-pclen-1);
1745                 Inc(pc);
1746                 Dec(pclen);
1747               end
1748               else
1749               begin
1750                 indent0(width-pclen);
1751               end;
1752             end
1753             else
1754             begin
1755               indent(width-pclen);
1756             end;
1757           end;
1758           writer(pc^, pclen);
1759           if (sign = '-') then indent(width-pclen);
1760         end;
1761       vtQWord: // args[curarg].VQWord^ (PQWord)
1762         begin
1763           case fmtch of
1764             's','d','u': pc := ui642str(args[curarg].VInt64^, false, false);
1765             'x': pc := ui642str(args[curarg].VInt64^, true, false);
1766             'X': pc := ui642str(args[curarg].VInt64^, true, true);
1767             else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1768           end;
1769           pclen := 0;
1770           while (pc[pclen] <> #0) do Inc(pclen);
1771           if (sign <> '-') then begin if zeropad then indent0(width-pclen) else indent(width-pclen); end;
1772           writer(pc^, pclen);
1773           if (sign = '-') then indent(width-pclen);
1774         end;
1775       else
1776         begin
1777           xwrite('<INVALID TYPE>');
1778           writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1);
1779           break;
1780         end;
1781     end;
1782     Inc(curarg);
1783   end;
1784 end;
1785
1786
1787 (*
1788 var
1789   ss: ShortString;
1790   ls: AnsiString;
1791   i64: Int64 = -$A000000000;
1792   ui64: UInt64 = $A000000000;
1793 begin
1794   writef(conwriter, 'test int:<%s> bool:<%s:%02d:%c> bool:<%s:%02d:%c>; char:<%2s;%c;%d>!'#10, [42, true, true, true, false, false, false, 'A', 'A', 'A']);
1795   writef(conwriter, 'test float:<%s;%u;%f;%g>'#10, [666.6942, 666.6942, 666.6942, 666.6942]);
1796   ss := 'fuckit';
1797   ls := 'FUCKIT';
1798   writef(conwriter, 'test ss:<%5s;%040s>'#10, [ss, ss]);
1799   writef(conwriter, 'test ls:<%5s;%040s>'#10, [ls, ls]);
1800   writef(conwriter, 'test pointer:<%s;%x;%p>'#10, [@ss, @ss, @ss]);
1801   writef(conwriter, 'test i64:<%s;%x;%015d;%u;%X>'#10, [i64, i64, i64, i64, i64]);
1802   writef(conwriter, 'test ui64:<%s;%x;%15d;%015u;%X>'#10, [ui64, ui64, ui64, ui64, ui64]);
1803 *)
1804 end.