0ac5caa00f15004d8f7901fa99eadf36f966712c
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 // strips out name from `fn`, leaving trailing slash
80 // ends with '/' or '\'?
83 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
84 // will add slash to `path`, even if `fn` is empty!
87 // does filename have one of ".wad", ".pk3", ".zip" extensions?
90 // does filepath have ".XXX:\" in it?
93 // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip"
96 // check wad signature
99 // convert number to strig with nice commas
109 // `true` if strings are equal; ignoring case for cp1251
116 // findFileCI takes case-insensitive path, traverses it, and rewrites it to
117 // a case-sensetive one (using real on-disk names). return value means 'success'.
118 // if some dir or file wasn't found, pathname is undefined (destroyed, but not
119 // necessarily cleared).
120 // last name assumed to be a file, not directory (unless `lastIsDir` flag is set).
123 // findDiskWad tries to find the wad file using common wad extensions
124 // (see `wadExtensions` array).
125 // returns real on-disk filename, or empty string.
126 // original wad extension is used as a hint for the first try.
127 // also, this automatically performs `findFileCI()`.
129 // slashes must be normalized!
132 // they throws
135 // create file if necessary, but don't truncate the existing one
138 // little endian
166 // big endian
196 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
198 {$ENDIF}
210 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
212 {$ENDIF}
223 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
225 {$ENDIF}
227 type
230 // returns formatted string if `writerCB` is `nil`, empty string otherwise
231 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
238 // returns string in single or double quotes
239 // single quotes supports only pascal-style '' for single quote char
240 // double quotes supports c-style escapes
241 // function will select quote mode automatically
245 type
247 private
248 //type PItemT = ^ItemT;
251 public
252 type
254 private
258 public
265 private
269 private
276 public
280 //WARNING! don't change list contents in `for ... in`!
290 public
302 type
307 // not changed by info getter; used in other parts of the code
317 implementation
319 uses
320 xstreams;
322 // ////////////////////////////////////////////////////////////////////////// //
324 begin
329 begin
334 begin
339 // ////////////////////////////////////////////////////////////////////////// //
340 // rewrites slashes to '/'
342 var
344 begin
350 // ////////////////////////////////////////////////////////////////////////// //
352 begin
359 begin
365 begin
370 // ////////////////////////////////////////////////////////////////////////// //
372 begin
380 begin
387 begin
393 begin
400 begin
407 begin
413 begin
420 begin
426 begin
432 var
434 begin
436 begin
446 var
448 begin
450 begin
457 var
459 begin
461 begin
464 end
465 else
466 begin
472 // ////////////////////////////////////////////////////////////////////////// //
473 var
478 // ////////////////////////////////////////////////////////////////////////// //
479 const
481 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
482 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
483 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
484 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
485 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
486 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
487 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
489 );
493 var
495 begin
503 // ////////////////////////////////////////////////////////////////////////// //
504 // fast state-machine based UTF-8 decoder; using 8 bytes of memory
505 // code points from invalid range will never be valid, this is the property of the state machine
506 const
507 // see http://bjoern.hoehrmann.de/utf-8/decoder/dfa/
509 // maps bytes to character classes
526 // maps a combination of a state of the automaton and a character class to a state
536 // ////////////////////////////////////////////////////////////////////////// //
537 constructor TUtf8DecoderFast.Create (v: Boolean{fuck you, fpc}); begin state := Accept; codepoint := 0; end;
543 function TUtf8DecoderFast.completeOrInvalid (): Boolean; inline; begin result := (state = Accept) or (state = Reject); end;
545 function TUtf8DecoderFast.decode (c: AnsiChar): Boolean; inline; overload; begin result := decode(Byte(c)); end;
548 var
550 begin
553 if (state <> Accept) then codepoint := (b and $3f) or (codepoint shl 6) else codepoint := ($ff shr tp) and b;
560 // ////////////////////////////////////////////////////////////////////////// //
562 begin
568 // ////////////////////////////////////////////////////////////////////////// //
570 var
573 begin
575 begin
577 begin
581 begin
584 exit;
592 var
596 begin
599 begin
601 end
603 begin
606 end
608 begin
612 end
614 begin
619 end
620 else
621 begin
626 begin
628 begin
630 begin
633 begin
635 begin
637 end
638 else
639 begin
643 exit;
650 // ////////////////////////////////////////////////////////////////////////// //
652 begin
657 begin
660 end
661 else
662 begin
671 // ////////////////////////////////////////////////////////////////////////// //
675 var
677 begin
680 begin
688 var
691 begin
694 begin
702 begin
705 end
707 begin
710 end
711 else
712 begin
719 var
722 begin
724 begin
732 // ////////////////////////////////////////////////////////////////////////// //
734 var
737 begin
740 begin
743 begin
745 exit;
755 var
758 begin
763 begin
775 var
778 begin
782 begin
785 begin
787 begin
789 end
790 else
791 begin
794 exit;
801 begin
808 // strips out name from `fn`, leaving trailing slash
810 var
813 begin
818 begin
827 // ends with '/' or '\'?
829 begin
831 begin
833 end
834 else
835 begin
841 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
842 // will add slash to `path`, even if `fn` is empty!
844 var
846 begin
850 if (Length(result) > 0) and ((result[Length(result)] <> '/') and (result[Length(result)] <> '\')) then result += '/';
852 begin
854 //FIXME: make this faster!
855 while (Length(result) > 0) and ((result[Length(result)] = '/') or (result[Length(result)] = '\')) do
856 begin
865 var
867 begin
872 //result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip') or StrEquCI1251(ext, '.dfz');
877 begin
885 begin
887 Result :=
888 (* ZIP *)
891 (* PACK *)
894 (* DFWAD *)
895 ((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))
900 var
903 begin
907 begin
909 begin
912 begin
915 begin
917 begin
919 exit;
930 var
932 begin
936 begin
943 begin
945 begin
947 end
948 else
949 begin
951 begin
953 end
954 else
955 begin
967 begin
969 begin
971 end
972 else
973 begin
975 begin
977 end
978 else
979 begin
990 begin
995 begin
1001 var
1003 begin
1012 var
1015 begin
1017 begin
1019 begin
1023 exit;
1026 // nothing to do
1031 // ////////////////////////////////////////////////////////////////////////// //
1032 // utils
1033 // `ch`: utf8 start
1034 // -1: invalid utf8
1036 begin
1048 var
1050 begin
1054 begin
1060 // check other sequence bytes
1062 begin
1072 // ////////////////////////////////////////////////////////////////////////// //
1073 const
1075 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
1076 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
1077 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
1078 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
1079 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
1080 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
1081 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
1082 $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
1083 );
1087 var
1089 begin
1090 (* The following encodings are valid, except for the 5 and 6 byte
1091 * combinations:
1092 * 0xxxxxxx
1093 * 110xxxxx 10xxxxxx
1094 * 1110xxxx 10xxxxxx 10xxxxxx
1095 * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
1096 * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1097 * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1098 *)
1106 // mask out unused bits
1114 // now continue
1116 begin
1124 // done, try 1251
1126 // alas
1131 var
1133 begin
1137 begin
1148 // ////////////////////////////////////////////////////////////////////////// //
1149 // findFileCI eats case-insensitive path, traverses it and rewrites it to a
1150 // case-sensetive. result value means success.
1151 // if file/dir not founded than pathname is in undefined state!
1153 var
1161 begin
1166 begin
1167 // remove trailing slashes
1170 // extract name
1173 begin
1177 // remove trailing slashes again
1180 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1181 // try the easiest case first
1184 begin
1186 begin
1187 // i found her!
1190 continue;
1193 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1194 // alas, either not found, or invalid attributes
1196 try
1198 repeat
1200 begin
1201 // i found her!
1205 break;
1208 finally
1218 var
1221 begin
1224 // check first ext
1227 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1229 // check second ext
1232 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1240 var
1243 begin
1245 //writeln('findDiskWad00: fname=<', fname, '>');
1249 //writeln(' findDiskWad01: fname=<', fname, '>; origExt=<', origExt, '>');
1251 begin
1252 //writeln(' findDiskWad02: fname=<', fname, '>; origExt=<', origExt, '>; newExt=<', newExt, '>');
1254 begin
1255 //writeln(' SKIP');
1256 continue;
1266 begin
1267 if not findFileCI(pathname) then raise EFileNotFoundException.Create('can''t open file "'+pathname+'"');
1272 var
1274 begin
1277 begin
1278 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1285 var
1288 begin
1289 //writeln('*** TRYING R/W FILE "', pathname, '"');
1292 begin
1293 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1297 begin
1298 //writeln('*** found old file "', oldname, '"');
1300 end
1301 else
1302 begin
1309 {$IFDEF ENDIAN_LITTLE}
1310 begin
1313 {$ELSE}
1314 var
1316 begin
1319 begin
1325 {$ENDIF}
1328 {$IFDEF ENDIAN_LITTLE}
1329 var
1331 begin
1334 begin
1340 {$ELSE}
1341 begin
1344 {$ENDIF}
1347 begin
1352 var
1355 begin
1358 begin
1360 begin
1363 end
1364 else
1365 begin
1367 begin
1386 procedure writeIntBE (st: TStream; v: ShortInt); overload; begin writeIntegerBE(st, @v, 1); end;
1388 procedure writeIntBE (st: TStream; v: SmallInt); overload; begin writeIntegerBE(st, @v, 2); end;
1389 procedure writeIntBE (st: TStream; v: LongWord); overload; begin writeIntegerBE(st, @v, 4); end;
1390 procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(st, @v, 4); end;
1399 begin
1401 if (maxlen <= 65535) then writeInt(st, Word(Length(str))) else writeInt(st, LongWord(Length(str)));
1406 var
1408 begin
1413 begin
1421 {$IFDEF ENDIAN_LITTLE}
1422 begin
1425 {$ELSE}
1426 var
1428 begin
1431 begin
1437 {$ENDIF}
1440 {$IFDEF ENDIAN_LITTLE}
1441 var
1443 begin
1446 begin
1452 {$ELSE}
1453 begin
1456 {$ENDIF}
1477 // ////////////////////////////////////////////////////////////////////////// //
1478 function nmin (a, b: Byte): Byte; inline; overload; begin if (a < b) then result := a else result := b; end;
1479 function nmin (a, b: ShortInt): ShortInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1480 function nmin (a, b: Word): Word; inline; overload; begin if (a < b) then result := a else result := b; end;
1481 function nmin (a, b: SmallInt): SmallInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1482 function nmin (a, b: LongWord): LongWord; inline; overload; begin if (a < b) then result := a else result := b; end;
1483 function nmin (a, b: LongInt): LongInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1484 function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then result := a else result := b; end;
1485 function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end;
1486 function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end;
1487 function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end;
1488 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1489 function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end;
1490 {$ENDIF}
1492 function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end;
1493 function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1494 function nmax (a, b: Word): Word; inline; overload; begin if (a > b) then result := a else result := b; end;
1495 function nmax (a, b: SmallInt): SmallInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1496 function nmax (a, b: LongWord): LongWord; inline; overload; begin if (a > b) then result := a else result := b; end;
1497 function nmax (a, b: LongInt): LongInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1498 function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then result := a else result := b; end;
1499 function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end;
1500 function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end;
1501 function nmax (a, b: Double): Double; inline; overload; begin if (a > b) then result := a else result := b; end;
1502 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1503 function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end;
1504 {$ENDIF}
1506 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;
1507 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;
1508 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;
1509 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;
1510 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;
1511 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;
1512 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;
1513 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;
1514 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;
1515 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;
1516 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1517 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;
1518 {$ENDIF}
1520 // ////////////////////////////////////////////////////////////////////////// //
1521 {$IFDEF WINDOWS}
1522 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf';
1523 {$ELSE}
1524 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'libc' name 'snprintf';
1525 {$ENDIF}
1528 (*
1529 procedure conwriter (constref buf; len: SizeUInt);
1530 var
1531 ss: ShortString;
1532 slen: Integer;
1533 b: PByte;
1534 begin
1535 if (len < 1) then exit;
1536 b := PByte(@buf);
1537 while (len > 0) do
1538 begin
1539 if (len > 255) then slen := 255 else slen := Integer(len);
1540 Move(b^, ss[1], len);
1541 ss[0] := AnsiChar(slen);
1542 write(ss);
1543 b += slen;
1544 len -= slen;
1545 end;
1546 end;
1547 *)
1550 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1551 const
1553 PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
1554 var
1570 var
1574 begin
1578 begin
1580 end
1581 else
1582 begin
1584 begin
1596 begin
1601 begin
1607 var
1609 begin
1615 var
1617 begin
1623 begin
1627 begin
1637 begin
1642 var
1645 begin
1647 begin
1651 end
1652 else
1653 begin
1658 repeat
1660 begin
1664 end
1665 else
1666 begin
1668 begin
1671 end
1683 var
1685 begin
1688 repeat
1690 begin
1694 end
1695 else
1696 begin
1698 begin
1701 end
1711 var
1713 begin
1715 begin
1723 var
1725 begin
1727 begin
1734 begin
1738 begin
1739 // print literal part
1742 // output literal part
1744 begin
1746 begin
1748 break;
1752 begin
1756 end
1757 else
1758 begin
1762 continue;
1764 // check if we have argument for this format string
1766 begin
1769 break;
1771 // skip percent
1775 // parse format; check for sign
1779 // parse width
1782 begin
1783 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1787 begin
1793 end
1794 else
1795 begin
1799 // parse precision
1802 begin
1805 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1808 begin
1815 // get format char
1819 // done parsing format, check for valid format chars
1820 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;
1821 // now write formatted string
1824 begin
1825 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;
1834 begin
1836 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], 'true')
1841 begin
1843 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], AnsiChar('t'))
1848 begin
1853 else
1854 begin
1857 break;
1863 begin
1870 begin
1875 else
1876 begin
1879 break;
1882 //vtWideChar: begin end; // args[curarg].VWideChar (WideChar)
1886 begin
1893 begin
1899 begin
1901 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(trunc(args[curarg].VExtended^)));
1905 begin
1907 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], LongWord(trunc(args[curarg].VExtended^)));
1910 else
1911 begin
1914 break;
1918 begin
1926 begin
1935 begin
1943 else
1944 begin
1947 break;
1952 begin
1956 end
1957 else
1958 begin
1966 begin
1967 if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := '<nil>';
1973 begin
1974 if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := '<nil>';
1979 //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
1981 begin
1986 //vtCurrency: begin end; // args[curarg].VCurrency (PCurrency)
1987 //vtVariant: begin end; // args[curarg].VVariant^ (PVariant)
1988 //vtInterface: begin end; // args[curarg].VInterface (Pointer);
1989 //vtWideString: begin end; // args[curarg].VWideString (Pointer);
1991 begin
1996 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2001 begin
2003 begin
2005 begin
2010 end
2011 else
2012 begin
2015 end
2016 else
2017 begin
2025 begin
2030 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2034 if (sign <> '-') then begin if zeropad then indent0(width-pclen) else indent(width-pclen); end;
2038 else
2039 begin
2042 break;
2051 var
2055 begin
2059 // get age
2062 // get size
2068 // fill info
2076 (*
2077 var
2078 ss: ShortString;
2079 ls: AnsiString;
2080 i64: Int64 = -$A000000000;
2081 ui64: UInt64 = $A000000000;
2082 begin
2083 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']);
2084 writef(conwriter, 'test float:<%s;%u;%f;%g>'#10, [666.6942, 666.6942, 666.6942, 666.6942]);
2085 ss := 'fuckit';
2086 ls := 'FUCKIT';
2087 writef(conwriter, 'test ss:<%5s;%040s>'#10, [ss, ss]);
2088 writef(conwriter, 'test ls:<%5s;%040s>'#10, [ls, ls]);
2089 writef(conwriter, 'test pointer:<%s;%x;%p>'#10, [@ss, @ss, @ss]);
2090 writef(conwriter, 'test i64:<%s;%x;%015d;%u;%X>'#10, [i64, i64, i64, i64, i64]);
2091 writef(conwriter, 'test ui64:<%s;%x;%15d;%015u;%X>'#10, [ui64, ui64, ui64, ui64, ui64]);
2092 *)