diff --git a/src/shared/utils.pas b/src/shared/utils.pas
index c182da196a11ed57a1e61716031f8b033ad76424..308293da64e3aed41b94449e6f71a2b3d69727ac 100644 (file)
--- a/src/shared/utils.pas
+++ b/src/shared/utils.pas
SysUtils, Classes;
+// ////////////////////////////////////////////////////////////////////////// //
+type
+ SSArray = array of ShortString;
+
+
// ////////////////////////////////////////////////////////////////////////// //
type
TUtf8DecoderFast = packed record
// ////////////////////////////////////////////////////////////////////////// //
+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 UpCase1251 (ch: Char): Char;
function LoCase1251 (ch: Char): Char;
+function toLowerCase1251 (const s: AnsiString): AnsiString;
+
// `true` if strings are equal; ignoring case for cp1251
function StrEquCI1251 (const s0, s1: AnsiString): Boolean;
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;
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;
+function nmin (a, b: Extended): Extended; inline; overload;
+
+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;
+function nmax (a, b: Extended): Extended; inline; overload;
+
+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;
+function nclamp (v, a, b: Extended): Extended; inline; overload;
+
+
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
function quoteStr (const s: AnsiString): AnsiString;
+type
+ generic TSimpleList<ItemT> = 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,
$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
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 := Char(code and $ff);
+ end
+ else if (code <= $7FF) then
+ begin
+ result := Char($C0 or (code shr 6));
+ result += Char($80 or (code and $3F));
+ end
+ else if (code <= $FFFF) then
+ begin
+ result := Char($E0 or (code shr 12));
+ result += Char($80 or ((code shr 6) and $3F));
+ result += Char($80 or (code and $3F));
+ end
+ else if (code <= $10FFFF) then
+ begin
+ result := Char($F0 or (code shr 18));
+ result += Char($80 or ((code shr 12) and $3F));
+ result += Char($80 or ((code shr 6) and $3F));
+ result += Char($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
// ////////////////////////////////////////////////////////////////////////// //
-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');
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') then
+ begin
+ result := true;
+ exit;
+ end;
end;
end;
- Delete(fn, 1, p);
+ Inc(pos);
end;
end;
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
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 Char;
+ 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 +1227,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 +1310,44 @@ 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;
+function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end;
+
+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;
+function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end;
+
+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;
+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;
+
+
// ////////////////////////////////////////////////////////////////////////// //
{$IFDEF WINDOWS}
function snprintf (buf: PAnsiChar; bufsize: SizeUInt; const fmt: PAnsiChar): SizeUInt; cdecl; varargs; external 'msvcrt.dll' name '_snprintf';
*)
-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';
fmtblen: Integer;
pclen: Integer;
pc: PAnsiChar;
+ ccname: ShortString;
procedure writer (constref buf; len: SizeUInt);
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;
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);
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);
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 := '<nil>';
+ 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 := '<nil>';
+ 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)