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
900 if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') or StrEquCI1251(s, '.dfz') then
901 begin
903 exit;
913 var
915 begin
919 begin
926 begin
928 begin
930 end
931 else
932 begin
934 begin
936 end
937 else
938 begin
950 begin
952 begin
954 end
955 else
956 begin
958 begin
960 end
961 else
962 begin
973 begin
978 begin
984 var
986 begin
995 var
998 begin
1000 begin
1002 begin
1006 exit;
1009 // nothing to do
1014 // ////////////////////////////////////////////////////////////////////////// //
1015 // utils
1016 // `ch`: utf8 start
1017 // -1: invalid utf8
1019 begin
1031 var
1033 begin
1037 begin
1043 // check other sequence bytes
1045 begin
1055 // ////////////////////////////////////////////////////////////////////////// //
1056 const
1058 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
1059 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
1060 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
1061 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
1062 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
1063 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
1064 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
1065 $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
1066 );
1070 var
1072 begin
1073 (* The following encodings are valid, except for the 5 and 6 byte
1074 * combinations:
1075 * 0xxxxxxx
1076 * 110xxxxx 10xxxxxx
1077 * 1110xxxx 10xxxxxx 10xxxxxx
1078 * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
1079 * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1080 * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1081 *)
1089 // mask out unused bits
1097 // now continue
1099 begin
1107 // done, try 1251
1109 // alas
1114 var
1116 begin
1120 begin
1131 // ////////////////////////////////////////////////////////////////////////// //
1132 // findFileCI eats case-insensitive path, traverses it and rewrites it to a
1133 // case-sensetive. result value means success.
1134 // if file/dir not founded than pathname is in undefined state!
1136 var
1144 begin
1149 begin
1150 // remove trailing slashes
1153 // extract name
1156 begin
1160 // remove trailing slashes again
1163 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1164 // try the easiest case first
1167 begin
1169 begin
1170 // i found her!
1173 continue;
1176 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1177 // alas, either not found, or invalid attributes
1179 try
1181 repeat
1183 begin
1184 // i found her!
1188 break;
1191 finally
1201 var
1204 begin
1207 // check first ext
1210 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1212 // check second ext
1215 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1223 var
1226 begin
1228 //writeln('findDiskWad00: fname=<', fname, '>');
1232 //writeln(' findDiskWad01: fname=<', fname, '>; origExt=<', origExt, '>');
1234 begin
1235 //writeln(' findDiskWad02: fname=<', fname, '>; origExt=<', origExt, '>; newExt=<', newExt, '>');
1237 begin
1238 //writeln(' SKIP');
1239 continue;
1249 begin
1250 if not findFileCI(pathname) then raise EFileNotFoundException.Create('can''t open file "'+pathname+'"');
1255 var
1257 begin
1260 begin
1261 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1268 var
1271 begin
1272 //writeln('*** TRYING R/W FILE "', pathname, '"');
1275 begin
1276 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1280 begin
1281 //writeln('*** found old file "', oldname, '"');
1283 end
1284 else
1285 begin
1292 {$IFDEF ENDIAN_LITTLE}
1293 begin
1296 {$ELSE}
1297 var
1299 begin
1302 begin
1308 {$ENDIF}
1311 {$IFDEF ENDIAN_LITTLE}
1312 var
1314 begin
1317 begin
1323 {$ELSE}
1324 begin
1327 {$ENDIF}
1330 begin
1335 var
1338 begin
1341 begin
1343 begin
1346 end
1347 else
1348 begin
1350 begin
1369 procedure writeIntBE (st: TStream; v: ShortInt); overload; begin writeIntegerBE(st, @v, 1); end;
1371 procedure writeIntBE (st: TStream; v: SmallInt); overload; begin writeIntegerBE(st, @v, 2); end;
1372 procedure writeIntBE (st: TStream; v: LongWord); overload; begin writeIntegerBE(st, @v, 4); end;
1373 procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(st, @v, 4); end;
1382 begin
1384 if (maxlen <= 65535) then writeInt(st, Word(Length(str))) else writeInt(st, LongWord(Length(str)));
1389 var
1391 begin
1396 begin
1404 {$IFDEF ENDIAN_LITTLE}
1405 begin
1408 {$ELSE}
1409 var
1411 begin
1414 begin
1420 {$ENDIF}
1423 {$IFDEF ENDIAN_LITTLE}
1424 var
1426 begin
1429 begin
1435 {$ELSE}
1436 begin
1439 {$ENDIF}
1460 // ////////////////////////////////////////////////////////////////////////// //
1461 function nmin (a, b: Byte): Byte; inline; overload; begin if (a < b) then result := a else result := b; end;
1462 function nmin (a, b: ShortInt): ShortInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1463 function nmin (a, b: Word): Word; inline; overload; begin if (a < b) then result := a else result := b; end;
1464 function nmin (a, b: SmallInt): SmallInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1465 function nmin (a, b: LongWord): LongWord; inline; overload; begin if (a < b) then result := a else result := b; end;
1466 function nmin (a, b: LongInt): LongInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1467 function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then result := a else result := b; end;
1468 function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end;
1469 function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end;
1470 function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end;
1471 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1472 function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end;
1473 {$ENDIF}
1475 function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end;
1476 function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1477 function nmax (a, b: Word): Word; inline; overload; begin if (a > b) then result := a else result := b; end;
1478 function nmax (a, b: SmallInt): SmallInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1479 function nmax (a, b: LongWord): LongWord; inline; overload; begin if (a > b) then result := a else result := b; end;
1480 function nmax (a, b: LongInt): LongInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1481 function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then result := a else result := b; end;
1482 function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end;
1483 function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end;
1484 function nmax (a, b: Double): Double; inline; overload; begin if (a > b) then result := a else result := b; end;
1485 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1486 function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end;
1487 {$ENDIF}
1489 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;
1490 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;
1491 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;
1492 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;
1493 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;
1494 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;
1495 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;
1496 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;
1497 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;
1498 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;
1499 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1500 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;
1501 {$ENDIF}
1503 // ////////////////////////////////////////////////////////////////////////// //
1504 {$IFDEF WINDOWS}
1505 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf';
1506 {$ELSE}
1507 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'libc' name 'snprintf';
1508 {$ENDIF}
1511 (*
1512 procedure conwriter (constref buf; len: SizeUInt);
1513 var
1514 ss: ShortString;
1515 slen: Integer;
1516 b: PByte;
1517 begin
1518 if (len < 1) then exit;
1519 b := PByte(@buf);
1520 while (len > 0) do
1521 begin
1522 if (len > 255) then slen := 255 else slen := Integer(len);
1523 Move(b^, ss[1], len);
1524 ss[0] := AnsiChar(slen);
1525 write(ss);
1526 b += slen;
1527 len -= slen;
1528 end;
1529 end;
1530 *)
1533 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1534 const
1536 PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
1537 var
1553 var
1557 begin
1561 begin
1563 end
1564 else
1565 begin
1567 begin
1579 begin
1584 begin
1590 var
1592 begin
1598 var
1600 begin
1606 begin
1610 begin
1620 begin
1625 var
1628 begin
1630 begin
1634 end
1635 else
1636 begin
1641 repeat
1643 begin
1647 end
1648 else
1649 begin
1651 begin
1654 end
1666 var
1668 begin
1671 repeat
1673 begin
1677 end
1678 else
1679 begin
1681 begin
1684 end
1694 var
1696 begin
1698 begin
1706 var
1708 begin
1710 begin
1717 begin
1721 begin
1722 // print literal part
1725 // output literal part
1727 begin
1729 begin
1731 break;
1735 begin
1739 end
1740 else
1741 begin
1745 continue;
1747 // check if we have argument for this format string
1749 begin
1752 break;
1754 // skip percent
1758 // parse format; check for sign
1762 // parse width
1765 begin
1766 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1770 begin
1776 end
1777 else
1778 begin
1782 // parse precision
1785 begin
1788 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1791 begin
1798 // get format char
1802 // done parsing format, check for valid format chars
1803 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;
1804 // now write formatted string
1807 begin
1808 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;
1817 begin
1819 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], 'true')
1824 begin
1826 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], AnsiChar('t'))
1831 begin
1836 else
1837 begin
1840 break;
1846 begin
1853 begin
1858 else
1859 begin
1862 break;
1865 //vtWideChar: begin end; // args[curarg].VWideChar (WideChar)
1869 begin
1876 begin
1882 begin
1884 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(trunc(args[curarg].VExtended^)));
1888 begin
1890 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], LongWord(trunc(args[curarg].VExtended^)));
1893 else
1894 begin
1897 break;
1901 begin
1909 begin
1918 begin
1926 else
1927 begin
1930 break;
1935 begin
1939 end
1940 else
1941 begin
1949 begin
1950 if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := '<nil>';
1956 begin
1957 if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := '<nil>';
1962 //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
1964 begin
1969 //vtCurrency: begin end; // args[curarg].VCurrency (PCurrency)
1970 //vtVariant: begin end; // args[curarg].VVariant^ (PVariant)
1971 //vtInterface: begin end; // args[curarg].VInterface (Pointer);
1972 //vtWideString: begin end; // args[curarg].VWideString (Pointer);
1974 begin
1979 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1984 begin
1986 begin
1988 begin
1993 end
1994 else
1995 begin
1998 end
1999 else
2000 begin
2008 begin
2013 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2017 if (sign <> '-') then begin if zeropad then indent0(width-pclen) else indent(width-pclen); end;
2021 else
2022 begin
2025 break;
2034 var
2038 begin
2042 // get age
2045 // get size
2051 // fill info
2059 (*
2060 var
2061 ss: ShortString;
2062 ls: AnsiString;
2063 i64: Int64 = -$A000000000;
2064 ui64: UInt64 = $A000000000;
2065 begin
2066 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']);
2067 writef(conwriter, 'test float:<%s;%u;%f;%g>'#10, [666.6942, 666.6942, 666.6942, 666.6942]);
2068 ss := 'fuckit';
2069 ls := 'FUCKIT';
2070 writef(conwriter, 'test ss:<%5s;%040s>'#10, [ss, ss]);
2071 writef(conwriter, 'test ls:<%5s;%040s>'#10, [ls, ls]);
2072 writef(conwriter, 'test pointer:<%s;%x;%p>'#10, [@ss, @ss, @ss]);
2073 writef(conwriter, 'test i64:<%s;%x;%015d;%u;%X>'#10, [i64, i64, i64, i64, i64]);
2074 writef(conwriter, 'test ui64:<%s;%x;%15d;%015u;%X>'#10, [ui64, ui64, ui64, ui64, ui64]);
2075 *)