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