f5f762c6e983c96a5dd7c54ad3fb68c82110d058
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
203 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
205 {$ENDIF}
217 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
219 {$ENDIF}
230 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
232 {$ENDIF}
234 type
237 // returns formatted string if `writerCB` is `nil`, empty string otherwise
238 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
245 // returns string in single or double quotes
246 // single quotes supports only pascal-style '' for single quote char
247 // double quotes supports c-style escapes
248 // function will select quote mode automatically
252 type
254 private
255 //type PItemT = ^ItemT;
258 public
259 type
261 private
265 public
272 private
276 private
283 public
287 //WARNING! don't change list contents in `for ... in`!
297 public
309 type
314 // not changed by info getter; used in other parts of the code
324 implementation
326 uses
327 xstreams;
329 // ////////////////////////////////////////////////////////////////////////// //
331 begin
336 begin
341 begin
346 // ////////////////////////////////////////////////////////////////////////// //
347 // rewrites slashes to '/'
349 {$IFDEF WINDOWS}
350 var
352 {$ENDIF}
353 begin
355 {$IFDEF WINDOWS}
357 {$ENDIF}
360 // replaces all the shitty characters with '_'
361 // (everything except alphanumerics, '_', '.')
363 var
365 const
368 begin
376 begin
379 {$IFDEF WINDOWS}
381 if (length(s) > 2) and (s[2] = ':') and ((s[3] = '/') or (s[3] = '\')) then begin result := true; exit; end;
382 {$ELSE}
384 {$ENDIF}
389 begin
392 {$IFDEF WINDOWS}
394 if (length(s) = 3) and (s[2] = ':') and ((s[3] = '/') or (s[3] = '\')) then begin result := true; exit; end;
395 {$ELSE}
397 {$ENDIF}
401 // ////////////////////////////////////////////////////////////////////////// //
403 begin
410 begin
416 begin
421 // ////////////////////////////////////////////////////////////////////////// //
423 begin
431 begin
438 begin
444 begin
451 begin
458 begin
464 begin
471 begin
477 begin
483 var
485 begin
487 begin
497 var
499 begin
501 begin
508 var
510 begin
512 begin
515 end
516 else
517 begin
523 // ////////////////////////////////////////////////////////////////////////// //
524 var
529 // ////////////////////////////////////////////////////////////////////////// //
530 const
532 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
533 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$FFFD,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
534 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
535 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
536 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
537 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
538 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
540 );
544 var
546 begin
554 // ////////////////////////////////////////////////////////////////////////// //
555 // fast state-machine based UTF-8 decoder; using 8 bytes of memory
556 // code points from invalid range will never be valid, this is the property of the state machine
557 const
558 // see http://bjoern.hoehrmann.de/utf-8/decoder/dfa/
560 // maps bytes to character classes
577 // maps a combination of a state of the automaton and a character class to a state
587 // ////////////////////////////////////////////////////////////////////////// //
588 constructor TUtf8DecoderFast.Create (v: Boolean{fuck you, fpc}); begin state := Accept; codepoint := 0; end;
594 function TUtf8DecoderFast.completeOrInvalid (): Boolean; inline; begin result := (state = Accept) or (state = Reject); end;
596 function TUtf8DecoderFast.decode (c: AnsiChar): Boolean; inline; overload; begin result := decode(Byte(c)); end;
599 var
601 begin
604 if (state <> Accept) then codepoint := (b and $3f) or (codepoint shl 6) else codepoint := ($ff shr tp) and b;
611 // ////////////////////////////////////////////////////////////////////////// //
613 begin
619 // ////////////////////////////////////////////////////////////////////////// //
621 var
624 begin
626 begin
628 begin
632 begin
635 exit;
643 var
647 begin
650 begin
652 end
654 begin
657 end
659 begin
663 end
665 begin
670 end
671 else
672 begin
677 begin
679 begin
681 begin
684 begin
686 begin
688 end
689 else
690 begin
694 exit;
701 // ////////////////////////////////////////////////////////////////////////// //
703 begin
708 begin
711 end
712 else
713 begin
722 // ////////////////////////////////////////////////////////////////////////// //
726 var
728 begin
731 begin
739 var
742 begin
745 begin
753 begin
756 end
758 begin
761 end
762 else
763 begin
770 var
773 begin
775 begin
783 // ////////////////////////////////////////////////////////////////////////// //
785 var
788 begin
791 begin
794 begin
796 exit;
806 var
809 begin
814 begin
826 var
829 begin
833 begin
836 begin
838 begin
840 end
841 else
842 begin
845 exit;
852 begin
859 // strips out name from `fn`, leaving trailing slash
861 var
864 begin
869 begin
878 // ends with '/' or '\'?
880 begin
882 begin
884 end
885 else
886 begin
892 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
893 // will add slash to `path`, even if `fn` is empty!
895 var
897 begin
901 if (Length(result) > 0) and ((result[Length(result)] <> '/') and (result[Length(result)] <> '\')) then result += '/';
903 begin
905 //FIXME: make this faster!
906 while (Length(result) > 0) and ((result[Length(result)] = '/') or (result[Length(result)] = '\')) do
907 begin
916 var
918 begin
923 //result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip') or StrEquCI1251(ext, '.dfz');
928 begin
936 begin
938 Result :=
939 (* ZIP *)
942 (* PACK *)
945 (* DFWAD *)
946 ((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))
951 var
954 begin
958 begin
960 begin
963 begin
966 begin
968 begin
970 exit;
981 var
983 begin
987 begin
994 begin
996 begin
998 end
999 else
1000 begin
1002 begin
1004 end
1005 else
1006 begin
1018 begin
1020 begin
1022 end
1023 else
1024 begin
1026 begin
1028 end
1029 else
1030 begin
1041 begin
1046 begin
1052 var
1054 begin
1063 var
1066 begin
1068 begin
1070 begin
1074 exit;
1077 // nothing to do
1082 // ////////////////////////////////////////////////////////////////////////// //
1083 // utils
1084 // `ch`: utf8 start
1085 // -1: invalid utf8
1087 begin
1099 var
1101 begin
1105 begin
1111 // check other sequence bytes
1113 begin
1123 // ////////////////////////////////////////////////////////////////////////// //
1124 const
1126 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
1127 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
1128 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
1129 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
1130 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
1131 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
1132 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
1133 $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
1134 );
1138 var
1140 begin
1141 (* The following encodings are valid, except for the 5 and 6 byte
1142 * combinations:
1143 * 0xxxxxxx
1144 * 110xxxxx 10xxxxxx
1145 * 1110xxxx 10xxxxxx 10xxxxxx
1146 * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
1147 * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1148 * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1149 *)
1157 // mask out unused bits
1165 // now continue
1167 begin
1175 // done, try 1251
1177 // alas
1182 var
1184 begin
1188 begin
1199 // ////////////////////////////////////////////////////////////////////////// //
1200 // findFileCI eats case-insensitive path, traverses it and rewrites it to a
1201 // case-sensetive. result value means success.
1202 // if file/dir not founded than pathname is in undefined state!
1204 var
1212 begin
1217 begin
1218 // remove trailing slashes
1221 // extract name
1224 begin
1228 // remove trailing slashes again
1231 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1232 // try the easiest case first
1235 begin
1237 begin
1238 // i found her!
1241 continue;
1244 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1245 // alas, either not found, or invalid attributes
1247 try
1249 repeat
1251 begin
1252 // i found her!
1256 break;
1259 finally
1269 var
1272 begin
1275 // check first ext
1278 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1280 // check second ext
1283 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1291 var
1294 begin
1296 //writeln('findDiskWad00: fname=<', fname, '>');
1300 //writeln(' findDiskWad01: fname=<', fname, '>; origExt=<', origExt, '>');
1302 begin
1303 //writeln(' findDiskWad02: fname=<', fname, '>; origExt=<', origExt, '>; newExt=<', newExt, '>');
1305 begin
1306 //writeln(' SKIP');
1307 continue;
1317 begin
1318 if not findFileCI(pathname) then raise EFileNotFoundException.Create('can''t open file "'+pathname+'"');
1323 var
1325 begin
1328 begin
1329 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1336 var
1339 begin
1340 //writeln('*** TRYING R/W FILE "', pathname, '"');
1343 begin
1344 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1348 begin
1349 //writeln('*** found old file "', oldname, '"');
1351 end
1352 else
1353 begin
1360 {$IFDEF ENDIAN_LITTLE}
1361 begin
1364 {$ELSE}
1365 var
1367 begin
1370 begin
1376 {$ENDIF}
1379 {$IFDEF ENDIAN_LITTLE}
1380 var
1382 begin
1385 begin
1391 {$ELSE}
1392 begin
1395 {$ENDIF}
1398 begin
1403 var
1406 begin
1409 begin
1411 begin
1414 end
1415 else
1416 begin
1418 begin
1437 procedure writeIntBE (st: TStream; v: ShortInt); overload; begin writeIntegerBE(st, @v, 1); end;
1439 procedure writeIntBE (st: TStream; v: SmallInt); overload; begin writeIntegerBE(st, @v, 2); end;
1440 procedure writeIntBE (st: TStream; v: LongWord); overload; begin writeIntegerBE(st, @v, 4); end;
1441 procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(st, @v, 4); end;
1450 begin
1452 if (maxlen <= 65535) then writeInt(st, Word(Length(str))) else writeInt(st, LongWord(Length(str)));
1457 var
1459 begin
1464 begin
1472 {$IFDEF ENDIAN_LITTLE}
1473 begin
1476 {$ELSE}
1477 var
1479 begin
1482 begin
1488 {$ENDIF}
1491 {$IFDEF ENDIAN_LITTLE}
1492 var
1494 begin
1497 begin
1503 {$ELSE}
1504 begin
1507 {$ENDIF}
1528 // ////////////////////////////////////////////////////////////////////////// //
1529 function nmin (a, b: Byte): Byte; inline; overload; begin if (a < b) then result := a else result := b; end;
1530 function nmin (a, b: ShortInt): ShortInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1531 function nmin (a, b: Word): Word; inline; overload; begin if (a < b) then result := a else result := b; end;
1532 function nmin (a, b: SmallInt): SmallInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1533 function nmin (a, b: LongWord): LongWord; inline; overload; begin if (a < b) then result := a else result := b; end;
1534 function nmin (a, b: LongInt): LongInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1535 function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then result := a else result := b; end;
1536 function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end;
1537 function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end;
1538 function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end;
1539 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1540 function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end;
1541 {$ENDIF}
1543 function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end;
1544 function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1545 function nmax (a, b: Word): Word; inline; overload; begin if (a > b) then result := a else result := b; end;
1546 function nmax (a, b: SmallInt): SmallInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1547 function nmax (a, b: LongWord): LongWord; inline; overload; begin if (a > b) then result := a else result := b; end;
1548 function nmax (a, b: LongInt): LongInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1549 function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then result := a else result := b; end;
1550 function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end;
1551 function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end;
1552 function nmax (a, b: Double): Double; inline; overload; begin if (a > b) then result := a else result := b; end;
1553 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1554 function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end;
1555 {$ENDIF}
1557 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;
1558 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;
1559 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;
1560 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;
1561 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;
1562 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;
1563 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;
1564 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;
1565 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;
1566 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;
1567 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1568 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;
1569 {$ENDIF}
1571 // ////////////////////////////////////////////////////////////////////////// //
1572 {$IFDEF WINDOWS}
1573 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf';
1574 {$ELSE}
1575 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'libc' name 'snprintf';
1576 {$ENDIF}
1579 (*
1580 procedure conwriter (constref buf; len: SizeUInt);
1581 var
1582 ss: ShortString;
1583 slen: Integer;
1584 b: PByte;
1585 begin
1586 if (len < 1) then exit;
1587 b := PByte(@buf);
1588 while (len > 0) do
1589 begin
1590 if (len > 255) then slen := 255 else slen := Integer(len);
1591 Move(b^, ss[1], len);
1592 ss[0] := AnsiChar(slen);
1593 write(ss);
1594 b += slen;
1595 len -= slen;
1596 end;
1597 end;
1598 *)
1601 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1602 const
1604 PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
1605 var
1621 var
1625 begin
1629 begin
1631 end
1632 else
1633 begin
1635 begin
1647 begin
1652 begin
1658 var
1660 begin
1666 var
1668 begin
1674 begin
1678 begin
1688 begin
1693 var
1696 begin
1698 begin
1702 end
1703 else
1704 begin
1709 repeat
1711 begin
1715 end
1716 else
1717 begin
1719 begin
1722 end
1734 var
1736 begin
1739 repeat
1741 begin
1745 end
1746 else
1747 begin
1749 begin
1752 end
1762 var
1764 begin
1766 begin
1774 var
1776 begin
1778 begin
1785 begin
1789 begin
1790 // print literal part
1793 // output literal part
1795 begin
1797 begin
1799 break;
1803 begin
1807 end
1808 else
1809 begin
1813 continue;
1815 // check if we have argument for this format string
1817 begin
1820 break;
1822 // skip percent
1826 // parse format; check for sign
1830 // parse width
1833 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;
1838 begin
1844 end
1845 else
1846 begin
1850 // parse precision
1853 begin
1856 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1859 begin
1866 // get format char
1870 // done parsing format, check for valid format chars
1871 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;
1872 // now write formatted string
1875 begin
1876 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;
1885 begin
1887 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], 'true')
1892 begin
1894 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], AnsiChar('t'))
1899 begin
1904 else
1905 begin
1908 break;
1914 begin
1921 begin
1926 else
1927 begin
1930 break;
1933 //vtWideChar: begin end; // args[curarg].VWideChar (WideChar)
1937 begin
1944 begin
1950 begin
1952 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(trunc(args[curarg].VExtended^)));
1956 begin
1958 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], LongWord(trunc(args[curarg].VExtended^)));
1961 else
1962 begin
1965 break;
1969 begin
1977 begin
1986 begin
1994 else
1995 begin
1998 break;
2003 begin
2007 end
2008 else
2009 begin
2017 begin
2018 if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := '<nil>';
2024 begin
2025 if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := '<nil>';
2030 //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
2032 begin
2037 //vtCurrency: begin end; // args[curarg].VCurrency (PCurrency)
2038 //vtVariant: begin end; // args[curarg].VVariant^ (PVariant)
2039 //vtInterface: begin end; // args[curarg].VInterface (Pointer);
2040 //vtWideString: begin end; // args[curarg].VWideString (Pointer);
2042 begin
2047 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2052 begin
2054 begin
2056 begin
2061 end
2062 else
2063 begin
2066 end
2067 else
2068 begin
2076 begin
2081 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2085 if (sign <> '-') then begin if zeropad then indent0(width-pclen) else indent(width-pclen); end;
2089 else
2090 begin
2093 break;
2102 var
2106 begin
2110 // get age
2113 // get size
2119 // fill info
2127 (*
2128 var
2129 ss: ShortString;
2130 ls: AnsiString;
2131 i64: Int64 = -$A000000000;
2132 ui64: UInt64 = $A000000000;
2133 begin
2134 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']);
2135 writef(conwriter, 'test float:<%s;%u;%f;%g>'#10, [666.6942, 666.6942, 666.6942, 666.6942]);
2136 ss := 'fuckit';
2137 ls := 'FUCKIT';
2138 writef(conwriter, 'test ss:<%5s;%040s>'#10, [ss, ss]);
2139 writef(conwriter, 'test ls:<%5s;%040s>'#10, [ls, ls]);
2140 writef(conwriter, 'test pointer:<%s;%x;%p>'#10, [@ss, @ss, @ss]);
2141 writef(conwriter, 'test i64:<%s;%x;%015d;%u;%X>'#10, [i64, i64, i64, i64, i64]);
2142 writef(conwriter, 'test ui64:<%s;%x;%15d;%015u;%X>'#10, [ui64, ui64, ui64, ui64, ui64]);
2143 *)