X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Futils.pas;h=e62cc1c3fccd98571e3e6680a0216e093c452e86;hb=6a8baf759e33dfda3cf8d9062b6989cfd090a695;hp=c182da196a11ed57a1e61716031f8b033ad76424;hpb=702b2acc2df232119ee6274711134f1d2be19c76;p=d2df-sdl.git diff --git a/src/shared/utils.pas b/src/shared/utils.pas index c182da1..e62cc1c 100644 --- a/src/shared/utils.pas +++ b/src/shared/utils.pas @@ -1,4 +1,4 @@ -(* Copyright (C) DooM 2D:Forever Developers +(* Copyright (C) Doom 2D: Forever Developers * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -22,6 +22,11 @@ uses SysUtils, Classes; +// ////////////////////////////////////////////////////////////////////////// // +type + SSArray = array of ShortString; + + // ////////////////////////////////////////////////////////////////////////// // type TUtf8DecoderFast = packed record @@ -52,23 +57,39 @@ type // ////////////////////////////////////////////////////////////////////////// // +function getFilenameExt (const fn: AnsiString): AnsiString; +function setFilenameExt (const fn, ext: AnsiString): AnsiString; +function forceFilenameExt (const fn, ext: AnsiString): AnsiString; + +// strips out name from `fn`, leaving trailing slash +function getFilenamePath (const fn: AnsiString): AnsiString; + +// ends with '/' or '\'? +function isFilenamePath (const fn: AnsiString): Boolean; + +// strips extra trailing slashes in `path, and extra leading slashes in `fn` +// will add slash to `path`, even if `fn` is empty! +function filenameConcat (const path, fn: AnsiString): AnsiString; + // does filename have one of ".wad", ".pk3", ".zip" extensions? -function hasWadExtension (fn: AnsiString): Boolean; +function hasWadExtension (const fn: AnsiString): Boolean; // does filepath have ".XXX:\" in it? -function isWadPath (fn: AnsiString): Boolean; +function isWadPath (const fn: AnsiString): Boolean; // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip" -function addWadExtension (fn: AnsiString): AnsiString; +function addWadExtension (const fn: AnsiString): AnsiString; // convert number to strig with nice commas -function Int64ToStrComma (i: Int64): AnsiString; +function int64ToStrComma (i: Int64): AnsiString; -function UpCase1251 (ch: Char): Char; -function LoCase1251 (ch: Char): Char; +function upcase1251 (ch: AnsiChar): AnsiChar; inline; +function locase1251 (ch: AnsiChar): AnsiChar; inline; + +function toLowerCase1251 (const s: AnsiString): AnsiString; // `true` if strings are equal; ignoring case for cp1251 -function StrEquCI1251 (const s0, s1: AnsiString): Boolean; +function strEquCI1251 (const s0, s1: AnsiString): Boolean; function utf8Valid (const s: AnsiString): Boolean; @@ -79,11 +100,23 @@ function utf8to1251 (s: AnsiString): AnsiString; // nobody cares about shitdoze, so i'll use the same code path for it function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolean; +// return fixed AnsiString or empty AnsiString +function findDiskWad (fname: AnsiString): AnsiString; + // they throws function openDiskFileRO (pathname: AnsiString): TStream; function createDiskFile (pathname: AnsiString): TStream; // little endian +procedure writeSign (st: TStream; const sign: AnsiString); +function checkSign (st: TStream; const sign: AnsiString): Boolean; + +procedure writeBool (st: TStream; b: Boolean); +function readBool (st: TStream): Boolean; + +procedure writeStr (st: TStream; const str: AnsiString; maxlen: LongWord=65535); +function readStr (st: TStream; maxlen: LongWord=65535): AnsiString; + procedure writeInt (st: TStream; v: Byte); overload; procedure writeInt (st: TStream; v: ShortInt); overload; procedure writeInt (st: TStream; v: Word); overload; @@ -122,14 +155,56 @@ function readInt64BE (st: TStream): Int64; function readUInt64BE (st: TStream): UInt64; +function nmin (a, b: Byte): Byte; inline; overload; +function nmin (a, b: ShortInt): ShortInt; inline; overload; +function nmin (a, b: Word): Word; inline; overload; +function nmin (a, b: SmallInt): SmallInt; inline; overload; +function nmin (a, b: LongWord): LongWord; inline; overload; +function nmin (a, b: LongInt): LongInt; inline; overload; +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)} +function nmin (a, b: Extended): Extended; inline; overload; +{$ENDIF} + +function nmax (a, b: Byte): Byte; inline; overload; +function nmax (a, b: ShortInt): ShortInt; inline; overload; +function nmax (a, b: Word): Word; inline; overload; +function nmax (a, b: SmallInt): SmallInt; inline; overload; +function nmax (a, b: LongWord): LongWord; inline; overload; +function nmax (a, b: LongInt): LongInt; inline; overload; +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)} +function nmax (a, b: Extended): Extended; inline; overload; +{$ENDIF} +function nclamp (v, a, b: Byte): Byte; inline; overload; +function nclamp (v, a, b: ShortInt): ShortInt; inline; overload; +function nclamp (v, a, b: Word): Word; inline; overload; +function nclamp (v, a, b: SmallInt): SmallInt; inline; overload; +function nclamp (v, a, b: LongWord): LongWord; inline; overload; +function nclamp (v, a, b: LongInt): LongInt; inline; overload; +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)} +function nclamp (v, a, b: Extended): Extended; inline; overload; +{$ENDIF} + type TFormatStrFCallback = procedure (constref buf; len: SizeUInt); // returns formatted string if `writerCB` is `nil`, empty string otherwise -function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString; +function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString; function wchar2win (wc: WideChar): AnsiChar; inline; function utf2win (const s: AnsiString): AnsiString; +function win2utf (const s: AnsiString): AnsiString; function digitInBase (ch: AnsiChar; base: Integer): Integer; // returns string in single or double quotes @@ -139,16 +214,215 @@ function digitInBase (ch: AnsiChar; base: Integer): Integer; function quoteStr (const s: AnsiString): AnsiString; +type + generic TSimpleList = class + private + //type PItemT = ^ItemT; + type TItemArr = array of ItemT; + + public + type + TEnumerator = record + private + mItems: TItemArr; + mCount: Integer; + mCurrent: Integer; + public + constructor Create (const aitems: TItemArr; acount: Integer); + function MoveNext: Boolean; + function getCurrent (): ItemT; + property Current: ItemT read getCurrent; + end; + + private + mItems: TItemArr; + mCount: Integer; // can be less than `mItems` size + + private + function getAt (idx: Integer): ItemT; inline; + procedure setAt (idx: Integer; const it: ItemT); inline; + + function getCapacity (): Integer; inline; + procedure setCapacity (v: Integer); inline; + + public + constructor Create (acapacity: Integer=-1); + destructor Destroy (); override; + + //WARNING! don't change list contents in `for ... in`! + function GetEnumerator (): TEnumerator; + + procedure reset (); inline; // won't resize `mItems` + procedure clear (); inline; + + procedure append (constref it: ItemT); inline; + procedure delete (idx: Integer); inline; + function remove (idx: Integer): ItemT; inline; + + public + property count: Integer read mCount; + property capacity: Integer read getCapacity write setCapacity; + property at[idx: Integer]: ItemT read getAt write setAt; default; + end; + + +procedure FillMemory (Dest: Pointer; Len: LongWord; Ch: Byte); inline; +procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline; +procedure ZeroMemory (Dest: Pointer; Len: LongWord); inline; + + implementation +uses + xstreams; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline; +begin + Move(Src^, Dest^, Len); +end; + +procedure FillMemory (Dest: Pointer; Len: LongWord; Ch: Byte); inline; +begin + FillChar(Dest^, Len, Ch); +end; + +procedure ZeroMemory (Dest: Pointer; Len: LongWord); inline; +begin + FillChar(Dest^, Len, 0); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +constructor TSimpleList.TEnumerator.Create (const aitems: TItemArr; acount: Integer); +begin + mItems := aitems; + mCurrent := -1; + mCount := acount; +end; + +function TSimpleList.TEnumerator.MoveNext: Boolean; +begin + Inc(mCurrent); + result := (mCurrent < mCount); +end; +function TSimpleList.TEnumerator.getCurrent (): ItemT; +begin + result := mItems[mCurrent]; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +constructor TSimpleList.Create (acapacity: Integer=-1); +begin + mItems := nil; + if (acapacity > 0) then SetLength(mItems, acapacity); + mCount := 0; +end; + + +destructor TSimpleList.Destroy (); +begin + mItems := nil; + inherited; +end; + + +function TSimpleList.getCapacity (): Integer; inline; +begin + result := Length(mItems); +end; + + +procedure TSimpleList.setCapacity (v: Integer); inline; +begin + if (v < mCount) then v := mCount; + if (v <> Length(mItems)) then SetLength(mItems, v); +end; + + +function TSimpleList.GetEnumerator (): TEnumerator; +begin + if (Length(mItems) > 0) then result := TEnumerator.Create(mItems, mCount) + else result := TEnumerator.Create(nil, -1); +end; + + +procedure TSimpleList.reset (); inline; +begin + mCount := 0; +end; + + +procedure TSimpleList.clear (); inline; +begin + mItems := nil; + mCount := 0; +end; + + +function TSimpleList.getAt (idx: Integer): ItemT; inline; +begin + if (idx >= 0) and (idx < mCount) then result := mItems[idx] else result := Default(ItemT); +end; + + +procedure TSimpleList.setAt (idx: Integer; const it: ItemT); inline; +begin + if (idx >= 0) and (idx < mCount) then mItems[idx] := it; +end; + + +procedure TSimpleList.append (constref it: ItemT); inline; +var + newsz: Integer; +begin + if (mCount >= Length(mItems)) then + begin + newsz := mCount+(mCount div 3)+128; + SetLength(mItems, newsz); + end; + mItems[mCount] := it; + Inc(mCount); +end; + + +procedure TSimpleList.delete (idx: Integer); inline; +var + f: Integer; +begin + if (idx >= 0) and (idx < mCount) then + begin + for f := idx+1 to mCount-1 do mItems[f-1] := mItems[f]; + end; +end; + + +function TSimpleList.remove (idx: Integer): ItemT; inline; +var + f: Integer; +begin + if (idx >= 0) and (idx < mCount) then + begin + result := mItems[idx]; + for f := idx+1 to mCount-1 do mItems[f-1] := mItems[f]; + end + else + begin + result := Default(ItemT); + end; +end; + + +// ////////////////////////////////////////////////////////////////////////// // var wc2shitmap: array[0..65535] of AnsiChar; wc2shitmapInited: Boolean = false; // ////////////////////////////////////////////////////////////////////////// // -procedure initShitMap (); const cp1251: array[0..127] of Word = ( $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F, @@ -160,6 +434,9 @@ const $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F, $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F ); + + +procedure initShitMap (); var f: Integer; begin @@ -258,6 +535,65 @@ begin end; +function win2utf (const s: AnsiString): AnsiString; +var + f, c: Integer; + + function utf8Encode (code: Integer): AnsiString; + begin + if (code < 0) or (code > $10FFFF) then begin result := '?'; exit; end; + if (code <= $7f) then + begin + result := AnsiChar(code and $ff); + end + else if (code <= $7FF) then + begin + result := AnsiChar($C0 or (code shr 6)); + result += AnsiChar($80 or (code and $3F)); + end + else if (code <= $FFFF) then + begin + result := AnsiChar($E0 or (code shr 12)); + result += AnsiChar($80 or ((code shr 6) and $3F)); + result += AnsiChar($80 or (code and $3F)); + end + else if (code <= $10FFFF) then + begin + result := AnsiChar($F0 or (code shr 18)); + 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; + +begin + for f := 1 to Length(s) do + begin + if (Byte(s[f]) > 127) then + begin + result := ''; + for c := 1 to Length(s) do + begin + if (Byte(s[c]) < 128) then + begin + result += s[c]; + end + else + begin + result += utf8Encode(cp1251[Byte(s[c])-128]) + end; + end; + exit; + end; + end; + result := s; +end; + + // ////////////////////////////////////////////////////////////////////////// // function digitInBase (ch: AnsiChar; base: Integer): Integer; begin @@ -341,45 +677,181 @@ end; // ////////////////////////////////////////////////////////////////////////// // -function hasWadExtension (fn: AnsiString): Boolean; +function getFilenameExt (const fn: AnsiString): AnsiString; +var + pos: Integer; + ch: AnsiChar; +begin + pos := Length(fn); + while (pos > 0) do + begin + ch := fn[pos]; + if (ch = '.') then + begin + if (pos = Length(fn)) then result := '' else result := Copy(fn, pos, Length(fn)-pos+1); + exit; + end; + if (ch = '/') or (ch = '\') then break; + Dec(pos); + end; + result := ''; // no extension +end; + + +function setFilenameExt (const fn, ext: AnsiString): AnsiString; +var + pos: Integer; + ch: AnsiChar; +begin + result := fn; + if (Length(ext) = 0) or (ext = '.') then exit; + pos := Length(fn); + while (pos > 0) do + begin + ch := fn[pos]; + if (ch = '.') then exit; + if (ch = '/') or (ch = '\') then break; + Dec(pos); + end; + if (ext[1] <> '.') then result += '.'; + result += ext; +end; + + +function forceFilenameExt (const fn, ext: AnsiString): AnsiString; +var + pos: Integer; + ch: AnsiChar; +begin + result := fn; + pos := Length(fn); + while (pos > 0) do + begin + ch := fn[pos]; + if (ch = '.') then + begin + if (Length(ext) = 0) or (ext = '.') then + begin + result := Copy(fn, 1, pos-1); + end + else + begin + if (ext[1] = '.') then result := Copy(fn, 1, pos-1) else result := Copy(fn, 1, pos); + result += ext; + exit; + end; + end; + if (ch = '/') or (ch = '\') then break; + Dec(pos); + end; + if (Length(ext) > 0) then + begin + if (ext[1] <> '.') then result += '.'; + result += ext; + end; +end; + + +// strips out name from `fn`, leaving trailing slash +function getFilenamePath (const fn: AnsiString): AnsiString; +var + pos: Integer; + ch: AnsiChar; +begin + if (Length(fn) = 0) then begin result := './'; exit; end; + if (fn[Length(fn)] = '/') or (fn[Length(fn)] = '\') then begin result := fn; exit; end; + pos := Length(fn); + while (pos > 0) do + begin + ch := fn[pos]; + if (ch = '/') or (ch = '\') then begin result := Copy(fn, 1, pos); exit; end; + Dec(pos); + end; + result := './'; // no path -> current dir +end; + + +// ends with '/' or '\'? +function isFilenamePath (const fn: AnsiString): Boolean; +begin + if (Length(fn) = 0) then + begin + result := false; + end + else + begin + result := (fn[Length(fn)] = '/') or (fn[Length(fn)] = '\'); + end; +end; + + +// strips extra trailing slashes in `path, and extra leading slashes in `fn` +// will add slash to `path`, even if `fn` is empty! +function filenameConcat (const path, fn: AnsiString): AnsiString; +var + pos: Integer; +begin + pos := 1; + while (pos <= Length(fn)) and ((fn[pos] = '/') or (fn[pos] = '\')) do Inc(pos); + result := path; + if (Length(result) > 0) and ((result[Length(result)] <> '/') and (result[Length(result)] <> '\')) then result += '/'; + if (pos <= Length(fn)) then + begin + result += Copy(fn, pos, Length(fn)-pos+1); + //FIXME: make this faster! + while (Length(result) > 0) and ((result[Length(result)] = '/') or (result[Length(result)] = '\')) do + begin + Delete(result, Length(result), 1); + end; + if (fn[Length(fn)] = '/') or (fn[Length(fn)] = '\') then result += '/'; + end; +end; + + +function hasWadExtension (const fn: AnsiString): Boolean; +var + ext: AnsiString; begin - fn := ExtractFileExt(fn); - result := StrEquCI1251(fn, '.wad') or StrEquCI1251(fn, '.pk3') or StrEquCI1251(fn, '.zip'); + ext := getFilenameExt(fn); + result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip') or StrEquCI1251(ext, '.dfz'); end; -function addWadExtension (fn: AnsiString): AnsiString; +function addWadExtension (const fn: AnsiString): AnsiString; begin result := fn; if not hasWadExtension(result) then result := result+'.wad'; end; -function isWadPath (fn: AnsiString): Boolean; +function isWadPath (const fn: AnsiString): Boolean; var - p: Integer; + pos: Integer; s: AnsiString; begin result := false; - while true do + pos := 1; + while (pos <= Length(fn)) do begin - p := Pos(':', fn); - if (p = 0) or (length(fn)-p < 1) then break; - if (p-4 > 1) and (fn[p-4] = '.') and ((fn[p+1] = '\') or (fn[p+1] = '/')) then + if (fn[pos] = ':') then begin - s := Copy(fn, p-4, 4); - if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') then + if (Length(fn)-pos < 1) then break; + if (pos-4 > 1) and (fn[pos-4] = '.') and ((fn[pos+1] = '\') or (fn[pos+1] = '/')) then begin - result := true; - exit; + s := Copy(fn, pos-4, 4); + if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') or StrEquCI1251(s, '.dfz') then + begin + result := true; + exit; + end; end; end; - Delete(fn, 1, p); + Inc(pos); end; end; -function Int64ToStrComma (i: Int64): AnsiString; +function int64ToStrComma (i: Int64): AnsiString; var f: Integer; begin @@ -392,7 +864,7 @@ begin end; -function UpCase1251 (ch: Char): Char; +function upcase1251 (ch: AnsiChar): AnsiChar; inline; begin if ch < #128 then begin @@ -416,7 +888,7 @@ begin end; -function LoCase1251 (ch: Char): Char; +function locase1251 (ch: AnsiChar): AnsiChar; inline; begin if ch < #128 then begin @@ -440,7 +912,7 @@ begin end; -function StrEquCI1251 (const s0, s1: AnsiString): Boolean; +function strEquCI1251 (const s0, s1: AnsiString): Boolean; var i: Integer; begin @@ -451,6 +923,26 @@ begin end; +function toLowerCase1251 (const s: AnsiString): AnsiString; +var + f: Integer; + ch: AnsiChar; +begin + for ch in s do + begin + if (ch <> LoCase1251(ch)) then + begin + result := ''; + SetLength(result, Length(s)); + for f := 1 to Length(s) do result[f] := LoCase1251(s[f]); + exit; + end; + end; + // nothing to do + result := s; +end; + + // ////////////////////////////////////////////////////////////////////////// // // utils // `ch`: utf8 start @@ -506,7 +998,7 @@ const ); -function decodeUtf8Char (s: AnsiString; var pos: Integer): char; +function decodeUtf8Char (s: AnsiString; var pos: Integer): AnsiChar; var b, c: Integer; begin @@ -524,7 +1016,7 @@ begin b := Byte(s[pos]); Inc(pos); - if b < $80 then begin result := char(b); exit; end; + if b < $80 then begin result := AnsiChar(b); exit; end; // mask out unused bits if (b and $FE) = $FC then b := b and $01 @@ -545,7 +1037,7 @@ begin end; // done, try 1251 - for c := 128 to 255 do if uni2wint[c] = b then begin result := char(c and $FF); exit; end; + for c := 128 to 255 do if uni2wint[c] = b then begin result := AnsiChar(c and $FF); exit; end; // alas end; @@ -637,9 +1129,37 @@ begin end; +const fileExtensions: array [0..6] of AnsiString = ('.dfz', '.wad', '.dfwad', '.pk3', '.pak', '.zip', '.dfzip'); + +function findDiskWad (fname: AnsiString): AnsiString; +var + origExt: AnsiString = ''; + newExt: AnsiString = ''; +begin + result := ''; + //writeln('findDiskWad00: fname=<', fname, '>'); + if (findFileCI(fname)) then begin result := fname; exit; end; + origExt := getFilenameExt(fname); + fname := forceFilenameExt(fname, ''); + //writeln(' findDiskWad01: fname=<', fname, '>; origExt=<', origExt, '>'); + for newExt in fileExtensions do + begin + //writeln(' findDiskWad02: fname=<', fname, '>; origExt=<', origExt, '>; newExt=<', newExt, '>'); + if (StrEquCI1251(newExt, origExt)) then + begin + //writeln(' SKIP'); + continue; + end; + result := fname+newExt; + if (findFileCI(result)) then exit; + end; + result := ''; +end; + + function openDiskFileRO (pathname: AnsiString): TStream; begin - if not findFileCI(pathname) then raise Exception.Create('can''t open file "'+pathname+'"'); + if not findFileCI(pathname) then raise EFileNotFoundException.Create('can''t open file "'+pathname+'"'); result := TFileStream.Create(pathname, fmOpenRead or {fmShareDenyWrite}fmShareDenyNone); end; @@ -694,6 +1214,36 @@ begin end; {$ENDIF} +procedure writeSign (st: TStream; const sign: AnsiString); +begin + if (Length(sign) > 0) then st.WriteBuffer(sign[1], Length(sign)); +end; + +function checkSign (st: TStream; const sign: AnsiString): Boolean; +var + buf: packed array[0..7] of AnsiChar; + f: Integer; +begin + result := false; + if (Length(sign) > 0) then + begin + if (Length(sign) <= 8) then + begin + st.ReadBuffer(buf[0], Length(sign)); + for f := 1 to Length(sign) do if (buf[f-1] <> sign[f]) then exit; + end + else + begin + for f := 1 to Length(sign) do + begin + st.ReadBuffer(buf[0], 1); + if (buf[0] <> sign[f]) then exit; + end; + end; + end; + result := true; +end; + procedure writeInt (st: TStream; v: Byte); overload; begin writeIntegerLE(st, @v, 1); end; procedure writeInt (st: TStream; v: ShortInt); overload; begin writeIntegerLE(st, @v, 1); end; procedure writeInt (st: TStream; v: Word); overload; begin writeIntegerLE(st, @v, 2); end; @@ -712,6 +1262,31 @@ procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(s procedure writeIntBE (st: TStream; v: Int64); overload; begin writeIntegerBE(st, @v, 8); end; procedure writeIntBE (st: TStream; v: UInt64); overload; begin writeIntegerBE(st, @v, 8); end; +procedure writeBool (st: TStream; b: Boolean); begin writeInt(st, Byte(b)); end; +function readBool (st: TStream): Boolean; begin result := (readByte(st) <> 0); end; + + +procedure writeStr (st: TStream; const str: AnsiString; maxlen: LongWord=65535); +begin + if (Length(str) > maxlen) then raise XStreamError.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; + +function readStr (st: TStream; maxlen: LongWord=65535): AnsiString; +var + len: Integer; +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) then + begin + SetLength(result, len); + st.ReadBuffer(result[1], len); + end; +end; + procedure readIntegerLE (st: TStream; vp: Pointer; size: Integer); {$IFDEF ENDIAN_LITTLE} @@ -770,6 +1345,49 @@ function readInt64BE (st: TStream): Int64; begin readIntegerBE(st, @result, 8); function readUInt64BE (st: TStream): UInt64; begin readIntegerBE(st, @result, 8); 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; +function nmin (a, b: SmallInt): SmallInt; inline; overload; begin if (a < b) then result := a else result := b; end; +function nmin (a, b: LongWord): LongWord; inline; overload; begin if (a < b) then result := a else result := b; end; +function nmin (a, b: LongInt): LongInt; inline; overload; begin if (a < b) then result := a else result := b; end; +function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then result := a else result := b; end; +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)} +function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end; +{$ENDIF} + +function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end; +function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end; +function nmax (a, b: Word): Word; inline; overload; begin if (a > b) then result := a else result := b; end; +function nmax (a, b: SmallInt): SmallInt; inline; overload; begin if (a > b) then result := a else result := b; end; +function nmax (a, b: LongWord): LongWord; inline; overload; begin if (a > b) then result := a else result := b; end; +function nmax (a, b: LongInt): LongInt; inline; overload; begin if (a > b) then result := a else result := b; end; +function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then result := a else result := b; end; +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)} +function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end; +{$ENDIF} + +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; +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; +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; +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; +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; +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; +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; +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)} +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} + // ////////////////////////////////////////////////////////////////////////// // {$IFDEF WINDOWS} function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf'; @@ -800,7 +1418,7 @@ end; *) -function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString; +function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString; const PadSpaces: AnsiString = ' '; PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000'; @@ -817,6 +1435,7 @@ var fmtblen: Integer; pclen: Integer; pc: PAnsiChar; + ccname: ShortString; procedure writer (constref buf; len: SizeUInt); var @@ -835,7 +1454,7 @@ var while (len > 0) do begin if (len > 255) then slen := 255 else slen := Integer(len); - Move(b^, ss[1], len); + Move(b^, ss[1], slen); ss[0] := AnsiChar(slen); result += ss; b += slen; @@ -908,7 +1527,7 @@ var xpos := High(strbuf); strbuf[xpos] := #0; Dec(xpos); repeat - if hex then + if not hex then begin strbuf[xpos] := AnsiChar((n mod 10)+48); Dec(xpos); @@ -938,7 +1557,7 @@ var xpos := High(strbuf); strbuf[xpos] := #0; Dec(xpos); repeat - if hex then + if not hex then begin strbuf[xpos] := AnsiChar((n mod 10)+48); Dec(xpos); @@ -1216,15 +1835,17 @@ begin end; vtObject: // args[curarg].VObject.Classname (TObject) begin - if (sign <> '-') then indent(width-Length(args[curarg].VObject.Classname)); - xwrite(args[curarg].VObject.Classname); - if (sign = '-') then indent(width-Length(args[curarg].VObject.Classname)); + if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := ''; + if (sign <> '-') then indent(width-Length(ccname)); + xwrite(ccname); + if (sign = '-') then indent(width-Length(ccname)); end; vtClass: // args[curarg].VClass.Classname (TClass) begin - if (sign <> '-') then indent(width-Length(args[curarg].VClass.Classname)); - xwrite(args[curarg].VClass.Classname); - if (sign = '-') then indent(width-Length(args[curarg].VClass.Classname)); + if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := ''; + if (sign <> '-') then indent(width-Length(ccname)); + xwrite(ccname); + if (sign = '-') then indent(width-Length(ccname)); end; //vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar) vtAnsiString: // AnsiString(args[curarg].VAnsiString) (Pointer)