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 // strips out name from `fn`, leaving trailing slash
77 // ends with '/' or '\'?
80 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
81 // will add slash to `path`, even if `fn` is empty!
84 // does filename have one of ".wad", ".pk3", ".zip" extensions?
87 // does filepath have ".XXX:\" in it?
90 // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip"
93 // check wad signature
96 // convert number to strig with nice commas
106 // `true` if strings are equal; ignoring case for cp1251
113 // findFileCI takes case-insensitive path, traverses it, and rewrites it to
114 // a case-sensetive one (using real on-disk names). return value means 'success'.
115 // if some dir or file wasn't found, pathname is undefined (destroyed, but not
116 // necessarily cleared).
117 // last name assumed to be a file, not directory (unless `lastIsDir` flag is set).
120 // findDiskWad tries to find the wad file using common wad extensions
121 // (see `wadExtensions` array).
122 // returns real on-disk filename, or empty string.
123 // original wad extension is used as a hint for the first try.
124 // also, this automatically performs `findFileCI()`.
126 // slashes must be normalized!
129 // they throws
132 // create file if necessary, but don't truncate the existing one
135 // little endian
163 // big endian
193 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
195 {$ENDIF}
207 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
209 {$ENDIF}
220 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
222 {$ENDIF}
224 type
227 // returns formatted string if `writerCB` is `nil`, empty string otherwise
228 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
235 // returns string in single or double quotes
236 // single quotes supports only pascal-style '' for single quote char
237 // double quotes supports c-style escapes
238 // function will select quote mode automatically
242 type
244 private
245 //type PItemT = ^ItemT;
248 public
249 type
251 private
255 public
262 private
266 private
273 public
277 //WARNING! don't change list contents in `for ... in`!
287 public
299 type
304 // not changed by info getter; used in other parts of the code
314 implementation
316 uses
317 xstreams;
319 // ////////////////////////////////////////////////////////////////////////// //
321 begin
326 begin
331 begin
336 // ////////////////////////////////////////////////////////////////////////// //
338 begin
345 begin
351 begin
356 // ////////////////////////////////////////////////////////////////////////// //
358 begin
366 begin
373 begin
379 begin
386 begin
393 begin
399 begin
406 begin
412 begin
418 var
420 begin
422 begin
432 var
434 begin
436 begin
443 var
445 begin
447 begin
450 end
451 else
452 begin
458 // ////////////////////////////////////////////////////////////////////////// //
459 var
464 // ////////////////////////////////////////////////////////////////////////// //
465 const
467 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
468 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
469 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
470 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
471 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
472 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
473 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
475 );
479 var
481 begin
489 // ////////////////////////////////////////////////////////////////////////// //
490 // fast state-machine based UTF-8 decoder; using 8 bytes of memory
491 // code points from invalid range will never be valid, this is the property of the state machine
492 const
493 // see http://bjoern.hoehrmann.de/utf-8/decoder/dfa/
495 // maps bytes to character classes
512 // maps a combination of a state of the automaton and a character class to a state
522 // ////////////////////////////////////////////////////////////////////////// //
523 constructor TUtf8DecoderFast.Create (v: Boolean{fuck you, fpc}); begin state := Accept; codepoint := 0; end;
529 function TUtf8DecoderFast.completeOrInvalid (): Boolean; inline; begin result := (state = Accept) or (state = Reject); end;
531 function TUtf8DecoderFast.decode (c: AnsiChar): Boolean; inline; overload; begin result := decode(Byte(c)); end;
534 var
536 begin
539 if (state <> Accept) then codepoint := (b and $3f) or (codepoint shl 6) else codepoint := ($ff shr tp) and b;
546 // ////////////////////////////////////////////////////////////////////////// //
548 begin
554 // ////////////////////////////////////////////////////////////////////////// //
556 var
559 begin
561 begin
563 begin
567 begin
570 exit;
578 var
582 begin
585 begin
587 end
589 begin
592 end
594 begin
598 end
600 begin
605 end
606 else
607 begin
612 begin
614 begin
616 begin
619 begin
621 begin
623 end
624 else
625 begin
629 exit;
636 // ////////////////////////////////////////////////////////////////////////// //
638 begin
643 begin
646 end
647 else
648 begin
657 // ////////////////////////////////////////////////////////////////////////// //
661 var
663 begin
666 begin
674 var
677 begin
680 begin
688 begin
691 end
693 begin
696 end
697 else
698 begin
705 var
708 begin
710 begin
718 // ////////////////////////////////////////////////////////////////////////// //
720 var
723 begin
726 begin
729 begin
731 exit;
741 var
744 begin
749 begin
761 var
764 begin
768 begin
771 begin
773 begin
775 end
776 else
777 begin
780 exit;
787 begin
794 // strips out name from `fn`, leaving trailing slash
796 var
799 begin
804 begin
813 // ends with '/' or '\'?
815 begin
817 begin
819 end
820 else
821 begin
827 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
828 // will add slash to `path`, even if `fn` is empty!
830 var
832 begin
836 if (Length(result) > 0) and ((result[Length(result)] <> '/') and (result[Length(result)] <> '\')) then result += '/';
838 begin
840 //FIXME: make this faster!
841 while (Length(result) > 0) and ((result[Length(result)] = '/') or (result[Length(result)] = '\')) do
842 begin
851 var
853 begin
858 //result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip') or StrEquCI1251(ext, '.dfz');
863 begin
871 begin
873 Result :=
874 (* ZIP *)
877 (* PACK *)
880 (* DFWAD *)
881 ((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))
886 var
889 begin
893 begin
895 begin
898 begin
901 begin
903 begin
905 exit;
916 var
918 begin
922 begin
929 begin
931 begin
933 end
934 else
935 begin
937 begin
939 end
940 else
941 begin
953 begin
955 begin
957 end
958 else
959 begin
961 begin
963 end
964 else
965 begin
976 begin
981 begin
987 var
989 begin
998 var
1001 begin
1003 begin
1005 begin
1009 exit;
1012 // nothing to do
1017 // ////////////////////////////////////////////////////////////////////////// //
1018 // utils
1019 // `ch`: utf8 start
1020 // -1: invalid utf8
1022 begin
1034 var
1036 begin
1040 begin
1046 // check other sequence bytes
1048 begin
1058 // ////////////////////////////////////////////////////////////////////////// //
1059 const
1061 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
1062 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
1063 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
1064 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
1065 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
1066 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
1067 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
1068 $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
1069 );
1073 var
1075 begin
1076 (* The following encodings are valid, except for the 5 and 6 byte
1077 * combinations:
1078 * 0xxxxxxx
1079 * 110xxxxx 10xxxxxx
1080 * 1110xxxx 10xxxxxx 10xxxxxx
1081 * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
1082 * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1083 * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1084 *)
1092 // mask out unused bits
1100 // now continue
1102 begin
1110 // done, try 1251
1112 // alas
1117 var
1119 begin
1123 begin
1134 // ////////////////////////////////////////////////////////////////////////// //
1135 // findFileCI eats case-insensitive path, traverses it and rewrites it to a
1136 // case-sensetive. result value means success.
1137 // if file/dir not founded than pathname is in undefined state!
1139 var
1147 begin
1152 begin
1153 // remove trailing slashes
1156 // extract name
1159 begin
1163 // remove trailing slashes again
1166 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1167 // try the easiest case first
1170 begin
1172 begin
1173 // i found her!
1176 continue;
1179 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1180 // alas, either not found, or invalid attributes
1182 try
1184 repeat
1186 begin
1187 // i found her!
1191 break;
1194 finally
1204 var
1207 begin
1210 // check first ext
1213 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1215 // check second ext
1218 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1226 var
1229 begin
1231 //writeln('findDiskWad00: fname=<', fname, '>');
1235 //writeln(' findDiskWad01: fname=<', fname, '>; origExt=<', origExt, '>');
1237 begin
1238 //writeln(' findDiskWad02: fname=<', fname, '>; origExt=<', origExt, '>; newExt=<', newExt, '>');
1240 begin
1241 //writeln(' SKIP');
1242 continue;
1252 begin
1253 if not findFileCI(pathname) then raise EFileNotFoundException.Create('can''t open file "'+pathname+'"');
1258 var
1260 begin
1263 begin
1264 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1271 var
1274 begin
1275 //writeln('*** TRYING R/W FILE "', pathname, '"');
1278 begin
1279 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1283 begin
1284 //writeln('*** found old file "', oldname, '"');
1286 end
1287 else
1288 begin
1295 {$IFDEF ENDIAN_LITTLE}
1296 begin
1299 {$ELSE}
1300 var
1302 begin
1305 begin
1311 {$ENDIF}
1314 {$IFDEF ENDIAN_LITTLE}
1315 var
1317 begin
1320 begin
1326 {$ELSE}
1327 begin
1330 {$ENDIF}
1333 begin
1338 var
1341 begin
1344 begin
1346 begin
1349 end
1350 else
1351 begin
1353 begin
1372 procedure writeIntBE (st: TStream; v: ShortInt); overload; begin writeIntegerBE(st, @v, 1); end;
1374 procedure writeIntBE (st: TStream; v: SmallInt); overload; begin writeIntegerBE(st, @v, 2); end;
1375 procedure writeIntBE (st: TStream; v: LongWord); overload; begin writeIntegerBE(st, @v, 4); end;
1376 procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(st, @v, 4); end;
1385 begin
1387 if (maxlen <= 65535) then writeInt(st, Word(Length(str))) else writeInt(st, LongWord(Length(str)));
1392 var
1394 begin
1399 begin
1407 {$IFDEF ENDIAN_LITTLE}
1408 begin
1411 {$ELSE}
1412 var
1414 begin
1417 begin
1423 {$ENDIF}
1426 {$IFDEF ENDIAN_LITTLE}
1427 var
1429 begin
1432 begin
1438 {$ELSE}
1439 begin
1442 {$ENDIF}
1463 // ////////////////////////////////////////////////////////////////////////// //
1464 function nmin (a, b: Byte): Byte; inline; overload; begin if (a < b) then result := a else result := b; end;
1465 function nmin (a, b: ShortInt): ShortInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1466 function nmin (a, b: Word): Word; inline; overload; begin if (a < b) then result := a else result := b; end;
1467 function nmin (a, b: SmallInt): SmallInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1468 function nmin (a, b: LongWord): LongWord; inline; overload; begin if (a < b) then result := a else result := b; end;
1469 function nmin (a, b: LongInt): LongInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1470 function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then result := a else result := b; end;
1471 function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end;
1472 function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end;
1473 function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end;
1474 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1475 function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end;
1476 {$ENDIF}
1478 function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end;
1479 function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1480 function nmax (a, b: Word): Word; inline; overload; begin if (a > b) then result := a else result := b; end;
1481 function nmax (a, b: SmallInt): SmallInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1482 function nmax (a, b: LongWord): LongWord; inline; overload; begin if (a > b) then result := a else result := b; end;
1483 function nmax (a, b: LongInt): LongInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1484 function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then result := a else result := b; end;
1485 function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end;
1486 function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end;
1487 function nmax (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 nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end;
1490 {$ENDIF}
1492 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;
1493 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;
1494 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;
1495 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;
1496 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;
1497 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;
1498 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;
1499 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;
1500 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;
1501 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;
1502 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1503 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;
1504 {$ENDIF}
1506 // ////////////////////////////////////////////////////////////////////////// //
1507 {$IFDEF WINDOWS}
1508 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf';
1509 {$ELSE}
1510 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'libc' name 'snprintf';
1511 {$ENDIF}
1514 (*
1515 procedure conwriter (constref buf; len: SizeUInt);
1516 var
1517 ss: ShortString;
1518 slen: Integer;
1519 b: PByte;
1520 begin
1521 if (len < 1) then exit;
1522 b := PByte(@buf);
1523 while (len > 0) do
1524 begin
1525 if (len > 255) then slen := 255 else slen := Integer(len);
1526 Move(b^, ss[1], len);
1527 ss[0] := AnsiChar(slen);
1528 write(ss);
1529 b += slen;
1530 len -= slen;
1531 end;
1532 end;
1533 *)
1536 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1537 const
1539 PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
1540 var
1556 var
1560 begin
1564 begin
1566 end
1567 else
1568 begin
1570 begin
1582 begin
1587 begin
1593 var
1595 begin
1601 var
1603 begin
1609 begin
1613 begin
1623 begin
1628 var
1631 begin
1633 begin
1637 end
1638 else
1639 begin
1644 repeat
1646 begin
1650 end
1651 else
1652 begin
1654 begin
1657 end
1669 var
1671 begin
1674 repeat
1676 begin
1680 end
1681 else
1682 begin
1684 begin
1687 end
1697 var
1699 begin
1701 begin
1709 var
1711 begin
1713 begin
1720 begin
1724 begin
1725 // print literal part
1728 // output literal part
1730 begin
1732 begin
1734 break;
1738 begin
1742 end
1743 else
1744 begin
1748 continue;
1750 // check if we have argument for this format string
1752 begin
1755 break;
1757 // skip percent
1761 // parse format; check for sign
1765 // parse width
1768 begin
1769 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1773 begin
1779 end
1780 else
1781 begin
1785 // parse precision
1788 begin
1791 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1794 begin
1801 // get format char
1805 // done parsing format, check for valid format chars
1806 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;
1807 // now write formatted string
1810 begin
1811 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;
1820 begin
1822 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], 'true')
1827 begin
1829 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], AnsiChar('t'))
1834 begin
1839 else
1840 begin
1843 break;
1849 begin
1856 begin
1861 else
1862 begin
1865 break;
1868 //vtWideChar: begin end; // args[curarg].VWideChar (WideChar)
1872 begin
1879 begin
1885 begin
1887 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(trunc(args[curarg].VExtended^)));
1891 begin
1893 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], LongWord(trunc(args[curarg].VExtended^)));
1896 else
1897 begin
1900 break;
1904 begin
1912 begin
1921 begin
1929 else
1930 begin
1933 break;
1938 begin
1942 end
1943 else
1944 begin
1952 begin
1953 if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := '<nil>';
1959 begin
1960 if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := '<nil>';
1965 //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
1967 begin
1972 //vtCurrency: begin end; // args[curarg].VCurrency (PCurrency)
1973 //vtVariant: begin end; // args[curarg].VVariant^ (PVariant)
1974 //vtInterface: begin end; // args[curarg].VInterface (Pointer);
1975 //vtWideString: begin end; // args[curarg].VWideString (Pointer);
1977 begin
1982 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1987 begin
1989 begin
1991 begin
1996 end
1997 else
1998 begin
2001 end
2002 else
2003 begin
2011 begin
2016 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2020 if (sign <> '-') then begin if zeropad then indent0(width-pclen) else indent(width-pclen); end;
2024 else
2025 begin
2028 break;
2037 var
2041 begin
2045 // get age
2048 // get size
2054 // fill info
2062 (*
2063 var
2064 ss: ShortString;
2065 ls: AnsiString;
2066 i64: Int64 = -$A000000000;
2067 ui64: UInt64 = $A000000000;
2068 begin
2069 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']);
2070 writef(conwriter, 'test float:<%s;%u;%f;%g>'#10, [666.6942, 666.6942, 666.6942, 666.6942]);
2071 ss := 'fuckit';
2072 ls := 'FUCKIT';
2073 writef(conwriter, 'test ss:<%5s;%040s>'#10, [ss, ss]);
2074 writef(conwriter, 'test ls:<%5s;%040s>'#10, [ls, ls]);
2075 writef(conwriter, 'test pointer:<%s;%x;%p>'#10, [@ss, @ss, @ss]);
2076 writef(conwriter, 'test i64:<%s;%x;%015d;%u;%X>'#10, [i64, i64, i64, i64, i64]);
2077 writef(conwriter, 'test ui64:<%s;%x;%15d;%015u;%X>'#10, [ui64, ui64, ui64, ui64, ui64]);
2078 *)