(*
/*

CLASS {NATIVE_Zlib|_Pascal_KOL},
UNTESTED, BYTES, NATIVE,
ABSTRACT:

IMPORT: {Stream} .

NATIVE: "uses NATIVE_Zlib;" .
NATIVE: "///COPY NATIVE_Zlib.pas" .
*/
*)

unit NATIVE_Zlib;

interface

uses AL4, All_classes, Windows, KOL, KOLZlib;

type
	PNATIVE_Zlib = ^TNATIVE_Zlib;
	TNATIVE_Zlib = object(TObj)
		public a_out: PStream;
		public z_out: PStream;
		public a_in: PStream;
		public z_in: PStream;
		public handle: Integer;
		closed: Boolean;
		destructor Destroy; virtual;
	end;

(*
/*

FUNCTION Create_zlib_decompress_in|put_stream(
{Stream} In|put_stream) ==> INT RESULT|_handle, NATIVE :
"	RESULT := Do_create_zlib_decompress_in(X_In);" .

FUNCTION Create_zlib_compress|_stream(
{Stream} Out|put_stream,
INT Level|_compression) ==> INT RESULT|_handle, NATIVE :
"	RESULT := Do_create_zlib_compress(X_Out, X_Level);" .

FUNCTION Zlib_output(INT Handle|_of_zlib,
BYTE Source|_array[*]), NATIVE :
	CASE Source[].Count == 0 ? ==> ;
	NATIVE @
"	Do_output(X_Handle, X_Source);" .

FUNCTION Zlib_input|_decompress(INT Handle|_of_zlib,
BYTE Source|_array[*]) ==> INT, NATIVE :
	CASE Source[].Count == 0 ? ==> ;
	NATIVE @
"	RESULT := Do_input(X_Handle, X_Source);" .

FUNCTION Zlib_stream_close(INT Handle|_of_zlib), NATIVE :
"	Do_zlib_close(X_Handle);" .

FUNCTION Zlib_native_decompress_to_file(
INT Handle|_of_zlib, 
STR Dest|ination_file_path,
INT Len|gth_source) ==> BOOL, NATIVE :
"	RESULT := Do_decompress_to_file(X_Handle, X_Dest, X_Len);" .

FUNCTION Zlib_header_length ==> INT := 2 .
// DeflateStream used with the KOL adds 2 leading bytes(usually 78 DA 
// - this depends on the compression level) 

*/
*)

const ZLIB_ERROR      = TStrmSize (-1);

    function Do_create_zlib_decompress_in(X_In: Ref_obj): Integer;
	function Do_create_zlib_compress(X_Out: Ref_obj; X_Level: Integer): Integer;
	function Do_decompress_to_file(X_Handle: Integer;
		const X_Dest: String; X_Len: Integer): Boolean;
	procedure Do_output(X_Handle: Integer; X_Source: DynAByte);
    function Do_input(X_Handle: Integer; X_Dest: DynAByte): Integer;
	procedure Do_zlib_close(X_Handle: Integer);

implementation

    function Read_AL4_Stream(
    	Strm: PStream; var Buffer; const Count: TStrmSize): TStrmSize;
	    var
	    	xdest: DynAByte;
	    	AL4_stream: Ref_obj;
	    	Cstream: C_Stream;
    begin
        xdest := New_FixAByte_Array(nil, @Byte(Buffer), Count, 0, Count-1);
		
    	AL4_stream := Ref_obj(Strm.Methods.fCustom);
    	Cstream := C_Stream(AL4_stream.Obj);
        Result := Cstream.M_Read_bytes(xdest);
    	
        xdest.Free;
    end;
    
	function Write_AL4_Stream(
	Strm: PStream; var Buffer; 
		const Count: TStrmSize): TStrmSize;
		var
			xdest, final_dest: DynAByte;
			AL4_stream: Ref_obj;
			Cstream: C_Stream;
	begin
		xdest := New_FixAByte_Array(nil, @Byte(Buffer), Count, 0, Count-1);
		
    	AL4_stream := Ref_obj(Strm.Methods.fCustom);
    	Cstream := C_Stream(AL4_stream.Obj);
		Result := Cstream.M_Save_bytes(xdest);
		
		xdest.Free;
	end;
	
	procedure Close_AL4_Stream (
	Strm: PStream);
		var
			xdest, final_dest: DynAByte;
			AL4_stream: Ref_obj;
			Cstream: C_Stream;
	begin
    	AL4_stream := Ref_obj(Strm.Methods.fCustom);
    	Cstream := C_Stream(AL4_stream.Obj);
		Cstream.M_Close();
	end;
	
	procedure DummySetSize(
	Strm: PStream; const Value: TStrmSize);
	asm
	end;
	
	function DummyReadWrite (
	Strm: PStream; var Buffer;
			const Count: TStrmSize): TStrmSize;
	begin
	  	Result := ZLIB_ERROR;
	end;
	
	function DummyGetSize(
	Strm: PStream): TStrmSize;
	begin
		Result:= 0; // ZLIB_ERROR;
	end;
	
	function DummySeek(
	Strm: PStream; const Offset: TStrmMove;
		Origin: TMoveMethod): TStrmSize;
	begin
		Result := 0; // ZLIB_ERROR;
	end;
	

const
  Out_AL4_Stream_Methods: TStreamMethods = (
    fSeek:   DummySeek;
    fGetSiz: DummyGetSize;
    fSetSiz: DummySetSize;
    fRead:   DummyReadWrite;
    fWrite:  Write_AL4_Stream;
    fClose:  Close_AL4_Stream;
    fCustom: nil;                    );

  In_AL4_Stream_Methods: TStreamMethods = (
    fSeek:   DummySeek;
    fGetSiz: DummyGetSize;
    fSetSiz: DummySetSize;
    fRead:   Read_AL4_Stream;
    fWrite:  DummyReadWrite;
    fClose:  Close_AL4_Stream;
    fCustom: nil;                    );

    //function Do_create_zlib_decompress(X_Out: Ref_obj): Integer;
    //var nz: PNATIVE_Zlib;
    //begin
    //    new(nz, Create);
    //    nz.a_out = _NewStream(Out_AL4_Stream_Methods);
    //    nz.z_out = NewCompressionStream(nz.a_out, CompressionMode.Decompress, true);
    //    return Integer(nz);
    //end;
	
function Do_create_zlib_decompress_in(
    X_In: Ref_obj): Integer;
	var nz: PNATIVE_Zlib;
    begin
		new(nz, Create);
        nz.a_in := _NewStream(In_AL4_Stream_Methods);
        nz.a_in.Methods.fCustom := X_In;
        nz.z_in := NewDecompressionStream(nz.a_in, nil);
        Result := Integer(nz);
        nz.handle := Result;
    end;
	
function Do_create_zlib_compress(
	X_Out: Ref_obj; X_Level: Integer): Integer;
	var nz: PNATIVE_Zlib;
	var Level: TCompressionLevel;
	begin
		new(nz, Create);
		nz.a_out := _NewStream(Out_AL4_Stream_Methods);
		nz.a_out.Methods.fCustom := X_Out;
		Level := clDefault;
		case X_Level of 
		0: Level := clNone;
		1: Level := clFastest;
		9: Level := clMax;
		end;
		nz.z_out := NewCompressionStream(Level, nz.a_out, nil);
		Result := Integer(nz);	
		nz.handle := Result;
	end;
	
procedure Do_zlib_close(
	X_Handle: Integer);
	var nz: PNATIVE_Zlib;
	begin
		nz := PNATIVE_Zlib(X_Handle);
		if nz.closed then Exit;
		Free_And_Nil(nz.z_out);
		Free_And_Nil(nz.z_in);
		nz.closed := true;
	end;
	
destructor TNATIVE_Zlib.Destroy;
	begin
		if not closed then Do_ZLib_close(handle);
		handle := 0;
		inherited;
	end;
	
function Do_input(
    X_Handle: Integer; X_Dest: DynAByte): Integer;
	var nz: PNATIVE_Zlib;
	begin
		nz := PNATIVE_Zlib(X_Handle);
		Result := 0;
        if nz.z_in = nil then Exit;
        Result := nz.z_in.Read(X_Dest.First_byte^, X_Dest.Count);
    end;

procedure Do_output(
	X_Handle: Integer; X_Source: DynAByte);
	var nz: PNATIVE_Zlib;
	begin
		nz := PNATIVE_Zlib(X_Handle);
		if nz.z_out = nil then Exit;
		nz.z_out.Write(X_Source.First_byte^, X_Source.Count);
	end;
	
function StreamCopy (Dest, Source: PStream; Count: DWord): DWord;
const
  MAXBUFSIZE = $F0000;
  STRM_ERROR = DWORD(-1);
var
  BufSize: DWord;
  Readed: DWord;
  Buffer: PChar;
  Need: DWord;
begin
  If Count=0 then begin
    Source.Position:=0;
    Count:=Source.Size;
  end;
  Result:=0;
  If Count>MAXBUFSIZE then BufSize:=MAXBUFSIZE else BufSize:=Count;
  GetMem(Buffer, BufSize);
  try // => try .. finally works for 'Exit' command even without Kol_Err.pas !
    repeat
      If Count>BufSize then Need:=BufSize else Need:=Count;
      Readed:=Source.Read (Buffer^, Need);
      If Readed=STRM_ERROR then Exit;
      If Dest.Write (Buffer^, Readed)=STRM_ERROR then Exit;
      Dec(Count, Readed);
      Inc(Result, Readed);
    until (Count=0) or (Readed=0) or (Readed=STRM_ERROR);
  finally
    FreeMem(Buffer, BufSize);
  end;
end;
	
function Do_decompress_to_file(
		X_Handle: Integer;
		const X_Dest: String;
		X_Len: Integer): Boolean;
	var nz: PNATIVE_Zlib;
		dest: PStream;
	begin
		Result := false;
		nz := PNATIVE_Zlib(X_Handle);
		if nz.z_in = nil then Exit;
		dest := NewWriteFileStream(X_Dest);
		Result := StreamCopy(dest, nz.z_in, X_Len) = X_Len;
		dest.Free;
	end;
	
end.

(*
/*

END

*/
*)
