more hashing/compressing/encoding refactor

Villavu · Mar 5, 2024 · e58cd67 · e58cd67
1 parent 9dff099
commit e58cd67
Show file tree

Hide file tree

Showing 13 changed files with 442 additions and 334 deletions.
diff --git a/DocGen/docgen.simba b/DocGen/docgen.simba
@@ -50,6 +50,7 @@ begin
   APIFiles += ['Source\script\imports\simba.import_web.pas',           'Web'            ];
   APIFiles += ['Source\script\imports\simba.import_file.pas',          'File'           ];
   APIFiles += ['Source\script\imports\simba.import_encoding.pas',      'Encoding'       ];
+  APIFiles += ['Source\script\imports\simba.import_compress.pas',      'Compress'       ];
   APIFiles += ['Source\script\imports\simba.import_timing.pas',        'Timing'         ];
   APIFiles += ['Source\script\imports\simba.import_string.pas',        'String'         ];
   APIFiles += ['Source\script\imports\simba.import_process.pas',       'Process'        ];

diff --git a/Source/Simba.lpi b/Source/Simba.lpi
@@ -380,7 +380,7 @@
         <PackageName Value="LCL"/>
       </Item5>
     </RequiredPackages>
-    <Units Count="126">
+    <Units Count="127">
       <Unit0>
         <Filename Value="Simba.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -975,6 +975,10 @@
         <Filename Value="hash/simba.hash_murmur.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit125>
+      <Unit126>
+        <Filename Value="script/imports/simba.import_compress.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit126>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

diff --git a/Source/image/simba.image_fastcompress.pas b/Source/image/simba.image_fastcompress.pas
@@ -14,15 +14,42 @@ interface
 
 uses
   Classes, SysUtils,
-  simba.base, simba.image;
+  simba.base, simba.image, simba.simplelock;
 
 procedure SimbaImage_FastCompress(Images: TSimbaImageArray; var Data: Pointer; out DataSize: SizeUInt);
 function SimbaImage_FastDeCompress(Data: Pointer; DataLen: SizeUInt): TSimbaImageArray;
 
+type
+  TImageCompressThread = class;
+  TImageCompressedEvent = procedure(Sender: TImageCompressThread; Images: TSimbaImageArray; Data: Pointer; DataSize: SizeUInt) of object;
+
+  TImageCompressThread = class(TThread)
+  protected
+    FOnCompressed: TImageCompressedEvent;
+    FEvent: TSimpleWaitableLock;
+    FImages: TSimbaImageArray;
+    FTimeUsed: Double;
+
+    procedure Execute; override;
+  public
+    constructor Create; reintroduce;
+    destructor Destroy; override;
+
+    procedure Push(Images: TSimbaImageArray);
+    procedure WaitCompressing;
+    function IsCompressing: Boolean;
+
+    property TimeUsed: Double read FTimeUsed;
+    property OnCompressed: TImageCompressedEvent read FOnCompressed write FOnCompressed;
+  end;
+
+  PImageCompressThread = ^TImageCompressThread;
+
 implementation
 
 uses
-  SynLZ;
+  SynLZ,
+  simba.datetime;
 
 type
   PImageHeader = ^TImageHeader;
@@ -78,5 +105,66 @@ function SimbaImage_FastDeCompress(Data: Pointer; DataLen: SizeUInt): TSimbaImag
     end;
 end;
 
+constructor TImageCompressThread.Create;
+begin
+  inherited Create(False, 512*512);
+
+  FEvent.Lock();
+end;
+
+destructor TImageCompressThread.Destroy;
+begin
+  Terminate();
+  FEvent.Lock();
+  WaitFor();
+
+  inherited Destroy();
+end;
+
+procedure TImageCompressThread.Execute;
+var
+  Data: Pointer;
+  DataSize: SizeUInt;
+  T: Double;
+begin
+  Data := nil;
+
+  while not Terminated do
+  begin
+    FEvent.WaitLocked(); // unlocked = we have images to compress
+    if Terminated then
+      Break;
+
+    T := HighResolutionTime();
+    SimbaImage_FastCompress(FImages, Data, DataSize);
+    FTimeUsed := HighResolutionTime() - T;
+
+    if Assigned(FOnCompressed) then
+      FOnCompressed(Self, FImages, Data, DataSize);
+
+    FEvent.Lock(); // lock, and wait for unlock again
+  end;
+
+  FreeMem(Data);
+end;
+
+procedure TImageCompressThread.Push(Images: TSimbaImageArray);
+begin
+  FImages := Images;
+
+  FEvent.Unlock();
+end;
+
+procedure TImageCompressThread.WaitCompressing;
+begin
+  while not FEvent.IsLocked() do
+    Sleep(20);
+end;
+
+function TImageCompressThread.IsCompressing: Boolean;
+begin
+  Result := not FEvent.IsLocked();
+end;
+
 end.
 
diff --git a/Source/script/imports/simba.import_compress.pas b/Source/script/imports/simba.import_compress.pas
@@ -0,0 +1,211 @@
+unit simba.import_compress;
+
+{$i simba.inc}
+
+interface
+
+uses
+  Classes, SysUtils,
+  simba.base, simba.script_compiler;
+
+procedure ImportCompress(Compiler: TSimbaScript_Compiler);
+
+implementation
+
+uses
+  lptypes, ffi, SynLZ,
+  simba.image, simba.image_fastcompress, simba.compress, simba.encoding;
+
+(*
+Compress
+========
+Compress data, strings, images.
+*)
+
+procedure _LapeImageCompressThread_Create(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PImageCompressThread(Result)^ := TImageCompressThread.Create();
+end;
+
+procedure _LapeImageCompressThread_Push(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+  PImageCompressThread(Params^[0])^.Push(PSimbaImageArray(Params^[1])^);
+end;
+
+procedure _LapeImageCompressThread_SetOnCompressed(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+  PImageCompressThread(Params^[0])^.OnCompressed := TImageCompressedEvent(Params^[1]^);
+end;
+
+procedure _LapeImageCompressThread_GetOnCompressed(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  TImageCompressedEvent(Result^) := PImageCompressThread(Params^[0])^.OnCompressed;
+end;
+
+procedure _LapeImageCompressThread_TimeUsed(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PDouble(Result)^ := PImageCompressThread(Params^[0])^.TimeUsed;
+end;
+
+procedure _LapeImageCompressThread_IsCompressing(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PBoolean(Result)^ := PImageCompressThread(Params^[0])^.IsCompressing;
+end;
+
+procedure _LapeImageCompressThread_WaitCompressing(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+  PImageCompressThread(Params^[0])^.WaitCompressing();
+end;
+
+(*
+CompressBytes
+-------------
+> function CompressBytes(Bytes: TByteArray): TByteArray;
+
+```{note}
+Zlib compression is used.
+```
+*)
+procedure _LapeCompressBytes(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  TByteArray(Result^) := CompressBytes(TByteArray(Params^[0]^));
+end;
+
+(*
+DecompressBytes
+---------------
+> function DecompressBytes(Bytes: TByteArray): TByteArray;
+
+```{note}
+Zlib compression is used.
+```
+*)
+procedure _LapeDeCompressBytes(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  TByteArray(Result^) := DeCompressBytes(TByteArray(Params^[0]^));
+end;
+
+(*
+CompressString
+--------------
+> function CompressString(Data: String; Encoding: BaseEncoding = BaseEncoding.b64): String;
+
+```{note}
+Zlib compression is used.
+```
+*)
+procedure _LapeCompressString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PString(Result)^ := CompressString(PString(Params^[0])^, BaseEncoding(Params^[1]^));
+end;
+
+(*
+DecompressBytes
+---------------
+> function DeCompressString(Data: String; Encoding: BaseEncoding = BaseEncoding.b64): String;
+
+```{note}
+Zlib compression is used.
+```
+*)
+procedure _LapeDeCompressString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PString(Result)^ := DeCompressString(PString(Params^[0])^, BaseEncoding(Params^[1]^));
+end;
+
+(*
+SynLZCompress
+-------------
+> function SynLZCompress(Src: Pointer; Size: Integer; Dest: Pointer): Integer;
+*)
+procedure _LapeSynLZCompress(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PInteger(Result)^ := SynLZcompress(PPointer(Params^[0])^, PInteger(Params^[1])^, PPointer(Params^[2])^);
+end;
+
+(*
+SynLZDecompress
+---------------
+> function SynLZDecompress(Src: Pointer; Size: Integer; Dest: Pointer): Integer;
+*)
+procedure _LapeSynLZDecompress(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PInteger(Result)^ := SynLZdecompress(PPointer(Params^[0])^, PInteger(Params^[1])^, PPointer(Params^[2])^);
+end;
+
+(*
+SynLZCompressDestLen
+--------------------
+> function SynLZCompressDestLen(Len: Integer): Integer;
+*)
+procedure _LapeSynLZCompressDestLen(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PInteger(Result)^ := SynLZcompressdestlen(PInteger(Params^[0])^);
+end;
+
+(*
+SynLZDecompressDestLen
+----------------------
+> function SynLZDecompressDestLen(Src: Pointer): Integer;
+*)
+procedure _LapeSynLZDecompressDestLen(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  PInteger(Result)^ := SynLZdecompressdestlen(PPointer(Params^[0])^);
+end;
+
+(*
+FastCompressImage
+-----------------
+> procedure FastCompressImages(Images: TSimbaImageArray; var Data: Pointer; out DataSize: SizeUInt);
+*)
+procedure _LapeFastCompressImages(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+  SimbaImage_FastCompress(TSimbaImageArray(Params^[0]^), PPointer(Params^[1])^, PSizeUInt(Params^[2])^);
+end;
+
+(*
+FastDeCompressImages
+--------------------
+> function FastDeCompressImages(Data: Pointer; DataLen: SizeUInt): TSimbaImageArray;
+*)
+procedure _LapeFastDeCompressImages(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+  TSimbaImageArray(Result^) := SimbaImage_FastDeCompress(PPointer(Params^[0])^, PSizeUInt(Params^[1])^);
+end;
+
+procedure ImportCompress(Compiler: TSimbaScript_Compiler);
+begin
+  with Compiler do
+  begin
+    ImportingSection := 'Compress';
+
+    addGlobalFunc('function CompressBytes(Bytes: TByteArray): TByteArray', @_LapeCompressBytes);
+    addGlobalFunc('function DecompressBytes(Bytes: TByteArray): TByteArray', @_LapeDecompressBytes);
+
+    addGlobalFunc('function CompressString(S: String; Encoding: BaseEncoding = BaseEncoding.b64): String', @_LapeCompressString);
+    addGlobalFunc('function DecompressString(S: String; Encoding: BaseEncoding = BaseEncoding.b64): String', @_LapeDeCompressString);
+
+    addGlobalFunc('function SynLZCompressDestLen(Len: Integer): Integer', @_LapeSynLZCompressDestLen);
+    addGlobalFunc('function SynLZDecompressDestLen(Src: Pointer): Integer', @_LapeSynLZDecompressDestLen);
+    addGlobalFunc('function SynLZCompress(Src: Pointer; Size: Integer; Dest: Pointer): Integer', @_LapeSynLZCompress);
+    addGlobalFunc('function SynLZDecompress(Src: Pointer; Size: Integer; Dest: Pointer): Integer', @_LapeSynLZDecompress);
+
+    addGlobalFunc('procedure FastCompressImages(Images: TImageArray; var Data: Pointer; out DataSize: SizeUInt);', @_LapeFastCompressImages);
+    addGlobalFunc('function FastDeCompressImages(Data: Pointer; out DataLen: SizeUInt): TImageArray', @_LapeFastDeCompressImages);
+
+    addClass('TImageCompressThread');
+    addClassConstructor('TImageCompressThread', '', @_LapeImageCompressThread_Create);
+    addGlobalType('procedure(Sender: TImageCompressThread; Images: TImageArray; Data: Pointer; DataSize: SizeUInt) of object', 'TImageCompressedEvent', FFI_DEFAULT_ABI);
+    addGlobalFunc('procedure TImageCompressThread.Push(Images: TImageArray)', @_LapeImageCompressThread_Push);
+    addGlobalFunc('procedure TImageCompressThread.SetOnCompressed(Value: TImageCompressedEvent)', @_LapeImageCompressThread_SetOnCompressed);
+    addGlobalFunc('function TImageCompressThread.GetOnCompressed: TImageCompressedEvent', @_LapeImageCompressThread_GetOnCompressed);
+    addGlobalFunc('function TImageCompressThread.TimeUsed: Double', @_LapeImageCompressThread_TimeUsed);
+    addGlobalFunc('function TImageCompressThread.IsCompressing: Boolean', @_LapeImageCompressThread_IsCompressing);
+    addGlobalFunc('procedure TImageCompressThread.WaitCompressing;', @_LapeImageCompressThread_WaitCompressing);
+
+    ImportingSection := '';
+  end;
+end;
+
+end.
+