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