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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE a_modes.inc}
18 interface
20 uses
24 // ////////////////////////////////////////////////////////////////////////// //
25 type
36 '.dfzip'
37 );
40 // ////////////////////////////////////////////////////////////////////////// //
41 type
43 public
48 private
51 public
54 public
63 // process one byte, return `true` if codepoint is ready
69 // ////////////////////////////////////////////////////////////////////////// //
74 // rewrites slashes to '/'
77 // replaces all the shitty characters with '_'
78 // (everything except alphanumerics, '_', '.')
84 // strips out name from `fn`, leaving trailing slash
87 // ends with '/' or '\'?
90 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
91 // will add slash to `path`, even if `fn` is empty!
94 // does filename have one of ".wad", ".pk3", ".zip" extensions?
97 // does filepath have ".XXX:\" in it?
100 // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip"
103 // check wad signature
106 // convert number to strig with nice commas
116 // `true` if strings are equal; ignoring case for cp1251
123 // findFileCI takes case-insensitive path, traverses it, and rewrites it to
124 // a case-sensetive one (using real on-disk names). return value means 'success'.
125 // if some dir or file wasn't found, pathname is undefined (destroyed, but not
126 // necessarily cleared).
127 // last name assumed to be a file, not directory (unless `lastIsDir` flag is set).
130 // findDiskWad tries to find the wad file using common wad extensions
131 // (see `wadExtensions` array).
132 // returns real on-disk filename, or empty string.
133 // original wad extension is used as a hint for the first try.
134 // also, this automatically performs `findFileCI()`.
136 // slashes must be normalized!
139 // they throws
142 // create file if necessary, but don't truncate the existing one
145 // little endian
173 // big endian
204 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
206 {$ENDIF}
218 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
220 {$ENDIF}
231 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
233 {$ENDIF}
235 type
238 // returns formatted string if `writerCB` is `nil`, empty string otherwise
239 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
246 // returns string in single or double quotes
247 // single quotes supports only pascal-style '' for single quote char
248 // double quotes supports c-style escapes
249 // function will select quote mode automatically
251 // separate single-quote and double-quote escape functions
256 type
258 private
259 //type PItemT = ^ItemT;
262 public
263 type
265 private
269 public
276 private
280 private
287 public
291 //WARNING! don't change list contents in `for ... in`!
301 public
313 type
318 // not changed by info getter; used in other parts of the code
328 implementation
330 uses
331 xstreams;
333 // ////////////////////////////////////////////////////////////////////////// //
335 begin
340 begin
345 begin
350 // ////////////////////////////////////////////////////////////////////////// //
351 // rewrites slashes to '/'
353 {$IFDEF WINDOWS}
354 var
356 {$ENDIF}
357 begin
359 {$IFDEF WINDOWS}
361 {$ENDIF}
364 // replaces all the shitty characters with '_'
365 // (everything except alphanumerics, '_', '.')
367 var
369 const
372 begin
380 begin
383 {$IFDEF WINDOWS}
385 if (length(s) > 2) and (s[2] = ':') and ((s[3] = '/') or (s[3] = '\')) then begin result := true; exit; end;
386 {$ELSE}
388 {$ENDIF}
393 begin
396 {$IFDEF WINDOWS}
398 if (length(s) = 3) and (s[2] = ':') and ((s[3] = '/') or (s[3] = '\')) then begin result := true; exit; end;
399 {$ELSE}
401 {$ENDIF}
405 // ////////////////////////////////////////////////////////////////////////// //
407 begin
414 begin
420 begin
425 // ////////////////////////////////////////////////////////////////////////// //
427 begin
435 begin
442 begin
448 begin
455 begin
462 begin
468 begin
475 begin
481 begin
487 var
489 begin
491 begin
501 var
503 begin
505 begin
512 var
514 begin
516 begin
519 end
520 else
521 begin
527 // ////////////////////////////////////////////////////////////////////////// //
528 var
533 // ////////////////////////////////////////////////////////////////////////// //
534 const
536 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
537 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$FFFD,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
538 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
539 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
540 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
541 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
542 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
544 );
548 var
550 begin
558 // ////////////////////////////////////////////////////////////////////////// //
559 // fast state-machine based UTF-8 decoder; using 8 bytes of memory
560 // code points from invalid range will never be valid, this is the property of the state machine
561 const
562 // see http://bjoern.hoehrmann.de/utf-8/decoder/dfa/
564 // maps bytes to character classes
581 // maps a combination of a state of the automaton and a character class to a state
591 // ////////////////////////////////////////////////////////////////////////// //
592 constructor TUtf8DecoderFast.Create (v: Boolean{fuck you, fpc}); begin state := Accept; codepoint := 0; end;
598 function TUtf8DecoderFast.completeOrInvalid (): Boolean; inline; begin result := (state = Accept) or (state = Reject); end;
600 function TUtf8DecoderFast.decode (c: AnsiChar): Boolean; inline; overload; begin result := decode(Byte(c)); end;
603 var
605 begin
608 if (state <> Accept) then codepoint := (b and $3f) or (codepoint shl 6) else codepoint := ($ff shr tp) and b;
615 // ////////////////////////////////////////////////////////////////////////// //
617 begin
623 // ////////////////////////////////////////////////////////////////////////// //
625 var
628 begin
630 begin
632 begin
636 begin
639 exit;
647 var
651 begin
654 begin
656 end
658 begin
661 end
663 begin
667 end
669 begin
674 end
675 else
676 begin
681 begin
683 begin
685 begin
688 begin
690 begin
692 end
693 else
694 begin
698 exit;
705 // ////////////////////////////////////////////////////////////////////////// //
707 begin
712 begin
715 end
716 else
717 begin
726 // ////////////////////////////////////////////////////////////////////////// //
728 var
730 begin
733 begin
741 var
744 begin
747 begin
755 begin
758 end
760 begin
763 end
764 else
765 begin
773 var
776 begin
778 begin
786 // ////////////////////////////////////////////////////////////////////////// //
788 var
791 begin
794 begin
797 begin
799 exit;
809 var
812 begin
817 begin
829 var
832 begin
836 begin
839 begin
841 begin
843 end
844 else
845 begin
848 exit;
855 begin
862 // strips out name from `fn`, leaving trailing slash
864 var
867 begin
872 begin
881 // ends with '/' or '\'?
883 begin
885 begin
887 end
888 else
889 begin
895 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
896 // will add slash to `path`, even if `fn` is empty!
898 var
900 begin
904 if (Length(result) > 0) and ((result[Length(result)] <> '/') and (result[Length(result)] <> '\')) then result += '/';
906 begin
908 //FIXME: make this faster!
909 while (Length(result) > 0) and ((result[Length(result)] = '/') or (result[Length(result)] = '\')) do
910 begin
919 var
921 begin
926 //result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip') or StrEquCI1251(ext, '.dfz');
931 begin
939 begin
941 Result :=
942 (* ZIP *)
945 (* PACK *)
948 (* DFWAD *)
949 ((len > 5) and (p[0] = 'D') and (p[1] = 'F') and (p[2] = 'W') and (p[3] = 'A') and (p[4] = 'D') and (p[5] = #01))
954 var
957 begin
961 begin
963 begin
966 begin
969 begin
971 begin
973 exit;
984 var
986 begin
990 begin
997 begin
999 begin
1001 end
1002 else
1003 begin
1005 begin
1007 end
1008 else
1009 begin
1021 begin
1023 begin
1025 end
1026 else
1027 begin
1029 begin
1031 end
1032 else
1033 begin
1044 begin
1049 begin
1055 var
1057 begin
1066 var
1069 begin
1071 begin
1073 begin
1077 exit;
1080 // nothing to do
1085 // ////////////////////////////////////////////////////////////////////////// //
1086 // utils
1087 // `ch`: utf8 start
1088 // -1: invalid utf8
1090 begin
1102 var
1104 begin
1108 begin
1114 // check other sequence bytes
1116 begin
1126 // ////////////////////////////////////////////////////////////////////////// //
1127 const
1129 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
1130 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
1131 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
1132 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
1133 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
1134 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
1135 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
1136 $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
1137 );
1141 var
1143 begin
1144 (* The following encodings are valid, except for the 5 and 6 byte
1145 * combinations:
1146 * 0xxxxxxx
1147 * 110xxxxx 10xxxxxx
1148 * 1110xxxx 10xxxxxx 10xxxxxx
1149 * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
1150 * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1151 * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1152 *)
1160 // mask out unused bits
1168 // now continue
1170 begin
1178 // done, try 1251
1180 // alas
1185 var
1187 begin
1191 begin
1202 // ////////////////////////////////////////////////////////////////////////// //
1203 // findFileCI eats case-insensitive path, traverses it and rewrites it to a
1204 // case-sensetive. result value means success.
1205 // if file/dir not founded than pathname is in undefined state!
1207 var
1215 begin
1220 begin
1221 // remove trailing slashes
1224 // extract name
1227 begin
1231 // remove trailing slashes again
1234 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1235 // try the easiest case first
1238 begin
1240 begin
1241 // i found her!
1244 continue;
1247 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1248 // alas, either not found, or invalid attributes
1250 try
1252 repeat
1254 begin
1255 // i found her!
1259 break;
1262 finally
1272 var
1275 begin
1278 // check first ext
1281 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1283 // check second ext
1286 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1294 var
1297 begin
1299 //writeln('findDiskWad00: fname=<', fname, '>');
1303 //writeln(' findDiskWad01: fname=<', fname, '>; origExt=<', origExt, '>');
1305 begin
1306 //writeln(' findDiskWad02: fname=<', fname, '>; origExt=<', origExt, '>; newExt=<', newExt, '>');
1308 begin
1309 //writeln(' SKIP');
1310 continue;
1320 begin
1321 if not findFileCI(pathname) then raise EFileNotFoundException.Create('can''t open file "'+pathname+'"');
1326 var
1328 begin
1331 begin
1332 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1339 var
1342 begin
1343 //writeln('*** TRYING R/W FILE "', pathname, '"');
1346 begin
1347 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1351 begin
1352 //writeln('*** found old file "', oldname, '"');
1354 end
1355 else
1356 begin
1363 {$IFDEF ENDIAN_LITTLE}
1364 begin
1367 {$ELSE}
1368 var
1370 begin
1373 begin
1379 {$ENDIF}
1382 {$IFDEF ENDIAN_LITTLE}
1383 var
1385 begin
1388 begin
1394 {$ELSE}
1395 begin
1398 {$ENDIF}
1401 begin
1406 var
1409 begin
1412 begin
1414 begin
1417 end
1418 else
1419 begin
1421 begin
1440 procedure writeIntBE (st: TStream; v: ShortInt); overload; begin writeIntegerBE(st, @v, 1); end;
1442 procedure writeIntBE (st: TStream; v: SmallInt); overload; begin writeIntegerBE(st, @v, 2); end;
1443 procedure writeIntBE (st: TStream; v: LongWord); overload; begin writeIntegerBE(st, @v, 4); end;
1444 procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(st, @v, 4); end;
1453 begin
1455 if (maxlen <= 65535) then writeInt(st, Word(Length(str))) else writeInt(st, LongWord(Length(str)));
1460 var
1462 begin
1467 begin
1475 {$IFDEF ENDIAN_LITTLE}
1476 begin
1479 {$ELSE}
1480 var
1482 begin
1485 begin
1491 {$ENDIF}
1494 {$IFDEF ENDIAN_LITTLE}
1495 var
1497 begin
1500 begin
1506 {$ELSE}
1507 begin
1510 {$ENDIF}
1531 // ////////////////////////////////////////////////////////////////////////// //
1532 function nlerp (a, b: Integer; t: Single): Integer; inline; begin result := round((1.0 - t) * a + t * b); end;
1534 function nmin (a, b: Byte): Byte; inline; overload; begin if (a < b) then result := a else result := b; end;
1535 function nmin (a, b: ShortInt): ShortInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1536 function nmin (a, b: Word): Word; inline; overload; begin if (a < b) then result := a else result := b; end;
1537 function nmin (a, b: SmallInt): SmallInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1538 function nmin (a, b: LongWord): LongWord; inline; overload; begin if (a < b) then result := a else result := b; end;
1539 function nmin (a, b: LongInt): LongInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1540 function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then result := a else result := b; end;
1541 function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end;
1542 function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end;
1543 function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end;
1544 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1545 function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end;
1546 {$ENDIF}
1548 function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end;
1549 function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1550 function nmax (a, b: Word): Word; inline; overload; begin if (a > b) then result := a else result := b; end;
1551 function nmax (a, b: SmallInt): SmallInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1552 function nmax (a, b: LongWord): LongWord; inline; overload; begin if (a > b) then result := a else result := b; end;
1553 function nmax (a, b: LongInt): LongInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1554 function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then result := a else result := b; end;
1555 function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end;
1556 function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end;
1557 function nmax (a, b: Double): Double; inline; overload; begin if (a > b) then result := a else result := b; end;
1558 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1559 function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end;
1560 {$ENDIF}
1562 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;
1563 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;
1564 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;
1565 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;
1566 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;
1567 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;
1568 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;
1569 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;
1570 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;
1571 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;
1572 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1573 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;
1574 {$ENDIF}
1576 // ////////////////////////////////////////////////////////////////////////// //
1577 {$IFDEF WINDOWS}
1578 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf';
1579 {$ELSE}
1580 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'libc' name 'snprintf';
1581 {$ENDIF}
1584 (*
1585 procedure conwriter (constref buf; len: SizeUInt);
1586 var
1587 ss: ShortString;
1588 slen: Integer;
1589 b: PByte;
1590 begin
1591 if (len < 1) then exit;
1592 b := PByte(@buf);
1593 while (len > 0) do
1594 begin
1595 if (len > 255) then slen := 255 else slen := Integer(len);
1596 Move(b^, ss[1], len);
1597 ss[0] := AnsiChar(slen);
1598 write(ss);
1599 b += slen;
1600 len -= slen;
1601 end;
1602 end;
1603 *)
1606 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1607 const
1609 PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
1610 var
1626 var
1630 begin
1634 begin
1636 end
1637 else
1638 begin
1640 begin
1652 begin
1657 begin
1663 var
1665 begin
1671 var
1673 begin
1679 begin
1683 begin
1693 begin
1698 var
1701 begin
1703 begin
1707 end
1708 else
1709 begin
1714 repeat
1716 begin
1720 end
1721 else
1722 begin
1724 begin
1727 end
1739 var
1741 begin
1744 repeat
1746 begin
1750 end
1751 else
1752 begin
1754 begin
1757 end
1767 var
1769 begin
1771 begin
1779 var
1781 begin
1783 begin
1790 begin
1794 begin
1795 // print literal part
1798 // output literal part
1800 begin
1802 begin
1804 break;
1808 begin
1812 end
1813 else
1814 begin
1818 continue;
1820 // check if we have argument for this format string
1822 begin
1825 break;
1827 // skip percent
1831 // parse format; check for sign
1835 // parse width
1838 begin
1839 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1843 begin
1849 end
1850 else
1851 begin
1855 // parse precision
1858 begin
1861 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1864 begin
1871 // get format char
1875 // done parsing format, check for valid format chars
1876 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;
1877 // now write formatted string
1880 begin
1881 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;
1890 begin
1892 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], 'true')
1897 begin
1899 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], AnsiChar('t'))
1904 begin
1909 else
1910 begin
1913 break;
1919 begin
1926 begin
1931 else
1932 begin
1935 break;
1938 //vtWideChar: begin end; // args[curarg].VWideChar (WideChar)
1942 begin
1949 begin
1955 begin
1957 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(trunc(args[curarg].VExtended^)));
1961 begin
1963 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], LongWord(trunc(args[curarg].VExtended^)));
1966 else
1967 begin
1970 break;
1974 begin
1982 begin
1991 begin
1999 else
2000 begin
2003 break;
2008 begin
2012 end
2013 else
2014 begin
2022 begin
2023 if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := '<nil>';
2029 begin
2030 if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := '<nil>';
2035 //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
2037 begin
2042 //vtCurrency: begin end; // args[curarg].VCurrency (PCurrency)
2043 //vtVariant: begin end; // args[curarg].VVariant^ (PVariant)
2044 //vtInterface: begin end; // args[curarg].VInterface (Pointer);
2045 //vtWideString: begin end; // args[curarg].VWideString (Pointer);
2047 begin
2052 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2057 begin
2059 begin
2061 begin
2066 end
2067 else
2068 begin
2071 end
2072 else
2073 begin
2081 begin
2086 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2090 if (sign <> '-') then begin if zeropad then indent0(width-pclen) else indent(width-pclen); end;
2094 else
2095 begin
2098 break;
2107 var
2111 begin
2115 // get age
2118 // get size
2124 // fill info
2132 (*
2133 var
2134 ss: ShortString;
2135 ls: AnsiString;
2136 i64: Int64 = -$A000000000;
2137 ui64: UInt64 = $A000000000;
2138 begin
2139 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']);
2140 writef(conwriter, 'test float:<%s;%u;%f;%g>'#10, [666.6942, 666.6942, 666.6942, 666.6942]);
2141 ss := 'fuckit';
2142 ls := 'FUCKIT';
2143 writef(conwriter, 'test ss:<%5s;%040s>'#10, [ss, ss]);
2144 writef(conwriter, 'test ls:<%5s;%040s>'#10, [ls, ls]);
2145 writef(conwriter, 'test pointer:<%s;%x;%p>'#10, [@ss, @ss, @ss]);
2146 writef(conwriter, 'test i64:<%s;%x;%015d;%u;%X>'#10, [i64, i64, i64, i64, i64]);
2147 writef(conwriter, 'test ui64:<%s;%x;%15d;%015u;%X>'#10, [ui64, ui64, ui64, ui64, ui64]);
2148 *)