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, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 {$INCLUDE a_modes.inc}
19 interface
21 uses
25 // does filename have one of ".wad", ".pk3", ".zip" extensions?
28 // does filepath have ".XXX:\" in it?
31 // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip"
34 // convert number to strig with nice commas
40 // `true` if strings are equal; ignoring case for cp1251
47 // `pathname` will be modified if path is valid
48 // `lastIsDir` should be `true` if we are searching for directory
49 // nobody cares about shitdoze, so i'll use the same code path for it
52 // they throws
56 // little endian
75 // big endian
95 type
98 // returns formatted string if `writerCB` is `nil`, empty string otherwise
99 function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
102 implementation
106 begin
113 begin
120 var
123 begin
126 begin
130 begin
133 begin
135 exit;
144 var
146 begin
150 begin
157 begin
159 begin
161 end
162 else
163 begin
165 begin
167 end
168 else
169 begin
181 begin
183 begin
185 end
186 else
187 begin
189 begin
191 end
192 else
193 begin
205 var
207 begin
215 // ////////////////////////////////////////////////////////////////////////// //
216 // utils
217 // `ch`: utf8 start
218 // -1: invalid utf8
220 begin
232 var
234 begin
238 begin
244 // check other sequence bytes
246 begin
256 // ////////////////////////////////////////////////////////////////////////// //
257 const
259 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
260 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
261 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
262 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
263 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
264 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
265 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
267 );
271 var
273 begin
274 (* The following encodings are valid, except for the 5 and 6 byte
275 * combinations:
276 * 0xxxxxxx
277 * 110xxxxx 10xxxxxx
278 * 1110xxxx 10xxxxxx 10xxxxxx
279 * 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
280 * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
281 * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
282 *)
290 // mask out unused bits
298 // now continue
300 begin
308 // done, try 1251
310 // alas
315 var
317 begin
321 begin
332 // ////////////////////////////////////////////////////////////////////////// //
333 // `pathname` will be modified if path is valid
334 // `lastIsDir` should be `true` if we are searching for directory
335 // nobody cares about shitdoze, so i'll use the same code path for it
337 var
345 begin
350 begin
351 // remove trailing slashes
354 // extract name
357 begin
361 // remove trailing slashes again
364 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
365 // try the easiest case first
368 begin
370 begin
371 // i found her!
374 continue;
377 //writeln(Format('npt=[%s]; newname=[%s]; curname=[%s]; wantdir=%d', [npt, newname, curname, Integer(wantdir)]));
378 // alas, either not found, or invalid attributes
380 try
382 repeat
384 begin
385 // i found her!
389 break;
392 finally
402 begin
408 var
410 begin
413 begin
421 {$IFDEF ENDIAN_LITTLE}
422 begin
425 {$ELSE}
426 var
428 begin
431 begin
437 {$ENDIF}
440 {$IFDEF ENDIAN_LITTLE}
441 var
443 begin
446 begin
452 {$ELSE}
453 begin
456 {$ENDIF}
468 procedure writeIntBE (st: TStream; v: ShortInt); overload; begin writeIntegerBE(st, @v, 1); end;
470 procedure writeIntBE (st: TStream; v: SmallInt); overload; begin writeIntegerBE(st, @v, 2); end;
471 procedure writeIntBE (st: TStream; v: LongWord); overload; begin writeIntegerBE(st, @v, 4); end;
478 {$IFDEF ENDIAN_LITTLE}
479 begin
482 {$ELSE}
483 var
485 begin
488 begin
494 {$ENDIF}
497 {$IFDEF ENDIAN_LITTLE}
498 var
500 begin
503 begin
509 {$ELSE}
510 begin
513 {$ENDIF}
534 // ////////////////////////////////////////////////////////////////////////// //
535 {$IFDEF WINDOWS}
536 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf';
537 {$ELSE}
538 function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'libc' name 'snprintf';
539 {$ENDIF}
542 (*
543 procedure conwriter (constref buf; len: SizeUInt);
544 var
545 ss: ShortString;
546 slen: Integer;
547 b: PByte;
548 begin
549 if (len < 1) then exit;
550 b := PByte(@buf);
551 while (len > 0) do
552 begin
553 if (len > 255) then slen := 255 else slen := Integer(len);
554 Move(b^, ss[1], len);
555 ss[0] := AnsiChar(slen);
556 write(ss);
557 b += slen;
558 len -= slen;
559 end;
560 end;
561 *)
564 function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
565 const
567 PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
568 var
583 var
587 begin
591 begin
593 end
594 else
595 begin
597 begin
609 begin
614 begin
620 var
622 begin
628 var
630 begin
636 begin
640 begin
650 begin
655 var
658 begin
660 begin
664 end
665 else
666 begin
671 repeat
673 begin
677 end
678 else
679 begin
681 begin
684 end
696 var
698 begin
701 repeat
703 begin
707 end
708 else
709 begin
711 begin
714 end
724 var
726 begin
728 begin
736 var
738 begin
740 begin
747 begin
751 begin
752 // print literal part
755 // output literal part
757 begin
759 begin
761 break;
765 begin
769 end
770 else
771 begin
775 continue;
777 // check if we have argument for this format string
779 begin
782 break;
784 // skip percent
788 // parse format; check for sign
792 // parse width
795 begin
796 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
800 begin
806 end
807 else
808 begin
812 // parse precision
815 begin
818 if (fmt[spos] < '0') or (fmt[spos] > '9') then begin xwrite('<INVALID FORMAT>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
821 begin
828 // get format char
832 // done parsing format, check for valid format chars
833 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;
834 // now write formatted string
837 begin
838 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;
847 begin
849 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], 'true')
854 begin
856 if args[curarg].VBoolean then strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], AnsiChar('t'))
861 begin
866 else
867 begin
870 break;
876 begin
883 begin
888 else
889 begin
892 break;
895 //vtWideChar: begin end; // args[curarg].VWideChar (WideChar)
899 begin
906 begin
912 begin
914 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], Integer(trunc(args[curarg].VExtended^)));
918 begin
920 strblen := snprintf(@strbuf[0], Length(strbuf), @fmtbuf[0], LongWord(trunc(args[curarg].VExtended^)));
923 else
924 begin
927 break;
931 begin
939 begin
948 begin
956 else
957 begin
960 break;
965 begin
969 end
970 else
971 begin
979 begin
985 begin
990 //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
992 begin
997 //vtCurrency: begin end; // args[curarg].VCurrency (PCurrency)
998 //vtVariant: begin end; // args[curarg].VVariant^ (PVariant)
999 //vtInterface: begin end; // args[curarg].VInterface (Pointer);
1000 //vtWideString: begin end; // args[curarg].VWideString (Pointer);
1002 begin
1007 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1012 begin
1014 begin
1016 begin
1021 end
1022 else
1023 begin
1026 end
1027 else
1028 begin
1036 begin
1041 else begin xwrite('<INVALID FORMAT CHAR>'); writer((PAnsiChar(fmt)+spos-1)^, Length(fmt)-spos+1); break; end;
1045 if (sign <> '-') then begin if zeropad then indent0(width-pclen) else indent(width-pclen); end;
1049 else
1050 begin
1053 break;
1061 (*
1062 var
1063 ss: ShortString;
1064 ls: AnsiString;
1065 i64: Int64 = -$A000000000;
1066 ui64: UInt64 = $A000000000;
1067 begin
1068 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']);
1069 writef(conwriter, 'test float:<%s;%u;%f;%g>'#10, [666.6942, 666.6942, 666.6942, 666.6942]);
1070 ss := 'fuckit';
1071 ls := 'FUCKIT';
1072 writef(conwriter, 'test ss:<%5s;%040s>'#10, [ss, ss]);
1073 writef(conwriter, 'test ls:<%5s;%040s>'#10, [ls, ls]);
1074 writef(conwriter, 'test pointer:<%s;%x;%p>'#10, [@ss, @ss, @ss]);
1075 writef(conwriter, 'test i64:<%s;%x;%015d;%u;%X>'#10, [i64, i64, i64, i64, i64]);
1076 writef(conwriter, 'test ui64:<%s;%x;%15d;%015u;%X>'#10, [ui64, ui64, ui64, ui64, ui64]);
1077 *)