From 8ec025719a9658f2f60a2b7324991dd6ef7b73ef Mon Sep 17 00:00:00 2001 From: admin_d Date: Tue, 15 Sep 2026 17:16:23 +0500 Subject: [PATCH] Complete BigTask --- config/extra-paths.json | 3 +- .../kam_remake/src/utils/KromUtils.pas | 552 ++++++++++++++++++ 2 files changed, 554 insertions(+), 1 deletion(-) create mode 100644 port-source/kam_remake/src/utils/KromUtils.pas diff --git a/config/extra-paths.json b/config/extra-paths.json index d55bf81..6c2623d 100755 --- a/config/extra-paths.json +++ b/config/extra-paths.json @@ -4,7 +4,8 @@ "src/utils/io/KM_FileIO.pas", "src/common/KM_CommonClasses.pas", "src/settings/KM_GameSettings.pas", - "src/utils/io/KM_IoXML.pas" + "src/utils/io/KM_IoXML.pas", + "src/utils/KromUtils.pas" ], "source_paths": [ "code/resource" diff --git a/port-source/kam_remake/src/utils/KromUtils.pas b/port-source/kam_remake/src/utils/KromUtils.pas new file mode 100644 index 0000000..a6a1e55 --- /dev/null +++ b/port-source/kam_remake/src/utils/KromUtils.pas @@ -0,0 +1,552 @@ +unit KromUtils; +{$I KaM_Remake.inc} +interface +uses + Classes; + +type + TAnsiStringArray = array of AnsiString; + TUnicodeStringArray = array of UnicodeString; + TSetOfAnsiChar = set of AnsiChar; + + +function ExtractOpenedFileName(const in_s: string):string; +function GetFileExt (const FileName: string): string; +function AssureFileExt(const FileName,Ext:string): string; +function TruncateExt(const FileName:string): string; +function GetFileSize(const FileName: string): LongInt; +function CheckSameContents(const A, B: string): Boolean; +function CharInSet(C: AnsiChar; S: TSetOfAnsiChar): Boolean; overload; +function CharInSet(C: WideChar; S: TSetOfAnsiChar): Boolean; overload; + +procedure FreeThenNil(var Obj); + +function ReverseString(const s1:string):string; + +function int2fix(Number,Len:integer):string; + +function Min(const A,B,C: integer):integer; overload; +function Min(const A,B,C: single):single; overload; +function Min(Values: array of Single): Single; overload; +function PickMin(Values: array of Single): Byte; + +function Max(const A,B,C: Integer): Integer; overload; +function Max(const A,B,C: Single): Single; overload; + + function GetLengthSQR(ix,iy,iz: integer): integer; //Length without SQRT + function GetLength(ix,iy,iz: single): single; overload; + function GetLength(ix,iy: single): single; overload; + function GetLength(ix,iy: integer): single; overload; + function GetLengthI(ix,iy: integer): single; overload; + + function Mix(x1,x2,MixValue:single):single; overload; + function Mix(x1,x2:integer; MixValue:single):integer; overload; + function Lerp(A,B: Single; MixValue: Single): Single; + + procedure decs(var AText: string; const Len: integer = 1); overload; + procedure decs(var AText: widestring; const Len: integer = 1); overload; + function decs(const AText: string; Len, RunAsFunction: integer): string; overload; + function RemoveQuotes(const Input: string): string; + procedure SwapStr(var A, B: string); + procedure SwapBool(var A, B: Boolean); + procedure SwapInt(var A, B: Byte); overload; + procedure SwapInt(var A, B: ShortInt); overload; + procedure SwapInt(var A, B: SmallInt); overload; + procedure SwapInt(var A, B: Word); overload; + procedure SwapInt(var A, B: Integer); overload; + procedure SwapInt(var A, B: Cardinal); overload; + procedure SwapFloat(var A, B: Single); + function Equals(A, B: single; const Epsilon: Single = 0.001): Boolean; + +function MakePOT(num: Integer): Integer; +function Adler32CRC(aPointer: Pointer; aLength: Cardinal): Cardinal; overload; +function Adler32CRC(const aPath: string): Cardinal; overload; +function Adler32CRC(S: TMemoryStream): Cardinal; overload; +function RandomS(Range_Both_Directions:integer):integer; overload; +function RandomS(Range_Both_Directions:single):single; overload; + +function CheckDuplicateApplication(const aGUID: string): Boolean; + +function CountMatches(const aString, aSubString: string): Integer; + +const + EolA: AnsiString = #13#10; //EndOfLine + EolW: UnicodeString = #0013#0010; //EndOfLine + + +implementation +uses + SysUtils; + + +function Min(const A,B,C: integer): integer; overload; +begin + if A < B then if A < C then Result := A else Result := C + else if B < C then Result := B else Result := C; +end; + +function Min(const A,B,C: single): single; overload; +begin + if A < B then if A < C then Result := A else Result := C + else if B < C then Result := B else Result := C; +end; + + +function Min(Values: array of Single): Single; +var + I: Integer; +begin + Result := Values[0]; + for I := 1 to High(Values) do + if Values[I] < Result then + Result := Values[I]; +end; + + +//Pick minimum value and return its index +//if two or more values are equal then first in list is returned +function PickMin(Values: array of Single): Byte; +var + I: Integer; +begin + Result := 0; + for I := 1 to High(Values) do + if Values[I] < Values[Result] then + Result := I; +end; + + +function Max(const A,B,C: integer): integer; overload; +begin if A > B then if A > C then Result := A else Result := C + else if B > C then Result := B else Result := C; +end; + +function Max(const A,B,C: single): single; overload; +begin if A > B then if A > C then Result := A else Result := C + else if B > C then Result := B else Result := C; +end; + + +//I re-add this it is required by KM_Editor. +function ExtractOpenedFileName(const in_s: string): string; +var k:word; out_s:string; QMarks:boolean; +begin +k:=0; out_s:=''; QMarks:=False; + +repeat //First of all skip exe path +inc(k); + if in_s[k]='"' then + repeat inc(k); + until(in_s[k]='"'); +until((k>=length(in_s))or(in_s[k]=#32)); //in_s[k]=#32 now + +inc(k); //in_s[k]=" or first char + +if (length(in_s)>k)and(in_s[k]=#32) then //Skip doublespace, WinXP bug ? + repeat + inc(k); + until((k>=length(in_s))or(in_s[k]<>#32)); + +if (length(in_s)>k) then begin + + if in_s[k]='"' then begin + inc(k); //Getting path from "...." + QMarks:=True; + end; + + repeat + out_s:=out_s+in_s[k]; + inc(k); + until((length(in_s)=k-1)or(in_s[k]='"')or((QMarks=False)and(in_s[k]=' '))); + +end else out_s:=''; + +Result:=out_s; +end; + + +//Returns file extension without dot +function GetFileExt(const FileName: string): string; +begin + Result := ExtractFileExt(FileName); + if length(Result)>0 then + Result := UpperCase(Copy(Result, 2, length(Result)-1)) + else + Result := ''; +end; + + +function AssureFileExt(const FileName,Ext:string): string; +begin +if (Ext='')or(GetFileExt(FileName)=UpperCase(Ext)) then + Result:=FileName +else + Result:=FileName+'.'+Ext; +end; + + +//Look for last dot and truncate it +function TruncateExt(const FileName:string): string; +var i:word; DotPlace:word; +begin + DotPlace := length(FileName) + 1; //In case there's no Extension + for i:=1 to length(FileName) do + if FileName[i] = '.' then //FileExtension separator is always a . + DotPlace := i; + + Result := Copy(FileName, 1, DotPlace - 1); +end; + + +function GetFileSize(const FileName: string): LongInt; +var + SearchRec: TSearchRec; +begin + try + if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then + Result := SearchRec.Size + else + Result := -1; + finally + SysUtils.FindClose(SearchRec); + end; +end; + + +function CheckSameContents(const A, B: string): Boolean; +var S1, S2: TMemoryStream; I: Cardinal; +begin + Result := FileExists(A) and FileExists(B); + + if Result then + begin + S1 := TMemoryStream.Create; + S1.LoadFromFile(A); + S2 := TMemoryStream.Create; + S2.LoadFromFile(B); + + Result := (S1.Size = S2.Size); + + if Result then + begin + I := 0; + repeat + Result := PByte(NativeUInt(S1.Memory) + I)^ = PByte(NativeUInt(S2.Memory) + I)^; + Inc(I); + until (not Result or (I = S1.Size)); + end; + + S1.Free; + S2.Free; + end; +end; + + +function CharInSet(C: AnsiChar; S: TSetOfAnsiChar): Boolean; +begin + Result := C in S; +end; + + +function CharInSet(C: WideChar; S: TSetOfAnsiChar): Boolean; +begin + Result := (Ord(C) <= MAXBYTE) and (AnsiChar(C) in S); +end; + + +procedure FreeThenNil(var Obj); +begin + TObject(Obj).Free; + Pointer(Obj) := nil; +end; + + +function ReverseString(const s1: string): string; +var + s2: string; + i: integer; +begin + s2 := s1; // preparing ? + for i := 1 to length(s1) do + s2[i] := s1[length(s1) - i + 1]; + ReverseString := s2; +end; + + +function int2fix(Number, Len: integer): string; +var + ss: string; + x: byte; +begin + ss := inttostr(Number); + for x := length(ss) to Len - 1 do + ss := '0' + ss; + if length(ss) > Len then + ss := '**********'; // ss[99999999]:='0'; //generating an error in lame way + setlength(ss, Len); + Result := ss; +end; + + +// Return closest bigger PowerOfTwo number +function MakePOT(num: integer): integer; +begin + num := num - 1; + num := num OR (num SHR 1); + num := num OR (num SHR 2); + num := num OR (num SHR 4); + num := num OR (num SHR 8); + num := num OR (num SHR 16); // 32bit needs no more + Result := num + 1; +end; + + +function GetLengthSQR(ix, iy, iz: integer): integer; +begin + Result := sqr(ix) + sqr(iy) + sqr(iz); +end; + + +function GetLength(ix, iy, iz: single): single; overload; +begin + Result := sqrt(sqr(ix) + sqr(iy) + sqr(iz)); +end; + + +function GetLength(ix, iy: single): single; overload; +begin + Result := sqrt(sqr(ix) + sqr(iy)); +end; + + +function GetLength(ix, iy: integer): single; overload; +begin + Result := sqrt(sqr(ix) + sqr(iy)); +end; + + +function GetLengthI(ix, iy: integer): single; overload; +begin + Result := GetLength(ix, iy); +end; + + +function Mix(x1, x2, MixValue: single): single; overload; +begin + Result := x1 * MixValue + x2 * (1 - MixValue); +end; + + +function Mix(x1, x2: integer; MixValue: single): integer; overload; +begin + Result := round(x1 * MixValue + x2 * (1 - MixValue)); +end; + + +function Lerp(A,B: Single; MixValue: Single): Single; +begin + Result := A + (B - A) * MixValue; +end; + + +procedure decs(var AText: string; const Len: integer = 1); +begin + if length(AText) <= abs(Len) then + AText := '' + else if Len >= 0 then + AText := Copy(AText, 1, length(AText) - Len) + else + AText := Copy(AText, 1 + abs(Len), length(AText) - abs(Len)); +end; + + +procedure decs(var AText: widestring; const Len: integer = 1); +begin + if length(AText) <= abs(Len) then + AText := '' + else if Len >= 0 then + AText := Copy(AText, 1, length(AText) - Len) + else + AText := Copy(AText, 1 + abs(Len), length(AText) - abs(Len)); +end; + + +function decs(const AText: string; Len, RunAsFunction: integer): string; overload; +begin + if length(AText) <= abs(Len) then + Result := '' + else if Len >= 0 then + Result := Copy(AText, 1, length(AText) - Len) + else + Result := Copy(AText, 1 + abs(Len), length(AText) - abs(Len)); +end; + + +function RemoveQuotes(const Input: string): string; +var + i, k: integer; +begin + Result := ''; + k := 1; + while (Input[k] <> '"') and (k <= length(Input)) do + inc(k); + if k = length(Input) then + exit; // No quotes found + + for i := k + 1 to length(Input) do + if Input[i] <> '"' then + Result := Result + Input[i] + else + exit; // Will exit on first encountered quotes from 2nd character +end; + + +procedure SwapStr(var A, B: string); +var + S: string; +begin + S := A; A := B; B := S; +end; + + +procedure SwapBool(var A, B: Boolean); +var + S: Boolean; +begin + S := A; A := B; B := S; +end; + + +procedure SwapInt(var A, B: byte); +var + S: Byte; +begin + S := A; A := B; B := S; +end; + + +procedure SwapInt(var A, B: shortint); +var + S: Shortint; +begin + S := A; A := B; B := S; +end; + + +procedure SwapInt(var A,B:smallint); +var + s: Smallint; +begin + s:=A; A:=B; B:=s; +end; + + +procedure SwapInt(var A,B:word); +var + s: Word; +begin + s:=A; A:=B; B:=s; +end; + +procedure SwapInt(var A,B: Integer); +var + s: Integer; +begin + s:=A; A:=B; B:=s; +end; + +procedure SwapInt(var A,B: Cardinal); +var + s: Cardinal; +begin + s:=A; A:=B; B:=s; +end; + +procedure SwapFloat(var A,B:single); +var + s: Single; +begin + s:=A; A:=B; B:=s; +end; + + +function Equals(A,B: Single; const Epsilon: Single = 0.001): Boolean; +begin + Result := Abs(A-B) <= Epsilon; +end; + + +function Adler32CRC(aPointer: Pointer; aLength: Cardinal): Cardinal; +const + MAX_PRIME_16BIT = 65521; // 65521 is the largest prime number smaller than 2^16 +var + I, A, B: Cardinal; +begin + A := 1; + B := 0; // A is initialized to 1, B to 0 + + if aLength <> 0 then // Check to avoid CardinalOverflow on -1 + for I := 0 to aLength - 1 do + begin + Inc(A, pByte(NativeUInt(aPointer) + I)^); + // We need to MOD B within cos it may overflow in files larger than 65kb, A overflows with files larger than 16mb + B := (B + A) mod MAX_PRIME_16BIT; + end; + + A := A mod MAX_PRIME_16BIT; + Result := B + A shl 16; // Reverse order for smaller numbers +end; + + +function Adler32CRC(const aPath: string): Cardinal; +var + S: TMemoryStream; +begin + Result := 0; + if not FileExists(aPath) then + Exit; + + S := TMemoryStream.Create; + try + S.LoadFromFile(aPath); + Result := Adler32CRC(S); + finally + S.Free; + end; +end; + + +function Adler32CRC(S: TMemoryStream): Cardinal; +begin + Result := Adler32CRC(S.Memory, S.Size); +end; + + +function RandomS(Range_Both_Directions: integer): integer; overload; +begin + Result := Random(Range_Both_Directions * 2 + 1) - Range_Both_Directions; +end; + + +function RandomS(Range_Both_Directions: single): single; overload; +begin + Result := Random(round(Range_Both_Directions * 20000) + 1) / 10000 - Range_Both_Directions; +end; + + +function CheckDuplicateApplication(const aGUID: string): Boolean; +begin + Result := False; +end; + + +// Case sensitive +function CountMatches(const aString, aSubString: string): Integer; +begin + if (aString = '') or (aSubString = '') or (Pos(aSubString, aString) = 0) then + Result := 0 + else + Result := (Length(aString) - Length(StringReplace(aString, aSubString, '', [rfReplaceAll]))) div Length(aSubString); +end; + +end.