0cedb13e86a64643fb396cfd646d5d589fb30ae9
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
29 // ////////////////////////////////////////////////////////////////////////// //
30 type
32 public
37 private
40 public
43 public
52 // process one byte, return `true` if codepoint is ready
58 // ////////////////////////////////////////////////////////////////////////// //
63 // strips out name from `fn`, leaving trailing slash
66 // ends with '/' or '\'?
69 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
70 // will add slash to `path`, even if `fn` is empty!
73 // does filename have one of ".wad", ".pk3", ".zip" extensions?
76 // does filepath have ".XXX:\" in it?
79 // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip"
82 // check wad signature
85 // convert number to strig with nice commas
95 // `true` if strings are equal; ignoring case for cp1251
102 // findFileCI eats case-insensitive path, traverses it and rewrites it to a
103 // case-sensetive. result value means success.
104 // if file/dir not founded than pathname is in undefined state!
107 // findDiskWad tries to find wad file and rewrites extension if needed
108 // result is new filename or empty string
110 // slashes must be normalized!
113 // they throws
116 // creates file if necessary
119 // little endian
147 // big endian
177 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
179 {$ENDIF}
191 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
193 {$ENDIF}
204 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
206 {$ENDIF}
208 type
211 // returns formatted string if `writerCB` is `nil`, empty string otherwise
212 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
219 // returns string in single or double quotes
220 // single quotes supports only pascal-style '' for single quote char
221 // double quotes supports c-style escapes
222 // function will select quote mode automatically
226 type
228 private
229 //type PItemT = ^ItemT;
232 public
233 type
235 private
239 public
246 private
250 private
257 public
261 //WARNING! don't change list contents in `for ... in`!
271 public
283 type
288 // not changed by info getter; used in other parts of the code
298 implementation
300 uses
301 xstreams;
310 '.dfzip'
311 );
314 // ////////////////////////////////////////////////////////////////////////// //
316 begin
321 begin
326 begin
331 // ////////////////////////////////////////////////////////////////////////// //
333 begin
340 begin
346 begin
351 // ////////////////////////////////////////////////////////////////////////// //
353 begin
361 begin
368 begin
374 begin
381 begin
388 begin
394 begin
401 begin
407 begin
413 var
415 begin
417 begin
427 var
429 begin
431 begin
438 var
440 begin
442 begin
445 end
446 else
447 begin
453 // ////////////////////////////////////////////////////////////////////////// //
454 var
459 // ////////////////////////////////////////////////////////////////////////// //
460 const
462 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
463 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
464 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
465 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
466 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
467 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
468 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
470 );
474 var
476 begin
484 // ////////////////////////////////////////////////////////////////////////// //
485 // fast state-machine based UTF-8 decoder; using 8 bytes of memory
486 // code points from invalid range will never be valid, this is the property of the state machine
487 const
488 // see http://bjoern.hoehrmann.de/utf-8/decoder/dfa/
490 // maps bytes to character classes
507 // maps a combination of a state of the automaton and a character class to a state
517 // ////////////////////////////////////////////////////////////////////////// //
518 constructor TUtf8DecoderFast.Create (v: Boolean{fuck you, fpc}); begin state := Accept; codepoint := 0; end;
524 function TUtf8DecoderFast.completeOrInvalid (): Boolean; inline; begin result := (state = Accept) or (state = Reject); end;
526 function TUtf8DecoderFast.decode (c: AnsiChar): Boolean; inline; overload; begin result := decode(Byte(c)); end;
529 var
531 begin
534 if (state <> Accept) then codepoint := (b and $3f) or (codepoint shl 6) else codepoint := ($ff shr tp) and b;
541 // ////////////////////////////////////////////////////////////////////////// //
543 begin
549 // ////////////////////////////////////////////////////////////////////////// //
551 var
554 begin
556 begin
558 begin
562 begin
565 exit;
573 var
577 begin
580 begin
582 end
584 begin
587 end
589 begin
593 end
595 begin
600 end
601 else
602 begin
607 begin
609 begin
611 begin
614 begin
616 begin
618 end
619 else
620 begin
624 exit;
631 // ////////////////////////////////////////////////////////////////////////// //
633 begin
638 begin
641 end
642 else
643 begin
652 // ////////////////////////////////////////////////////////////////////////// //
656 var
658 begin
661 begin
669 var
672 begin
675 begin
683 begin
686 end
688 begin
691 end
692 else
693 begin
700 var
703 begin
705 begin
713 // ////////////////////////////////////////////////////////////////////////// //
715 var
718 begin
721 begin
724 begin
726 exit;
736 var
739 begin
744 begin
756 var
759 begin
763 begin
766 begin
768 begin
770 end
771 else
772 begin
775 exit;
782 begin
789 // strips out name from `fn`, leaving trailing slash
791 var
794 begin
799 begin
808 // ends with '/' or '\'?
810 begin
812 begin
814 end
815 else
816 begin
822 // strips extra trailing slashes in `path, and extra leading slashes in `fn`
823 // will add slash to `path`, even if `fn` is empty!
825 var
827 begin
831 if (Length(result) > 0) and ((result[Length(result)] <> '/') and (result[Length(result)] <> '\')) then result += '/';
833 begin
835 //FIXME: make this faster!
836 while (Length(result) > 0) and ((result[Length(result)] = '/') or (result[Length(result)] = '\')) do
837 begin
846 var
848 begin
853 //result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip') or StrEquCI1251(ext, '.dfz');
858 begin
866 begin
868 Result :=
869 (* ZIP *)
872 (* PACK *)
875 (* DFWAD *)
876 ((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))
881 var
884 begin
888 begin
890 begin
893 begin
895 if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') or StrEquCI1251(s, '.dfz') then
896 begin
898 exit;
908 var
910 begin
914 begin
921 begin
923 begin
925 end
926 else
927 begin
929 begin
931 end
932 else
933 begin
945 begin
947 begin
949 end
950 else
951 begin
953 begin
955 end
956 else
957 begin
968 begin
973 begin
979 var
981 begin
990 var
993 begin
995 begin
997 begin
1001 exit;
1004 // nothing to do
1009 // ////////////////////////////////////////////////////////////////////////// //
1010 // utils
1011 // `ch`: utf8 start
1012 // -1: invalid utf8
1014 begin
1026 var
1028 begin
1032 begin
1038 // check other sequence bytes
1040 begin
1050 // ////////////////////////////////////////////////////////////////////////// //
1051 const
1053 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
1054 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
1055 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
1056 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
1057 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
1058 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
1059 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
1060 $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
1061 );
1065 var
1067 begin
1068 (* The following encodings are valid, except for the 5 and 6 byte
1069 * combinations:
1070 * 0xxxxxxx
1071 * 110xxxxx 10xxxxxx
1072 * 1110xxxx 10xxxxxx 10xxxxxx
1073 * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
1074 * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1075 * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
1076 *)
1084 // mask out unused bits
1092 // now continue
1094 begin
1102 // done, try 1251
1104 // alas
1109 var
1111 begin
1115 begin
1126 // ////////////////////////////////////////////////////////////////////////// //
1127 // findFileCI eats case-insensitive path, traverses it and rewrites it to a
1128 // case-sensetive. result value means success.
1129 // if file/dir not founded than pathname is in undefined state!
1131 var
1139 begin
1144 begin
1145 // remove trailing slashes
1148 // extract name
1151 begin
1155 // remove trailing slashes again
1158 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1159 // try the easiest case first
1162 begin
1164 begin
1165 // i found her!
1168 continue;
1171 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
1172 // alas, either not found, or invalid attributes
1174 try
1176 repeat
1178 begin
1179 // i found her!
1183 break;
1186 finally
1196 var
1199 begin
1202 // check first ext
1205 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1207 // check second ext
1210 for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end;
1218 var
1221 begin
1223 //writeln('findDiskWad00: fname=<', fname, '>');
1227 //writeln(' findDiskWad01: fname=<', fname, '>; origExt=<', origExt, '>');
1229 begin
1230 //writeln(' findDiskWad02: fname=<', fname, '>; origExt=<', origExt, '>; newExt=<', newExt, '>');
1232 begin
1233 //writeln(' SKIP');
1234 continue;
1244 begin
1245 if not findFileCI(pathname) then raise EFileNotFoundException.Create('can''t open file "'+pathname+'"');
1250 var
1252 begin
1255 begin
1256 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1263 var
1266 begin
1267 //writeln('*** TRYING R/W FILE "', pathname, '"');
1270 begin
1271 if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"');
1275 begin
1276 //writeln('*** found old file "', oldname, '"');
1278 end
1279 else
1280 begin
1287 {$IFDEF ENDIAN_LITTLE}
1288 begin
1291 {$ELSE}
1292 var
1294 begin
1297 begin
1303 {$ENDIF}
1306 {$IFDEF ENDIAN_LITTLE}
1307 var
1309 begin
1312 begin
1318 {$ELSE}
1319 begin
1322 {$ENDIF}
1325 begin
1330 var
1333 begin
1336 begin
1338 begin
1341 end
1342 else
1343 begin
1345 begin
1364 procedure writeIntBE (st: TStream; v: ShortInt); overload; begin writeIntegerBE(st, @v, 1); end;
1366 procedure writeIntBE (st: TStream; v: SmallInt); overload; begin writeIntegerBE(st, @v, 2); end;
1367 procedure writeIntBE (st: TStream; v: LongWord); overload; begin writeIntegerBE(st, @v, 4); end;
1368 procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(st, @v, 4); end;
1377 begin
1379 if (maxlen <= 65535) then writeInt(st, Word(Length(str))) else writeInt(st, LongWord(Length(str)));
1384 var
1386 begin
1391 begin
1399 {$IFDEF ENDIAN_LITTLE}
1400 begin
1403 {$ELSE}
1404 var
1406 begin
1409 begin
1415 {$ENDIF}
1418 {$IFDEF ENDIAN_LITTLE}
1419 var
1421 begin
1424 begin
1430 {$ELSE}
1431 begin
1434 {$ENDIF}
1455 // ////////////////////////////////////////////////////////////////////////// //
1456 function nmin (a, b: Byte): Byte; inline; overload; begin if (a < b) then result := a else result := b; end;
1457 function nmin (a, b: ShortInt): ShortInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1458 function nmin (a, b: Word): Word; inline; overload; begin if (a < b) then result := a else result := b; end;
1459 function nmin (a, b: SmallInt): SmallInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1460 function nmin (a, b: LongWord): LongWord; inline; overload; begin if (a < b) then result := a else result := b; end;
1461 function nmin (a, b: LongInt): LongInt; inline; overload; begin if (a < b) then result := a else result := b; end;
1462 function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then result := a else result := b; end;
1463 function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end;
1464 function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end;
1465 function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end;
1466 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1467 function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end;
1468 {$ENDIF}
1470 function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end;
1471 function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1472 function nmax (a, b: Word): Word; inline; overload; begin if (a > b) then result := a else result := b; end;
1473 function nmax (a, b: SmallInt): SmallInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1474 function nmax (a, b: LongWord): LongWord; inline; overload; begin if (a > b) then result := a else result := b; end;
1475 function nmax (a, b: LongInt): LongInt; inline; overload; begin if (a > b) then result := a else result := b; end;
1476 function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then result := a else result := b; end;
1477 function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end;
1478 function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end;
1479 function nmax (a, b: Double): Double; inline; overload; begin if (a > b) then result := a else result := b; end;
1480 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1481 function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end;
1482 {$ENDIF}
1484 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;
1485 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;
1486 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;
1487 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;
1488 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;
1489 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;
1490 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;
1491 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;
1492 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;
1493 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;
1494 {$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)}
1495 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;
1496 {$ENDIF}
1498 // ////////////////////////////////////////////////////////////////////////// //
1499 {$IFDEF WINDOWS}
1500 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf';
1501 {$ELSE}
1502 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'libc' name 'snprintf';
1503 {$ENDIF}
1506 (*
1507 procedure conwriter (constref buf; len: SizeUInt);
1508 var
1509 ss: ShortString;
1510 slen: Integer;
1511 b: PByte;
1512 begin
1513 if (len < 1) then exit;
1514 b := PByte(@buf);
1515 while (len > 0) do
1516 begin
1517 if (len > 255) then slen := 255 else slen := Integer(len);
1518 Move(b^, ss[1], len);
1519 ss[0] := AnsiChar(slen);
1520 write(ss);
1521 b += slen;
1522 len -= slen;
1523 end;
1524 end;
1525 *)
1528 function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
1529 const
1531 PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
1532 var
1548 var
1552 begin
1556 begin
1558 end
1559 else
1560 begin
1562 begin
1574 begin
1579 begin
1585 var
1587 begin
1593 var
1595 begin
1601 begin
1605 begin
1615 begin
1620 var
1623 begin
1625 begin
1629 end
1630 else
1631 begin
1636 repeat
1638 begin
1642 end
1643 else
1644 begin
1646 begin
1649 end
1661 var
1663 begin
1666 repeat
1668 begin
1672 end
1673 else
1674 begin
1676 begin
1679 end
1689 var
1691 begin
1693 begin
1701 var
1703 begin
1705 begin
1712 begin
1716 begin
1717 // print literal part
1720 // output literal part
1722 begin
1724 begin
1726 break;
1730 begin
1734 end
1735 else
1736 begin
1740 continue;
1742 // check if we have argument for this format string
1744 begin
1747 break;
1749 // skip percent
1753 // parse format; check for sign
1757 // parse width
1760 begin
1761 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1765 begin
1771 end
1772 else
1773 begin
1777 // parse precision
1780 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;
1786 begin
1793 // get format char
1797 // done parsing format, check for valid format chars
1798 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;
1799 // now write formatted string
1802 begin
1803 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;
1812 begin
1814 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], 'true')
1819 begin
1821 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], AnsiChar('t'))
1826 begin
1831 else
1832 begin
1835 break;
1841 begin
1848 begin
1853 else
1854 begin
1857 break;
1860 //vtWideChar: begin end; // args[curarg].VWideChar (WideChar)
1864 begin
1871 begin
1877 begin
1879 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(trunc(args[curarg].VExtended^)));
1883 begin
1885 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], LongWord(trunc(args[curarg].VExtended^)));
1888 else
1889 begin
1892 break;
1896 begin
1904 begin
1913 begin
1921 else
1922 begin
1925 break;
1930 begin
1934 end
1935 else
1936 begin
1944 begin
1945 if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := '<nil>';
1951 begin
1952 if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := '<nil>';
1957 //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
1959 begin
1964 //vtCurrency: begin end; // args[curarg].VCurrency (PCurrency)
1965 //vtVariant: begin end; // args[curarg].VVariant^ (PVariant)
1966 //vtInterface: begin end; // args[curarg].VInterface (Pointer);
1967 //vtWideString: begin end; // args[curarg].VWideString (Pointer);
1969 begin
1974 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1979 begin
1981 begin
1983 begin
1988 end
1989 else
1990 begin
1993 end
1994 else
1995 begin
2003 begin
2008 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
2012 if (sign <> '-') then begin if zeropad then indent0(width-pclen) else indent(width-pclen); end;
2016 else
2017 begin
2020 break;
2029 var
2033 begin
2037 // get age
2040 // get size
2046 // fill info
2054 (*
2055 var
2056 ss: ShortString;
2057 ls: AnsiString;
2058 i64: Int64 = -$A000000000;
2059 ui64: UInt64 = $A000000000;
2060 begin
2061 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']);
2062 writef(conwriter, 'test float:<%s;%u;%f;%g>'#10, [666.6942, 666.6942, 666.6942, 666.6942]);
2063 ss := 'fuckit';
2064 ls := 'FUCKIT';
2065 writef(conwriter, 'test ss:<%5s;%040s>'#10, [ss, ss]);
2066 writef(conwriter, 'test ls:<%5s;%040s>'#10, [ls, ls]);
2067 writef(conwriter, 'test pointer:<%s;%x;%p>'#10, [@ss, @ss, @ss]);
2068 writef(conwriter, 'test i64:<%s;%x;%015d;%u;%X>'#10, [i64, i64, i64, i64, i64]);
2069 writef(conwriter, 'test ui64:<%s;%x;%15d;%015u;%X>'#10, [ui64, ui64, ui64, ui64, ui64]);
2070 *)