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 '/'
80 // strips out name from `fn`, leaving trailing slash
83 // ends with '/' or '\'?
86 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
87 // will add slash to `path`, even if `fn` is empty!
90 // does filename have one of ".wad", ".pk3", ".zip" extensions?
93 // does filepath have ".XXX:\" in it?
96 // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip"
99 // check wad signature
102 // convert number to strig with nice commas
112 // `true` if strings are equal; ignoring case for cp1251
119 // findFileCI takes case-insensitive path, traverses it, and rewrites it to
120 // a case-sensetive one (using real on-disk names). return value means 'success'.
121 // if some dir or file wasn't found, pathname is undefined (destroyed, but not
122 // necessarily cleared).
123 // last name assumed to be a file, not directory (unless `lastIsDir` flag is set).
126 // findDiskWad tries to find the wad file using common wad extensions
127 // (see `wadExtensions` array).
128 // returns real on-disk filename, or empty string.
129 // original wad extension is used as a hint for the first try.
130 // also, this automatically performs `findFileCI()`.
132 // slashes must be normalized!
135 // they throws
138 // create file if necessary, but don't truncate the existing one
141 // little endian
169 // big endian
199 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
201 {$ENDIF}
213 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
215 {$ENDIF}
226 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
228 {$ENDIF}
230 type
233 // returns formatted string if `writerCB` is `nil`, empty string otherwise
234 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
241 // returns string in single or double quotes
242 // single quotes supports only pascal-style '' for single quote char
243 // double quotes supports c-style escapes
244 // function will select quote mode automatically
248 type
250 private
251 //type PItemT = ^ItemT;
254 public
255 type
257 private
261 public
268 private
272 private
279 public
283 //WARNING! don't change list contents in `for ... in`!
293 public
305 type
310 // not changed by info getter; used in other parts of the code
320 implementation
322 uses
323 xstreams;
325 // ////////////////////////////////////////////////////////////////////////// //
327 begin
332 begin
337 begin
342 // ////////////////////////////////////////////////////////////////////////// //
343 // rewrites slashes to '/'
345 var
347 begin
354 begin
357 {$IFDEF WINDOWS}
359 if (length(s) > 2) and (s[2] = ':') and ((s[3] = '/') or (s[3] = '\')) then begin result := true; exit; end;
360 {$ELSE}
362 {$ENDIF}
367 begin
370 {$IFDEF WINDOWS}
372 if (length(s) = 3) and (s[2] = ':') and ((s[3] = '/') or (s[3] = '\')) then begin result := true; exit; end;
373 {$ELSE}
375 {$ENDIF}
379 // ////////////////////////////////////////////////////////////////////////// //
381 begin
388 begin
394 begin
399 // ////////////////////////////////////////////////////////////////////////// //
401 begin
409 begin
416 begin
422 begin
429 begin
436 begin
442 begin
449 begin
455 begin
461 var
463 begin
465 begin
475 var
477 begin
479 begin
486 var
488 begin
490 begin
493 end
494 else
495 begin
501 // ////////////////////////////////////////////////////////////////////////// //
502 var
507 // ////////////////////////////////////////////////////////////////////////// //
508 const
510 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
511 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
512 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
513 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
514 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
515 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
516 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
518 );
522 var
524 begin
532 // ////////////////////////////////////////////////////////////////////////// //
533 // fast state-machine based UTF-8 decoder; using 8 bytes of memory
534 // code points from invalid range will never be valid, this is the property of the state machine
535 const
536 // see http://bjoern.hoehrmann.de/utf-8/decoder/dfa/
538 // maps bytes to character classes
555 // maps a combination of a state of the automaton and a character class to a state
565 // ////////////////////////////////////////////////////////////////////////// //
566 constructor TUtf8DecoderFast.Create (v: Boolean{fuck you, fpc}); begin state := Accept; codepoint := 0; end;
572 function TUtf8DecoderFast.completeOrInvalid (): Boolean; inline; begin result := (state = Accept) or (state = Reject); end;
574 function TUtf8DecoderFast.decode (c: AnsiChar): Boolean; inline; overload; begin result := decode(Byte(c)); end;
577 var
579 begin
582 if (state <> Accept) then codepoint := (b and $3f) or (codepoint shl 6) else codepoint := ($ff shr tp) and b;
589 // ////////////////////////////////////////////////////////////////////////// //
591 begin
597 // ////////////////////////////////////////////////////////////////////////// //
599 var
602 begin
604 begin
606 begin
610 begin
613 exit;
621 var
625 begin
628 begin
630 end
632 begin
635 end
637 begin
641 end
643 begin
648 end
649 else
650 begin
655 begin
657 begin
659 begin
662 begin
664 begin
666 end
667 else
668 begin
672 exit;
679 // ////////////////////////////////////////////////////////////////////////// //
681 begin
686 begin
689 end
690 else
691 begin
700 // ////////////////////////////////////////////////////////////////////////// //
704 var
706 begin
709 begin
717 var
720 begin
723 begin
731 begin
734 end
736 begin
739 end
740 else
741 begin
748 var
751 begin
753 begin
761 // ////////////////////////////////////////////////////////////////////////// //
763 var
766 begin
769 begin
772 begin
774 exit;
784 var
787 begin
792 begin
804 var
807 begin
811 begin
814 begin
816 begin
818 end
819 else
820 begin
823 exit;
830 begin
837 // strips out name from `fn`, leaving trailing slash
839 var
842 begin
847 begin
856 // ends with '/' or '\'?
858 begin
860 begin
862 end
863 else
864 begin
870 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
871 // will add slash to `path`, even if `fn` is empty!
873 var
875 begin
879 if (Length(result) > 0) and ((result[Length(result)] <> '/') and (result[Length(result)] <> '\')) then result += '/';
881 begin
883 //FIXME: make this faster!
884 while (Length(result) > 0) and ((result[Length(result)] = '/') or (result[Length(result)] = '\')) do
885 begin
894 var
896 begin
901 //result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip') or StrEquCI1251(ext, '.dfz');
906 begin
914 begin
916 Result :=
917 (* ZIP *)
920 (* PACK *)
923 (* DFWAD *)
924 ((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))
929 var
932 begin
936 begin
938 begin
941 begin
944 begin
946 begin
948 exit;
959 var
961 begin
965 begin
972 begin
974 begin
976 end
977 else
978 begin
980 begin
982 end
983 else
984 begin
996 begin
998 begin
1000 end
1001 else
1002 begin
1004 begin
1006 end
1007 else
1008 begin
1019 begin
1024 begin
1030 var
1032 begin
1041 var
1044 begin
1046 begin
1048 begin
1052 exit;
1055 // nothing to do
1060 // ////////////////////////////////////////////////////////////////////////// //
1061 // utils
1062 // `ch`: utf8 start
1063 // -1: invalid utf8
1065 begin
1077 var
1079 begin
1083 begin
1089 // check other sequence bytes
1091 begin
1101 // ////////////////////////////////////////////////////////////////////////// //
1102 const
1104 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
1105 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
1106 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
1107 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
1108 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
1109 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
1110 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
1111 $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
1112 );
1116 var
1118 begin
1119 (* The following encodings are valid, except for the 5 and 6 byte
1120 * combinations:
1121 * 0xxxxxxx
1122 * 110xxxxx 10xxxxxx
1123 * 1110xxxx 10xxxxxx 10xxxxxx
1124 * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
1125 * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1126 * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1127 *)
1135 // mask out unused bits
1143 // now continue
1145 begin
1153 // done, try 1251
1155 // alas
1160 var
1162 begin
1166 begin
1177 // ////////////////////////////////////////////////////////////////////////// //
1178 // findFileCI eats case-insensitive path, traverses it and rewrites it to a
1179 // case-sensetive. result value means success.
1180 // if file/dir not founded than pathname is in undefined state!
1182 var
1190 begin
1195 begin
1196 // remove trailing slashes
1199 // extract name
1202 begin
1206 // remove trailing slashes again
1209 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1210 // try the easiest case first
1213 begin
1215 begin
1216 // i found her!
1219 continue;
1222 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1223 // alas, either not found, or invalid attributes
1225 try
1227 repeat
1229 begin
1230 // i found her!
1234 break;
1237 finally
1247 var
1250 begin
1253 // check first ext
1256 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1258 // check second ext
1261 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1269 var
1272 begin
1274 //writeln('findDiskWad00: fname=<', fname, '>');
1278 //writeln(' findDiskWad01: fname=<', fname, '>; origExt=<', origExt, '>');
1280 begin
1281 //writeln(' findDiskWad02: fname=<', fname, '>; origExt=<', origExt, '>; newExt=<', newExt, '>');
1283 begin
1284 //writeln(' SKIP');
1285 continue;
1295 begin
1296 if not findFileCI(pathname) then raise EFileNotFoundException.Create('can''t open file "'+pathname+'"');
1301 var
1303 begin
1306 begin
1307 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1314 var
1317 begin
1318 //writeln('*** TRYING R/W FILE "', pathname, '"');
1321 begin
1322 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1326 begin
1327 //writeln('*** found old file "', oldname, '"');
1329 end
1330 else
1331 begin
1338 {$IFDEF ENDIAN_LITTLE}
1339 begin
1342 {$ELSE}
1343 var
1345 begin
1348 begin
1354 {$ENDIF}
1357 {$IFDEF ENDIAN_LITTLE}
1358 var
1360 begin
1363 begin
1369 {$ELSE}
1370 begin
1373 {$ENDIF}
1376 begin
1381 var
1384 begin
1387 begin
1389 begin
1392 end
1393 else
1394 begin
1396 begin
1415 procedure writeIntBE (st: TStream; v: ShortInt); overload; begin writeIntegerBE(st, @v, 1); end;
1417 procedure writeIntBE (st: TStream; v: SmallInt); overload; begin writeIntegerBE(st, @v, 2); end;
1418 procedure writeIntBE (st: TStream; v: LongWord); overload; begin writeIntegerBE(st, @v, 4); end;
1419 procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(st, @v, 4); end;
1428 begin
1430 if (maxlen <= 65535) then writeInt(st, Word(Length(str))) else writeInt(st, LongWord(Length(str)));
1435 var
1437 begin
1442 begin
1450 {$IFDEF ENDIAN_LITTLE}
1451 begin
1454 {$ELSE}
1455 var
1457 begin
1460 begin
1466 {$ENDIF}
1469 {$IFDEF ENDIAN_LITTLE}
1470 var
1472 begin
1475 begin
1481 {$ELSE}
1482 begin
1485 {$ENDIF}
1506 // ////////////////////////////////////////////////////////////////////////// //
1507 function nmin (a, b: Byte): Byte; inline; overload; begin if (a < b) then result := a else result := b; end;
1508 function nmin (a, b: ShortInt): ShortInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1509 function nmin (a, b: Word): Word; inline; overload; begin if (a < b) then result := a else result := b; end;
1510 function nmin (a, b: SmallInt): SmallInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1511 function nmin (a, b: LongWord): LongWord; inline; overload; begin if (a < b) then result := a else result := b; end;
1512 function nmin (a, b: LongInt): LongInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1513 function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then result := a else result := b; end;
1514 function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end;
1515 function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end;
1516 function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end;
1517 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1518 function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end;
1519 {$ENDIF}
1521 function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end;
1522 function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1523 function nmax (a, b: Word): Word; inline; overload; begin if (a > b) then result := a else result := b; end;
1524 function nmax (a, b: SmallInt): SmallInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1525 function nmax (a, b: LongWord): LongWord; inline; overload; begin if (a > b) then result := a else result := b; end;
1526 function nmax (a, b: LongInt): LongInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1527 function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then result := a else result := b; end;
1528 function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end;
1529 function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end;
1530 function nmax (a, b: Double): Double; inline; overload; begin if (a > b) then result := a else result := b; end;
1531 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1532 function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end;
1533 {$ENDIF}
1535 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;
1536 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;
1537 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;
1538 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;
1539 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;
1540 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;
1541 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;
1542 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;
1543 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;
1544 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;
1545 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1546 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;
1547 {$ENDIF}
1549 // ////////////////////////////////////////////////////////////////////////// //
1550 {$IFDEF WINDOWS}
1551 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf';
1552 {$ELSE}
1553 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'libc' name 'snprintf';
1554 {$ENDIF}
1557 (*
1558 procedure conwriter (constref buf; len: SizeUInt);
1559 var
1560 ss: ShortString;
1561 slen: Integer;
1562 b: PByte;
1563 begin
1564 if (len < 1) then exit;
1565 b := PByte(@buf);
1566 while (len > 0) do
1567 begin
1568 if (len > 255) then slen := 255 else slen := Integer(len);
1569 Move(b^, ss[1], len);
1570 ss[0] := AnsiChar(slen);
1571 write(ss);
1572 b += slen;
1573 len -= slen;
1574 end;
1575 end;
1576 *)
1579 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1580 const
1582 PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
1583 var
1599 var
1603 begin
1607 begin
1609 end
1610 else
1611 begin
1613 begin
1625 begin
1630 begin
1636 var
1638 begin
1644 var
1646 begin
1652 begin
1656 begin
1666 begin
1671 var
1674 begin
1676 begin
1680 end
1681 else
1682 begin
1687 repeat
1689 begin
1693 end
1694 else
1695 begin
1697 begin
1700 end
1712 var
1714 begin
1717 repeat
1719 begin
1723 end
1724 else
1725 begin
1727 begin
1730 end
1740 var
1742 begin
1744 begin
1752 var
1754 begin
1756 begin
1763 begin
1767 begin
1768 // print literal part
1771 // output literal part
1773 begin
1775 begin
1777 break;
1781 begin
1785 end
1786 else
1787 begin
1791 continue;
1793 // check if we have argument for this format string
1795 begin
1798 break;
1800 // skip percent
1804 // parse format; check for sign
1808 // parse width
1811 begin
1812 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1816 begin
1822 end
1823 else
1824 begin
1828 // parse precision
1831 begin
1834 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1837 begin
1844 // get format char
1848 // done parsing format, check for valid format chars
1849 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;
1850 // now write formatted string
1853 begin
1854 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;
1863 begin
1865 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], 'true')
1870 begin
1872 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], AnsiChar('t'))
1877 begin
1882 else
1883 begin
1886 break;
1892 begin
1899 begin
1904 else
1905 begin
1908 break;
1911 //vtWideChar: begin end; // args[curarg].VWideChar (WideChar)
1915 begin
1922 begin
1928 begin
1930 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(trunc(args[curarg].VExtended^)));
1934 begin
1936 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], LongWord(trunc(args[curarg].VExtended^)));
1939 else
1940 begin
1943 break;
1947 begin
1955 begin
1964 begin
1972 else
1973 begin
1976 break;
1981 begin
1985 end
1986 else
1987 begin
1995 begin
1996 if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := '<nil>';
2002 begin
2003 if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := '<nil>';
2008 //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
2010 begin
2015 //vtCurrency: begin end; // args[curarg].VCurrency (PCurrency)
2016 //vtVariant: begin end; // args[curarg].VVariant^ (PVariant)
2017 //vtInterface: begin end; // args[curarg].VInterface (Pointer);
2018 //vtWideString: begin end; // args[curarg].VWideString (Pointer);
2020 begin
2025 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2030 begin
2032 begin
2034 begin
2039 end
2040 else
2041 begin
2044 end
2045 else
2046 begin
2054 begin
2059 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2063 if (sign <> '-') then begin if zeropad then indent0(width-pclen) else indent(width-pclen); end;
2067 else
2068 begin
2071 break;
2080 var
2084 begin
2088 // get age
2091 // get size
2097 // fill info
2105 (*
2106 var
2107 ss: ShortString;
2108 ls: AnsiString;
2109 i64: Int64 = -$A000000000;
2110 ui64: UInt64 = $A000000000;
2111 begin
2112 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']);
2113 writef(conwriter, 'test float:<%s;%u;%f;%g>'#10, [666.6942, 666.6942, 666.6942, 666.6942]);
2114 ss := 'fuckit';
2115 ls := 'FUCKIT';
2116 writef(conwriter, 'test ss:<%5s;%040s>'#10, [ss, ss]);
2117 writef(conwriter, 'test ls:<%5s;%040s>'#10, [ls, ls]);
2118 writef(conwriter, 'test pointer:<%s;%x;%p>'#10, [@ss, @ss, @ss]);
2119 writef(conwriter, 'test i64:<%s;%x;%015d;%u;%X>'#10, [i64, i64, i64, i64, i64]);
2120 writef(conwriter, 'test ui64:<%s;%x;%15d;%015u;%X>'#10, [ui64, ui64, ui64, ui64, ui64]);
2121 *)