DEADSOFTWARE

Cosmetic: DooM 2D:Forever -> Doom 2D: Forever
[d2df-sdl.git] / src / shared / xstreams.pas
index f62582b1bd0854acf19a77242f37788fb80732b9..e27f73ad0eb9c94c8f964649e0d969a22b0e78e6 100644 (file)
@@ -1,6 +1,21 @@
+(* 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
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ *)
 // special stream classes
-{$MODE OBJFPC}
-{$R+}
+{$INCLUDE a_modes.inc}
+{.$R+}
 unit xstreams;
 
 interface
@@ -95,6 +110,7 @@ type
     fSize: Int64; // can be -1
     fSrcStPos: Int64;
     fSkipToPos: Int64; // >0: skip to this position
+    fKillSrc: Boolean;
 
     procedure reset ();
     function readBuf (var buffer; count: LongInt): LongInt;
@@ -103,13 +119,36 @@ type
 
   public
     // `aSize` can be -1 if stream size is unknown
-    constructor create (asrc: TStream; aSize: Int64; aSkipHeader: boolean=false);
+    constructor create (asrc: TStream; aSize: Int64; aKillSrc: Boolean; aSkipHeader: boolean=false);
     destructor destroy (); override;
     function read (var buffer; count: LongInt): LongInt; override;
     function write (const buffer; count: LongInt): LongInt; override;
     function seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
   end;
 
+  // fixed memory chunk
+  TSFSMemoryChunkStream = class(TStream)
+  private
+    fFreeMem: Boolean;
+    fMemBuf: PByte;
+    fMemSize: Integer;
+    fCurPos: Integer;
+
+  public
+    // if `pMem` is `nil`, stream will allocate it
+    constructor Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
+    destructor Destroy (); override;
+
+    procedure setup (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
+
+    function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override;
+    function Read (var buffer; count: LongInt): LongInt; override;
+    function Write (const buffer; count: LongInt): LongInt; override;
+
+    property chunkSize: Integer read fMemSize;
+    property chunkData: PByte read fMemBuf;
+  end;
+
 
 implementation
 
@@ -288,121 +327,240 @@ end;
 { TUnZStream }
 const ZBufSize = 32768; // size of the buffer used for temporarily storing data from the child stream
 
-constructor TUnZStream.create (asrc: TStream; aSize: Int64; aSkipHeader: boolean=false);
+
+constructor TUnZStream.create (asrc: TStream; aSize: Int64; aKillSrc: Boolean; aSkipHeader: boolean=false);
 var
   err: Integer;
 begin
+  fKillSrc := aKillSrc;
   fPos := 0;
   fSkipToPos := -1;
   fSrcSt := asrc;
   fSize := aSize;
   GetMem(fBuffer, ZBufSize);
   fSkipHeader := aSkipHeader;
+  fSrcStPos := fSrcSt.position;
+  FillChar(fZlibSt, sizeof(fZlibSt), 0);
   if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
   if err <> Z_OK then raise XStreamError.Create(zerror(err));
-  fSrcStPos := fSrcSt.position;
 end;
 
+
 destructor TUnZStream.destroy ();
 begin
   inflateEnd(fZlibSt);
   FreeMem(fBuffer);
-  fSrcSt.Free;
-  inherited destroy;
+  if fKillSrc then fSrcSt.Free();
+  inherited Destroy();
 end;
 
+
 function TUnZStream.readBuf (var buffer; count: LongInt): LongInt;
 var
   err: Integer;
-  lastavail: LongInt;
+  sz: LongInt;
 begin
-  fZlibSt.next_out := @buffer;
-  fZlibSt.avail_out := count;
-  lastavail := count;
-  while fZlibSt.avail_out <> 0 do
+  result := 0;
+  if (fSize >= 0) and (fPos >= fSize) then exit;
+  if count > 0 then
   begin
-    if fZlibSt.avail_in = 0 then
+    fZlibSt.next_out := @buffer;
+    fZlibSt.avail_out := count;
+    sz := fZlibSt.avail_out;
+    while fZlibSt.avail_out > 0 do
     begin
-      // refill the buffer
-      fZlibSt.next_in := fBuffer;
-      fZlibSt.avail_in := fSrcSt.read(Fbuffer^, ZBufSize);
-      //Inc(compressed_read, fZlibSt.avail_in);
-      Inc(fPos, lastavail-fZlibSt.avail_out);
-      lastavail := fZlibSt.avail_out;
+      if fZlibSt.avail_in = 0 then
+      begin
+        // refill the buffer
+        fZlibSt.next_in := fBuffer;
+        fZlibSt.avail_in := fSrcSt.read(Fbuffer^, ZBufSize);
+      end;
+      err := inflate(fZlibSt, Z_NO_FLUSH);
+      if (err <> Z_OK) and (err <> Z_STREAM_END) then raise XStreamError.Create(zerror(err));
+      Inc(result, sz-fZlibSt.avail_out);
+      Inc(fPos, sz-fZlibSt.avail_out);
+      sz := fZlibSt.avail_out;
+      if err = Z_STREAM_END then begin fSize := fPos; break; end;
     end;
-    err := inflate(fZlibSt, Z_NO_FLUSH);
-    if err = Z_STREAM_END then fSize := fPos; break;
-    if err <> Z_OK then raise XStreamError.Create(zerror(err));
   end;
-  //if err = Z_STREAM_END then Dec(compressed_read, fZlibSt.avail_in);
-  Inc(fPos, lastavail-fZlibSt.avail_out);
-  result := count-fZlibSt.avail_out;
 end;
 
+
 procedure TUnZStream.fixPos ();
 var
   buf: array [0..4095] of Byte;
   rd, rr: LongInt;
 begin
   if fSkipToPos < 0 then exit;
-  if fSkipToPos > fPos then reset();
+  //writeln('fixing pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
+  if fSkipToPos < fPos then reset();
   while fPos < fSkipToPos do
   begin
     if fSkipToPos-fPos > 4096 then rd := 4096 else rd := LongInt(fSkipToPos-fPos);
+    //writeln('  reading ', rd, ' bytes...');
     rr := readBuf(buf, rd);
-    if rd <> rr then raise XStreamError.Create('seek error');
+    //writeln('  got ', rr, ' bytes; fPos=', fPos, '; fSkipToPos=', fSkipToPos);
+    if rr <= 0 then raise XStreamError.Create('seek error');
   end;
+  //writeln('  pos: fPos=', fPos, '; fSkipToPos=', fSkipToPos);
   fSkipToPos := -1;
 end;
 
+
 procedure TUnZStream.determineSize ();
 var
   buf: array [0..4095] of Byte;
   rd: LongInt;
+  opos: Int64;
 begin
   if fSize >= 0 then exit;
-  while true do
-  begin
-    rd := readBuf(buf, 4096);
-    if rd <> 4096 then break;
+  opos := fPos;
+  try
+    //writeln('determining unzstream size...');
+    while true do
+    begin
+      rd := readBuf(buf, 4096);
+      if rd = 0 then break;
+    end;
+    fSize := fPos;
+    //writeln('  unzstream size is ', fSize);
+  finally
+    if fSkipToPos < 0 then fSkipToPos := opos;
   end;
-  fSize := fPos;
 end;
 
+
 function TUnZStream.read (var buffer; count: LongInt): LongInt;
 begin
   if fSkipToPos >= 0 then fixPos();
   result := readBuf(buffer, count);
 end;
 
+
 function TUnZStream.write (const buffer; count: LongInt): LongInt;
 begin
   result := 0;
   raise XStreamError.Create('can''t write to read-only stream');
 end;
 
+
 procedure TUnZStream.reset ();
 var
   err: Integer;
 begin
+  //writeln('doing RESET');
   fSrcSt.position := fSrcStPos;
   fPos := 0;
   inflateEnd(fZlibSt);
+  FillChar(fZlibSt, sizeof(fZlibSt), 0);
   if fSkipHeader then err := inflateInit2(fZlibSt, -MAX_WBITS) else err := inflateInit(fZlibSt);
   if err <> Z_OK then raise XStreamError.Create(zerror(err));
 end;
 
+
 function TUnZStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
+var
+  cpos: Int64;
 begin
+  cpos := fPos;
+  if fSkipToPos >= 0 then cpos := fSkipToPos;
   case origin of
     soBeginning: result := offset;
-    soCurrent: result := offset+fPos;
-    soEnd: begin if fSize = -1 then determineSize(); result := fSize+offset; end;
+    soCurrent: result := offset+cpos;
+    soEnd: begin determineSize(); result := fSize+offset; end;
     else raise XStreamError.Create('invalid Seek() call');
     // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð.
   end;
   if result < 0 then result := 0;
   fSkipToPos := result;
+  //writeln('seek: ofs=', offset, '; origin=', origin, '; result=', result);
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TSFSMemoryChunkStream.Create (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
+begin
+  fMemBuf := nil;
+  fFreeMem := false;
+  fMemSize := 0;
+  fCurPos := 0;
+  setup(pMem, pSize, aFreeMem);
+end;
+
+
+procedure TSFSMemoryChunkStream.setup (pMem: Pointer; pSize: Integer; aFreeMem: Boolean=false);
+begin
+  if fFreeMem then FreeMem(fMemBuf);
+  fMemBuf := nil;
+  fFreeMem := false;
+  fMemSize := 0;
+  fCurPos := 0;
+  if (pSize < 0) then raise XStreamError.Create('invalid chunk size');
+  if (pMem = nil) then
+  begin
+    if (pSize > 0) then
+    begin
+      GetMem(pMem, pSize);
+      if (pMem = nil) then raise XStreamError.Create('out of memory for chunk');
+      aFreeMem := true;
+    end
+    else
+    begin
+      aFreeMem := false;
+    end;
+  end;
+  fFreeMem := aFreeMem;
+  fMemBuf := PByte(pMem);
+  fMemSize := pSize;
+end;
+
+
+destructor TSFSMemoryChunkStream.Destroy ();
+begin
+  if fFreeMem then FreeMem(fMemBuf);
+  inherited;
+end;
+
+
+function TSFSMemoryChunkStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64;
+begin
+  case origin of
+    soBeginning: result := offset;
+    soCurrent: result := offset+fCurPos;
+    soEnd: result := fMemSize+offset;
+    else raise XStreamError.Create('invalid Seek() call');
+  end;
+  if (result < 0) then raise XStreamError.Create('invalid Seek() call');
+  if (result > fMemSize) then result := fMemSize;
+  fCurPos := result;
+end;
+
+
+function TSFSMemoryChunkStream.Read (var buffer; count: LongInt): LongInt;
+var
+  left: Integer;
+begin
+  if (count < 0) then raise XStreamError.Create('negative read');
+  left := fMemSize-fCurPos;
+  if (left < 0) then raise XStreamError.Create('internal error in TSFSMemoryChunkStream (read)');
+  if (count > left) then count := left;
+  if (count > 0) then Move((fMemBuf+fCurPos)^, buffer, count);
+  Inc(fCurPos, count);
+  result := count;
+end;
+
+
+function TSFSMemoryChunkStream.Write (const buffer; count: LongInt): LongInt;
+var
+  left: Integer;
+begin
+  if (count < 0) then raise XStreamError.Create('negative write');
+  left := fMemSize-fCurPos;
+  if (left < 0) then raise XStreamError.Create('internal error in TSFSMemoryChunkStream (write)');
+  if (count > left) then count := left;
+  if (count > 0) then Move(buffer, (fMemBuf+fCurPos)^, count);
+  Inc(fCurPos, count);
+  result := count;
 end;