X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Futils.pas;h=4116c3fdd6c374433aab0ca37c506dab6a5a453e;hb=d4c1e78fe6bfb7cbbff5ced6b94d6e630e06d6f2;hp=5c3c7ba57a48fec14645c3e74b1d88f769f1bb45;hpb=4e2a6e58df94b7b9ff9ae2da91c5b7336fda5d92;p=d2df-sdl.git diff --git a/src/shared/utils.pas b/src/shared/utils.pas index 5c3c7ba..4116c3f 100644 --- a/src/shared/utils.pas +++ b/src/shared/utils.pas @@ -12,6 +12,7 @@ * You should have received a copy of the GNU General Public License * along with this program. If not, see . *) +{$DEFINE D2DF_FORCE_OBJFPC} {$INCLUDE a_modes.inc} unit utils; @@ -26,6 +27,10 @@ type SSArray = array of ShortString; +const + Invalid1251Char = #$98; // Undefined 1251 char, we use it as replacement for unknown chars + InvalidUnicodeCodepoint = $FFFD; // Unicode REPLACEMENT CHARACTER used to replace an unknown, unrecognised, or unrepresentable character + const wadExtensions: array [0..6] of AnsiString = ( '.dfz', '.wad', @@ -36,12 +41,18 @@ const wadExtensions: array [0..6] of AnsiString = ( '.dfzip' ); +{$IF DEFINED(FREEBSD) OR DEFINED(DARWIN)} +const NilThreadId = nil; +{$ELSE} +const NilThreadId = 0; +{$ENDIF} + // ////////////////////////////////////////////////////////////////////////// // type TUtf8DecoderFast = packed record public - const Replacement = $FFFD; // replacement char for invalid unicode + const Replacement = InvalidUnicodeCodepoint; // replacement char for invalid unicode const Accept = 0; const Reject = 12; @@ -71,6 +82,16 @@ function getFilenameExt (const fn: AnsiString): AnsiString; function setFilenameExt (const fn, ext: AnsiString): AnsiString; function forceFilenameExt (const fn, ext: AnsiString): AnsiString; +// rewrites slashes to '/' +function fixSlashes (s: AnsiString): AnsiString; + +// replaces all the shitty characters with '_' +// (everything except alphanumerics, '_', '.') +function sanitizeFilename (s: AnsiString): AnsiString; + +function isAbsolutePath (const s: AnsiString): Boolean; +function isRootPath (const s: AnsiString): Boolean; + // strips out name from `fn`, leaving trailing slash function getFilenamePath (const fn: AnsiString): AnsiString; @@ -116,6 +137,7 @@ function utf8to1251 (s: AnsiString): AnsiString; // necessarily cleared). // last name assumed to be a file, not directory (unless `lastIsDir` flag is set). function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolean; +function findFileCIStr (pathname: AnsiString): AnsiString; // findDiskWad tries to find the wad file using common wad extensions // (see `wadExtensions` array). @@ -179,6 +201,7 @@ function readLongIntBE (st: TStream): LongInt; function readInt64BE (st: TStream): Int64; function readUInt64BE (st: TStream): UInt64; +function nlerp (a, b: Integer; t: Single): Integer; inline; function nmin (a, b: Byte): Byte; inline; overload; function nmin (a, b: ShortInt): ShortInt; inline; overload; @@ -190,7 +213,7 @@ function nmin (a, b: Int64): Int64; inline; overload; function nmin (a, b: UInt64): UInt64; inline; overload; function nmin (a, b: Single): Single; inline; overload; function nmin (a, b: Double): Double; inline; overload; -{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} +{$IFDEF FPC_HAS_TYPE_EXTENDED} function nmin (a, b: Extended): Extended; inline; overload; {$ENDIF} @@ -204,7 +227,7 @@ function nmax (a, b: Int64): Int64; inline; overload; function nmax (a, b: UInt64): UInt64; inline; overload; function nmax (a, b: Single): Single; inline; overload; function nmax (a, b: Double): Double; inline; overload; -{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} +{$IFDEF FPC_HAS_TYPE_EXTENDED} function nmax (a, b: Extended): Extended; inline; overload; {$ENDIF} function nclamp (v, a, b: Byte): Byte; inline; overload; @@ -217,7 +240,7 @@ function nclamp (v, a, b: Int64): Int64; inline; overload; function nclamp (v, a, b: UInt64): UInt64; inline; overload; function nclamp (v, a, b: Single): Single; inline; overload; function nclamp (v, a, b: Double): Double; inline; overload; -{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} +{$IFDEF FPC_HAS_TYPE_EXTENDED} function nclamp (v, a, b: Extended): Extended; inline; overload; {$ENDIF} @@ -237,6 +260,9 @@ function digitInBase (ch: AnsiChar; base: Integer): Integer; // double quotes supports c-style escapes // function will select quote mode automatically function quoteStr (const s: AnsiString): AnsiString; +// separate single-quote and double-quote escape functions +function squoteStr (const s: AnsiString): AnsiString; +function dquoteStr (const s: AnsiString): AnsiString; type @@ -313,8 +339,8 @@ function GetDiskFileInfo (fname: AnsiString; var info: TDiskFileInfo): Boolean; implementation -uses - xstreams; +//uses +// xstreams; // ////////////////////////////////////////////////////////////////////////// // procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline; @@ -333,6 +359,61 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // +// rewrites slashes to '/' +function fixSlashes (s: AnsiString): AnsiString; +{$IFDEF WINDOWS} +var + f: Integer; +{$ENDIF} +begin + result := s; + {$IFDEF WINDOWS} + for f := 1 to length(result) do if (result[f] = '\') then result[f] := '/'; + {$ENDIF} +end; + +// replaces all the shitty characters with '_' +// (everything except alphanumerics, '_', '.') +function sanitizeFilename (s: AnsiString): AnsiString; +var + i: Integer; +const + leaveChars: set of Char = [ '0'..'9', 'A'..'Z', 'a'..'z', '_', '.', #192..#255 ]; + replaceWith: Char = '_'; +begin + result := s; + for i := 1 to length(result) do + if not (result[i] in leaveChars) then + result[i] := replaceWith; +end; + +function isAbsolutePath (const s: AnsiString): Boolean; +begin + result := false; + if (length(s) = 0) then exit; + {$IFDEF WINDOWS} + if (s[1] = '/') or (s[1] = '\') then begin result := true; exit; end; + if (length(s) > 2) and (s[2] = ':') and ((s[3] = '/') or (s[3] = '\')) then begin result := true; exit; end; + {$ELSE} + result := (s[1] = '/'); + {$ENDIF} +end; + + +function isRootPath (const s: AnsiString): Boolean; +begin + result := false; + if (length(s) = 0) then exit; + {$IFDEF WINDOWS} + if (s = '/') or (s = '\') then begin result := true; exit; end; + if (length(s) = 3) and (s[2] = ':') and ((s[3] = '/') or (s[3] = '\')) then begin result := true; exit; end; + {$ELSE} + result := (s = '/'); + {$ENDIF} +end; + + // ////////////////////////////////////////////////////////////////////////// // constructor TSimpleList.TEnumerator.Create (const aitems: TItemArr; acount: Integer); begin @@ -465,7 +546,7 @@ var const cp1251: array[0..127] of Word = ( $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F, - $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F, + $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,InvalidUnicodeCodepoint,$2122,$0459,$203A,$045A,$045C,$045B,$045F, $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407, $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457, $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F, @@ -479,7 +560,7 @@ procedure initShitMap (); var f: Integer; begin - for f := 0 to High(wc2shitmap) do wc2shitmap[f] := '?'; + for f := 0 to High(wc2shitmap) do wc2shitmap[f] := Invalid1251Char; for f := 0 to 127 do wc2shitmap[f] := AnsiChar(f); for f := 0 to 127 do wc2shitmap[cp1251[f]] := AnsiChar(f+128); wc2shitmapInited := true; @@ -547,7 +628,7 @@ end; function wchar2win (wc: WideChar): AnsiChar; inline; begin if not wc2shitmapInited then initShitMap(); - if (LongWord(wc) > 65535) then result := '?' else result := wc2shitmap[LongWord(wc)]; + if (LongWord(wc) > 65535) then result := Invalid1251Char else result := wc2shitmap[LongWord(wc)]; end; @@ -580,7 +661,8 @@ var function utf8Encode (code: Integer): AnsiString; begin - if (code < 0) or (code > $10FFFF) then begin result := '?'; exit; end; + if (code < 0) or (code > $10FFFF) then + code := InvalidUnicodeCodepoint; if (code <= $7f) then begin result := AnsiChar(code and $ff); @@ -602,10 +684,6 @@ var result += AnsiChar($80 or ((code shr 12) and $3F)); result += AnsiChar($80 or ((code shr 6) and $3F)); result += AnsiChar($80 or (code and $3F)); - end - else - begin - result := '?'; end; end; @@ -655,53 +733,52 @@ end; // ////////////////////////////////////////////////////////////////////////// // -function quoteStr (const s: AnsiString): AnsiString; - - function squote (const s: AnsiString): AnsiString; - var - f: Integer; +function squoteStr (const s: AnsiString): AnsiString; +var + f: Integer; +begin + result := ''''; + for f := 1 to Length(s) do begin - result := ''''; - for f := 1 to Length(s) do - begin - if (s[f] = '''') then result += ''''; - result += s[f]; - end; - result += ''''; + if (s[f] = '''') then result += ''''; + result += s[f]; end; + result += ''''; +end; - function dquote (const s: AnsiString): AnsiString; - var - f: Integer; - ch: AnsiChar; +function dquoteStr (const s: AnsiString): AnsiString; +var + f: Integer; + ch: AnsiChar; +begin + result := '"'; + for f := 1 to Length(s) do begin - result := '"'; - for f := 1 to Length(s) do + ch := s[f]; + if (ch = #0) then result += '\z' + else if (ch = #9) then result += '\t' + else if (ch = #10) then result += '\n' + else if (ch = #13) then result += '\r' + else if (ch = #27) then result += '\e' + else if (ch < ' ') or (ch = #127) then begin - ch := s[f]; - if (ch = #0) then result += '\z' - else if (ch = #9) then result += '\t' - else if (ch = #10) then result += '\n' - else if (ch = #13) then result += '\r' - else if (ch = #27) then result += '\e' - else if (ch < ' ') or (ch = #127) then - begin - result += '\x'; - result += LowerCase(IntToHex(Integer(ch), 2)); - end - else if (ch = '"') or (ch = '\') then - begin - result += '\'; - result += ch; - end - else - begin - result += ch; - end; + result += '\x'; + result += LowerCase(IntToHex(Integer(ch), 2)); + end + else if (ch = '"') or (ch = '\') then + begin + result += '\'; + result += ch; + end + else + begin + result += ch; end; - result += '"'; end; + result += '"'; +end; +function quoteStr (const s: AnsiString): AnsiString; var needSingle: Boolean = false; f: Integer; @@ -709,9 +786,9 @@ begin for f := 1 to Length(s) do begin if (s[f] = '''') then begin needSingle := true; continue; end; - if (s[f] < ' ') or (s[f] = #127) then begin result := dquote(s); exit; end; + if (s[f] < ' ') or (s[f] = #127) then begin result := dquoteStr(s); exit; end; end; - if needSingle then result := squote(s) else result := ''''+s+''''; + if needSingle then result := squoteStr(s) else result := ''''+s+''''; end; @@ -974,12 +1051,12 @@ end; function IsValid1251 (ch: Word): Boolean; begin - result := (ch = Ord('?')) or (wc2shitmap[ch] <> '?') + result := wc2shitmap[ch] <> Invalid1251Char end; function IsPrintable1251 (ch: AnsiChar): Boolean; begin - result := (ch >= #32) and (ch <> #127) + result := (ch >= #32) and (ch <> #127) and (ch <> Invalid1251Char) end; @@ -1059,7 +1136,7 @@ end; const uni2wint: array [128..255] of Word = ( $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F, - $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F, + $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,InvalidUnicodeCodepoint,$2122,$0459,$203A,$045A,$045C,$045B,$045F, $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407, $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457, $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F, @@ -1082,7 +1159,7 @@ begin * 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx * 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx *) - result := '?'; + result := Invalid1251Char; if pos > length(s) then exit; b := Byte(s[pos]); @@ -1200,6 +1277,14 @@ begin end; +function findFileCIStr (pathname: AnsiString): AnsiString; +begin + Result := pathname; + if findFileCI(Result) = False then + Result := pathname; +end; + + function isWadNamesEqu (wna, wnb: AnsiString): Boolean; var ext, newExt: AnsiString; @@ -1383,7 +1468,7 @@ function readBool (st: TStream): Boolean; begin result := (readByte(st) <> 0); e procedure writeStr (st: TStream; const str: AnsiString; maxlen: LongWord=65535); begin - if (Length(str) > maxlen) then raise XStreamError.Create('string too long'); + if (Length(str) > maxlen) then raise EStreamError.Create('string too long'); if (maxlen <= 65535) then writeInt(st, Word(Length(str))) else writeInt(st, LongWord(Length(str))); if (Length(str) > 0) then st.WriteBuffer(str[1], Length(str)); end; @@ -1394,7 +1479,7 @@ var begin result := ''; if (maxlen <= 65535) then len := readWord(st) else len := Integer(readLongWord(st)); - if (len < 0) or (len > maxlen) then raise XStreamError.Create('string too long'); + if (len < 0) or (len > maxlen) then raise EStreamError.Create('string too long'); if (len > 0) then begin SetLength(result, len); @@ -1461,6 +1546,8 @@ function readUInt64BE (st: TStream): UInt64; begin readIntegerBE(st, @result, 8) // ////////////////////////////////////////////////////////////////////////// // +function nlerp (a, b: Integer; t: Single): Integer; inline; begin result := round((1.0 - t) * a + t * b); end; + function nmin (a, b: Byte): Byte; inline; overload; begin if (a < b) then result := a else result := b; end; function nmin (a, b: ShortInt): ShortInt; inline; overload; begin if (a < b) then result := a else result := b; end; function nmin (a, b: Word): Word; inline; overload; begin if (a < b) then result := a else result := b; end; @@ -1471,7 +1558,7 @@ function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then resu function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end; function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end; function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end; -{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} +{$IFDEF FPC_HAS_TYPE_EXTENDED} function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end; {$ENDIF} @@ -1485,7 +1572,7 @@ function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then resu function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end; function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end; function nmax (a, b: Double): Double; inline; overload; begin if (a > b) then result := a else result := b; end; -{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} +{$IFDEF FPC_HAS_TYPE_EXTENDED} function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end; {$ENDIF} @@ -1499,7 +1586,7 @@ function nclamp (v, a, b: Int64): Int64; inline; overload; begin if (v < a) then 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; 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; 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; -{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} +{$IFDEF FPC_HAS_TYPE_EXTENDED} 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; {$ENDIF}