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 );
39 {$IF DEFINED(FREEBSD) OR DEFINED(DARWIN)}
41 {$ELSE}
43 {$ENDIF}
46 // ////////////////////////////////////////////////////////////////////////// //
47 type
49 public
54 private
57 public
60 public
69 // process one byte, return `true` if codepoint is ready
75 // ////////////////////////////////////////////////////////////////////////// //
80 // rewrites slashes to '/'
83 // replaces all the shitty characters with '_'
84 // (everything except alphanumerics, '_', '.')
90 // strips out name from `fn`, leaving trailing slash
93 // ends with '/' or '\'?
96 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
97 // will add slash to `path`, even if `fn` is empty!
100 // does filename have one of ".wad", ".pk3", ".zip" extensions?
103 // does filepath have ".XXX:\" in it?
106 // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip"
109 // check wad signature
112 // convert number to strig with nice commas
122 // `true` if strings are equal; ignoring case for cp1251
129 // findFileCI takes case-insensitive path, traverses it, and rewrites it to
130 // a case-sensetive one (using real on-disk names). return value means 'success'.
131 // if some dir or file wasn't found, pathname is undefined (destroyed, but not
132 // necessarily cleared).
133 // last name assumed to be a file, not directory (unless `lastIsDir` flag is set).
136 // findDiskWad tries to find the wad file using common wad extensions
137 // (see `wadExtensions` array).
138 // returns real on-disk filename, or empty string.
139 // original wad extension is used as a hint for the first try.
140 // also, this automatically performs `findFileCI()`.
142 // slashes must be normalized!
145 // they throws
148 // create file if necessary, but don't truncate the existing one
151 // little endian
179 // big endian
210 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
212 {$ENDIF}
224 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
226 {$ENDIF}
237 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
239 {$ENDIF}
241 type
244 // returns formatted string if `writerCB` is `nil`, empty string otherwise
245 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
252 // returns string in single or double quotes
253 // single quotes supports only pascal-style '' for single quote char
254 // double quotes supports c-style escapes
255 // function will select quote mode automatically
257 // separate single-quote and double-quote escape functions
262 type
264 private
265 //type PItemT = ^ItemT;
268 public
269 type
271 private
275 public
282 private
286 private
293 public
297 //WARNING! don't change list contents in `for ... in`!
307 public
319 type
324 // not changed by info getter; used in other parts of the code
334 implementation
336 uses
337 xstreams;
339 // ////////////////////////////////////////////////////////////////////////// //
341 begin
346 begin
351 begin
356 // ////////////////////////////////////////////////////////////////////////// //
357 // rewrites slashes to '/'
359 {$IFDEF WINDOWS}
360 var
362 {$ENDIF}
363 begin
365 {$IFDEF WINDOWS}
367 {$ENDIF}
370 // replaces all the shitty characters with '_'
371 // (everything except alphanumerics, '_', '.')
373 var
375 const
378 begin
386 begin
389 {$IFDEF WINDOWS}
391 if (length(s) > 2) and (s[2] = ':') and ((s[3] = '/') or (s[3] = '\')) then begin result := true; exit; end;
392 {$ELSE}
394 {$ENDIF}
399 begin
402 {$IFDEF WINDOWS}
404 if (length(s) = 3) and (s[2] = ':') and ((s[3] = '/') or (s[3] = '\')) then begin result := true; exit; end;
405 {$ELSE}
407 {$ENDIF}
411 // ////////////////////////////////////////////////////////////////////////// //
413 begin
420 begin
426 begin
431 // ////////////////////////////////////////////////////////////////////////// //
433 begin
441 begin
448 begin
454 begin
461 begin
468 begin
474 begin
481 begin
487 begin
493 var
495 begin
497 begin
507 var
509 begin
511 begin
518 var
520 begin
522 begin
525 end
526 else
527 begin
533 // ////////////////////////////////////////////////////////////////////////// //
534 var
539 // ////////////////////////////////////////////////////////////////////////// //
540 const
542 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
543 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$FFFD,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
544 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
545 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
546 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
547 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
548 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
550 );
554 var
556 begin
564 // ////////////////////////////////////////////////////////////////////////// //
565 // fast state-machine based UTF-8 decoder; using 8 bytes of memory
566 // code points from invalid range will never be valid, this is the property of the state machine
567 const
568 // see http://bjoern.hoehrmann.de/utf-8/decoder/dfa/
570 // maps bytes to character classes
587 // maps a combination of a state of the automaton and a character class to a state
597 // ////////////////////////////////////////////////////////////////////////// //
598 constructor TUtf8DecoderFast.Create (v: Boolean{fuck you, fpc}); begin state := Accept; codepoint := 0; end;
604 function TUtf8DecoderFast.completeOrInvalid (): Boolean; inline; begin result := (state = Accept) or (state = Reject); end;
606 function TUtf8DecoderFast.decode (c: AnsiChar): Boolean; inline; overload; begin result := decode(Byte(c)); end;
609 var
611 begin
614 if (state <> Accept) then codepoint := (b and $3f) or (codepoint shl 6) else codepoint := ($ff shr tp) and b;
621 // ////////////////////////////////////////////////////////////////////////// //
623 begin
629 // ////////////////////////////////////////////////////////////////////////// //
631 var
634 begin
636 begin
638 begin
642 begin
645 exit;
653 var
657 begin
660 begin
662 end
664 begin
667 end
669 begin
673 end
675 begin
680 end
681 else
682 begin
687 begin
689 begin
691 begin
694 begin
696 begin
698 end
699 else
700 begin
704 exit;
711 // ////////////////////////////////////////////////////////////////////////// //
713 begin
718 begin
721 end
722 else
723 begin
732 // ////////////////////////////////////////////////////////////////////////// //
734 var
736 begin
739 begin
747 var
750 begin
753 begin
761 begin
764 end
766 begin
769 end
770 else
771 begin
779 var
782 begin
784 begin
792 // ////////////////////////////////////////////////////////////////////////// //
794 var
797 begin
800 begin
803 begin
805 exit;
815 var
818 begin
823 begin
835 var
838 begin
842 begin
845 begin
847 begin
849 end
850 else
851 begin
854 exit;
861 begin
868 // strips out name from `fn`, leaving trailing slash
870 var
873 begin
878 begin
887 // ends with '/' or '\'?
889 begin
891 begin
893 end
894 else
895 begin
901 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
902 // will add slash to `path`, even if `fn` is empty!
904 var
906 begin
910 if (Length(result) > 0) and ((result[Length(result)] <> '/') and (result[Length(result)] <> '\')) then result += '/';
912 begin
914 //FIXME: make this faster!
915 while (Length(result) > 0) and ((result[Length(result)] = '/') or (result[Length(result)] = '\')) do
916 begin
925 var
927 begin
932 //result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip') or StrEquCI1251(ext, '.dfz');
937 begin
945 begin
947 Result :=
948 (* ZIP *)
951 (* PACK *)
954 (* DFWAD *)
955 ((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))
960 var
963 begin
967 begin
969 begin
972 begin
975 begin
977 begin
979 exit;
990 var
992 begin
996 begin
1003 begin
1005 begin
1007 end
1008 else
1009 begin
1011 begin
1013 end
1014 else
1015 begin
1027 begin
1029 begin
1031 end
1032 else
1033 begin
1035 begin
1037 end
1038 else
1039 begin
1050 begin
1055 begin
1061 var
1063 begin
1072 var
1075 begin
1077 begin
1079 begin
1083 exit;
1086 // nothing to do
1091 // ////////////////////////////////////////////////////////////////////////// //
1092 // utils
1093 // `ch`: utf8 start
1094 // -1: invalid utf8
1096 begin
1108 var
1110 begin
1114 begin
1120 // check other sequence bytes
1122 begin
1132 // ////////////////////////////////////////////////////////////////////////// //
1133 const
1135 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
1136 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
1137 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
1138 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
1139 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
1140 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
1141 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
1142 $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
1143 );
1147 var
1149 begin
1150 (* The following encodings are valid, except for the 5 and 6 byte
1151 * combinations:
1152 * 0xxxxxxx
1153 * 110xxxxx 10xxxxxx
1154 * 1110xxxx 10xxxxxx 10xxxxxx
1155 * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
1156 * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1157 * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1158 *)
1166 // mask out unused bits
1174 // now continue
1176 begin
1184 // done, try 1251
1186 // alas
1191 var
1193 begin
1197 begin
1208 // ////////////////////////////////////////////////////////////////////////// //
1209 // findFileCI eats case-insensitive path, traverses it and rewrites it to a
1210 // case-sensetive. result value means success.
1211 // if file/dir not founded than pathname is in undefined state!
1213 var
1221 begin
1226 begin
1227 // remove trailing slashes
1230 // extract name
1233 begin
1237 // remove trailing slashes again
1240 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1241 // try the easiest case first
1244 begin
1246 begin
1247 // i found her!
1250 continue;
1253 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1254 // alas, either not found, or invalid attributes
1256 try
1258 repeat
1260 begin
1261 // i found her!
1265 break;
1268 finally
1278 var
1281 begin
1284 // check first ext
1287 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1289 // check second ext
1292 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1300 var
1303 begin
1305 //writeln('findDiskWad00: fname=<', fname, '>');
1309 //writeln(' findDiskWad01: fname=<', fname, '>; origExt=<', origExt, '>');
1311 begin
1312 //writeln(' findDiskWad02: fname=<', fname, '>; origExt=<', origExt, '>; newExt=<', newExt, '>');
1314 begin
1315 //writeln(' SKIP');
1316 continue;
1326 begin
1327 if not findFileCI(pathname) then raise EFileNotFoundException.Create('can''t open file "'+pathname+'"');
1332 var
1334 begin
1337 begin
1338 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1345 var
1348 begin
1349 //writeln('*** TRYING R/W FILE "', pathname, '"');
1352 begin
1353 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1357 begin
1358 //writeln('*** found old file "', oldname, '"');
1360 end
1361 else
1362 begin
1369 {$IFDEF ENDIAN_LITTLE}
1370 begin
1373 {$ELSE}
1374 var
1376 begin
1379 begin
1385 {$ENDIF}
1388 {$IFDEF ENDIAN_LITTLE}
1389 var
1391 begin
1394 begin
1400 {$ELSE}
1401 begin
1404 {$ENDIF}
1407 begin
1412 var
1415 begin
1418 begin
1420 begin
1423 end
1424 else
1425 begin
1427 begin
1446 procedure writeIntBE (st: TStream; v: ShortInt); overload; begin writeIntegerBE(st, @v, 1); end;
1448 procedure writeIntBE (st: TStream; v: SmallInt); overload; begin writeIntegerBE(st, @v, 2); end;
1449 procedure writeIntBE (st: TStream; v: LongWord); overload; begin writeIntegerBE(st, @v, 4); end;
1450 procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(st, @v, 4); end;
1459 begin
1461 if (maxlen <= 65535) then writeInt(st, Word(Length(str))) else writeInt(st, LongWord(Length(str)));
1466 var
1468 begin
1473 begin
1481 {$IFDEF ENDIAN_LITTLE}
1482 begin
1485 {$ELSE}
1486 var
1488 begin
1491 begin
1497 {$ENDIF}
1500 {$IFDEF ENDIAN_LITTLE}
1501 var
1503 begin
1506 begin
1512 {$ELSE}
1513 begin
1516 {$ENDIF}
1537 // ////////////////////////////////////////////////////////////////////////// //
1538 function nlerp (a, b: Integer; t: Single): Integer; inline; begin result := round((1.0 - t) * a + t * b); end;
1540 function nmin (a, b: Byte): Byte; inline; overload; begin if (a < b) then result := a else result := b; end;
1541 function nmin (a, b: ShortInt): ShortInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1542 function nmin (a, b: Word): Word; inline; overload; begin if (a < b) then result := a else result := b; end;
1543 function nmin (a, b: SmallInt): SmallInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1544 function nmin (a, b: LongWord): LongWord; inline; overload; begin if (a < b) then result := a else result := b; end;
1545 function nmin (a, b: LongInt): LongInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1546 function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then result := a else result := b; end;
1547 function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end;
1548 function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end;
1549 function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end;
1550 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1551 function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end;
1552 {$ENDIF}
1554 function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end;
1555 function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1556 function nmax (a, b: Word): Word; inline; overload; begin if (a > b) then result := a else result := b; end;
1557 function nmax (a, b: SmallInt): SmallInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1558 function nmax (a, b: LongWord): LongWord; inline; overload; begin if (a > b) then result := a else result := b; end;
1559 function nmax (a, b: LongInt): LongInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1560 function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then result := a else result := b; end;
1561 function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end;
1562 function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end;
1563 function nmax (a, b: Double): Double; inline; overload; begin if (a > b) then result := a else result := b; end;
1564 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1565 function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end;
1566 {$ENDIF}
1568 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;
1569 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;
1570 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;
1571 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;
1572 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;
1573 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;
1574 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;
1575 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;
1576 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;
1577 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;
1578 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1579 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;
1580 {$ENDIF}
1582 // ////////////////////////////////////////////////////////////////////////// //
1583 {$IFDEF WINDOWS}
1584 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf';
1585 {$ELSE}
1586 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'libc' name 'snprintf';
1587 {$ENDIF}
1590 (*
1591 procedure conwriter (constref buf; len: SizeUInt);
1592 var
1593 ss: ShortString;
1594 slen: Integer;
1595 b: PByte;
1596 begin
1597 if (len < 1) then exit;
1598 b := PByte(@buf);
1599 while (len > 0) do
1600 begin
1601 if (len > 255) then slen := 255 else slen := Integer(len);
1602 Move(b^, ss[1], len);
1603 ss[0] := AnsiChar(slen);
1604 write(ss);
1605 b += slen;
1606 len -= slen;
1607 end;
1608 end;
1609 *)
1612 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1613 const
1615 PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
1616 var
1632 var
1636 begin
1640 begin
1642 end
1643 else
1644 begin
1646 begin
1658 begin
1663 begin
1669 var
1671 begin
1677 var
1679 begin
1685 begin
1689 begin
1699 begin
1704 var
1707 begin
1709 begin
1713 end
1714 else
1715 begin
1720 repeat
1722 begin
1726 end
1727 else
1728 begin
1730 begin
1733 end
1745 var
1747 begin
1750 repeat
1752 begin
1756 end
1757 else
1758 begin
1760 begin
1763 end
1773 var
1775 begin
1777 begin
1785 var
1787 begin
1789 begin
1796 begin
1800 begin
1801 // print literal part
1804 // output literal part
1806 begin
1808 begin
1810 break;
1814 begin
1818 end
1819 else
1820 begin
1824 continue;
1826 // check if we have argument for this format string
1828 begin
1831 break;
1833 // skip percent
1837 // parse format; check for sign
1841 // parse width
1844 begin
1845 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1849 begin
1855 end
1856 else
1857 begin
1861 // parse precision
1864 begin
1867 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1870 begin
1877 // get format char
1881 // done parsing format, check for valid format chars
1882 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;
1883 // now write formatted string
1886 begin
1887 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;
1896 begin
1898 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], 'true')
1903 begin
1905 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], AnsiChar('t'))
1910 begin
1915 else
1916 begin
1919 break;
1925 begin
1932 begin
1937 else
1938 begin
1941 break;
1944 //vtWideChar: begin end; // args[curarg].VWideChar (WideChar)
1948 begin
1955 begin
1961 begin
1963 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(trunc(args[curarg].VExtended^)));
1967 begin
1969 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], LongWord(trunc(args[curarg].VExtended^)));
1972 else
1973 begin
1976 break;
1980 begin
1988 begin
1997 begin
2005 else
2006 begin
2009 break;
2014 begin
2018 end
2019 else
2020 begin
2028 begin
2029 if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := '<nil>';
2035 begin
2036 if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := '<nil>';
2041 //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
2043 begin
2048 //vtCurrency: begin end; // args[curarg].VCurrency (PCurrency)
2049 //vtVariant: begin end; // args[curarg].VVariant^ (PVariant)
2050 //vtInterface: begin end; // args[curarg].VInterface (Pointer);
2051 //vtWideString: begin end; // args[curarg].VWideString (Pointer);
2053 begin
2058 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2063 begin
2065 begin
2067 begin
2072 end
2073 else
2074 begin
2077 end
2078 else
2079 begin
2087 begin
2092 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2096 if (sign <> '-') then begin if zeropad then indent0(width-pclen) else indent(width-pclen); end;
2100 else
2101 begin
2104 break;
2113 var
2117 begin
2121 // get age
2124 // get size
2130 // fill info
2138 (*
2139 var
2140 ss: ShortString;
2141 ls: AnsiString;
2142 i64: Int64 = -$A000000000;
2143 ui64: UInt64 = $A000000000;
2144 begin
2145 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']);
2146 writef(conwriter, 'test float:<%s;%u;%f;%g>'#10, [666.6942, 666.6942, 666.6942, 666.6942]);
2147 ss := 'fuckit';
2148 ls := 'FUCKIT';
2149 writef(conwriter, 'test ss:<%5s;%040s>'#10, [ss, ss]);
2150 writef(conwriter, 'test ls:<%5s;%040s>'#10, [ls, ls]);
2151 writef(conwriter, 'test pointer:<%s;%x;%p>'#10, [@ss, @ss, @ss]);
2152 writef(conwriter, 'test i64:<%s;%x;%015d;%u;%X>'#10, [i64, i64, i64, i64, i64]);
2153 writef(conwriter, 'test ui64:<%s;%x;%15d;%015u;%X>'#10, [ui64, ui64, ui64, ui64, ui64]);
2154 *)