UNIT CompDeco;

{ History

RvdW 26-03-93 Eerste implementatie.
              Aanpassing aan Initialize tov origineel: de InFile is al open
              en hoeft dus niet meer geopend te worden.
              Aanpassing aan Initialize tov origineel: de OutFile wordt nu
              met path en al opgegeven, ipv dat ParamStr (2) genomen wordt.
              OutByte routine uitgebreid met een buffer ipv direct een byte
              naar disk te schrijven.
}

INTERFACE

USES Globals,
     FBuffer;

PROCEDURE DeCompressFile (VAR pInFile : FBufferType; Path : PathString; DFilename : FilenameString);


IMPLEMENTATION

USES Ramon,
     Logs;

CONST BlockMask   = $80;
      SigByte1    = 31;
      SigByte2    = 157;

      ClearCode   = 256;
      ArrSize     = 4096;
      ArrPtrs     = (65536 DIV 4096)+1;
      MaxTokenLen = 512;

      IOBufSize   = 10000;

TYPE IndexType   = RECORD
                         ArrNr  : BYTE; { 0 = einde chain }
                         Offset : WORD; { in het Arr4096 }
                   END;

     ArrRecord = RECORD
                       Ch   : BYTE;
                       Rest : IndexType;
                 END;

     ArrPtr = ^Arr;
     Arr    = ARRAY[1..ArrSize] OF ArrRecord;

     OutBufferPtr = ^OutBufferArr;
     OutBufferArr = ARRAY[1..IOBufSize] OF BYTE;


VAR FirstPtrsCount : BYTE;
    FirstPtrs      : ARRAY[1..ArrPtrs] OF ArrPtr;

    InFile         : FBufferType;
    OutFile        : FILE;

    BitsNeeded     : BYTE;
    BitsNeededHigh : WORD;
    ComprBits      : BYTE;
    Cur_code       : WORD;
    BitsBuffer     : LONGINT;
    BitsInBuf      : BYTE;
    LastCh         : BYTE;

    OutBuffer      : OutBufferPtr;
    OutPutIndex    : WORD;


PROCEDURE Code2Index (Code : WORD; VAR Index : IndexType);
BEGIN
     Index.ArrNr:=(Code DIV ArrSize)+1;
     Index.Offset:=(Code MOD ArrSize)+1;
END;


FUNCTION ReadCode : WORD;

VAR B : BYTE;

BEGIN
     REPEAT
           B:=FBByteRead (InFile);
           BitsBuffer:=BitsBuffer OR (Longint (B) SHL BitsInBuf);
           Inc (BitsInBuf,8);
     UNTIL (BitsInBuf >= BitsNeeded);

     ReadCode:=BitsBuffer AND ((1 SHL BitsNeeded)-1);
     BitsBuffer:=BitsBuffer SHR BitsNeeded;
     Dec (BitsInBuf,BitsNeeded);
END;


PROCEDURE MakeNewArr;
BEGIN
     Inc (FirstPtrsCount);
     GetMem (FirstPtrs[FirstPtrsCount],SizeOf (Arr));
     {$IFDEF LogGetMem} LogGetMem (FirstPtrs[FirstPtrsCount],SizeOf (Arr),'MakeNewArr'); {$ENDIF}
     WriteXY (1,2,Longint2String (MemAvail)+' ');
END;


PROCEDURE InitTable;

VAR Lp : BYTE;

BEGIN
     FOR Lp:=0 TO 255 DO
         WITH FirstPtrs[1]^[Lp+1] DO
         BEGIN
              Ch:=Lp;
              Rest.ArrNr:=0; { geen rest }
              Rest.Offset:=65535;
         END; { with, for }
END;


PROCEDURE Initialize (TempFile : STRING);
BEGIN
     {FBufferOpen (InFile,ParamStr (1),4096); niet meer nodig }
     IF (FBByteRead (InFile) <> SigByte1) OR
        (FBByteRead (InFile) <> SigByte2) THEN
     BEGIN
        { WriteLn ('Not a compressed file'); }
          LogMessage ('DeCompress received a not-compressed file!!!');
          FBufferClose (InFile);
          Halt; { eh... beetje grof, maar komt toch nooit voor }
     END;

     ComprBits:=(FBByteRead (InFile) AND (255-BlockMask));
   { WriteLn (ComprBits,' bit compression'); }

     Assign (OutFile,TempFile);
     ReWrite (OutFile,1);
     PeekFiles;

     BitsNeeded:=9;
     BitsNeededHigh:=511;
     BitsBuffer:=0;
     BitsInBuf:=0;
     Cur_code:=ClearCode+1;

     GetMem (OutBuffer,SizeOf (OutBufferArr));
     {$IFDEF LogGetMem} LogGetMem (OutBuffer,SizeOf (OutBufferArr),'OutBufferArr'); {$ENDIF}
     WriteXY (1,2,Longint2String (MemAvail)+' ');
     OutPutIndex:=1;

     FirstPtrsCount:=0;
     MakeNewArr;
     InitTable;
END;


PROCEDURE OutCode (B : BYTE);
BEGIN
     OutBuffer^[OutPutIndex]:=B;
     Inc (OutPutIndex);

END;


PROCEDURE OutputString (Index : IndexType);

VAR Tekst : ARRAY[1..MaxTokenLen] OF BYTE;
    Put   : WORD;

BEGIN
     Put:=MaxTokenLen;
     WHILE (Index.ArrNr <> 0) DO
           WITH FirstPtrs[Index.ArrNr]^[Index.Offset] DO
           BEGIN
                Tekst[Put]:=Ch;
                Dec (Put);
                Index:=Rest;
           END;

     BlockWrite (OutFile,Tekst[Put+1],MaxTokenLen-Put);
     LastCh:=Tekst[Put+1];
END;


PROCEDURE Clearing;
BEGIN
     LogMessage ('[DeCompress] Clearing encountered! Don''t know how to handle!');
     BitsNeeded:=9;
     BitsNeededHigh:=511;
     {
     BitsBuffer:=0;
     BitsInBuf:=0;
     }
     Cur_code:=ClearCode+1;

     WHILE (FirstPtrsCount > 0) DO
     BEGIN
          FreeMem (FirstPtrs[FirstPtrsCount],SizeOf (Arr));
          Dec (FirstPtrsCount);
     END;

     MakeNewArr;
     InitTable;
END;


PROCEDURE DeCompress;

VAR Code     : WORD;
    SArrPrev,
    SArrNew,
    SArrCurr : IndexType;

BEGIN
     Code:=ReadCode;
     OutCode (Code);
     Code2Index (Code,SArrPrev);

     WHILE NOT ((InFile.CurPos = InFile.EndPos) AND InFile.EOF) DO
     BEGIN
          Code:=ReadCode;

          IF (Code > Cur_code) THEN
          BEGIN
               LogMessage ('[DeCompress] Bad code! : '+Word2String (Code)+' cur_code='+Word2String (Cur_code));
               Exit;
          END;

          IF (Code = ClearCode) THEN
          BEGIN
               Clearing;
               Code:=ReadCode;
               OutCode (Code);
               Code2Index (Code,SArrPrev);
          END ELSE
          BEGIN
               IF (Code < Cur_code) THEN
               BEGIN
                    Code2Index (Code,SArrCurr);
                    OutputString (SArrCurr);
               END ELSE
               BEGIN { special case handling }
                    OutputString (SArrPrev);
                    OutCode (LastCh);
                    Code2Index (Cur_code,SArrCurr);
               END;

               Code2Index (Cur_code,SArrNew);
               IF (SArrNew.ArrNr > FirstPtrsCount) THEN
                  MakeNewArr;

               WITH FirstPtrs[SArrNew.ArrNr]^[SArrNew.Offset] DO
               BEGIN
                    Ch:=LastCh;
                    Rest:=SArrPrev;
               END; { with }

               Inc (Cur_code);
               IF (Cur_code > BitsNeededHigh) THEN
               BEGIN
                    BitsNeededHigh:=BitsNeededHigh+Cur_code;
                    Inc (BitsNeeded);
                    {
                    IF (BitsNeeded > ComprBits) THEN
                    BEGIN
                         Clearing;

                         Code:=ReadCode;
                         OutCode (Code);
                         Code2Index (Code,SArrCurr);
                    END;
                    }

                  { WriteLn ('New bits: ',BitsNeeded,' at cur_code = ',cur_code);}
               END;

               SArrPrev:=SArrCurr;
           END; { not clearing }
     END; { for }
END;


PROCEDURE CloseFiles;
BEGIN
     FBufferClose (InFile);

     IF (OutPutIndex > IOBufSize) THEN
        BlockWrite (OutFile,OutBuffer,OutPutIndex-1);
     Close (OutFile);
     PeekFiles;

     WHILE (FirstPtrsCount > 0) DO
     BEGIN
          FreeMem (FirstPtrs[FirstPtrsCount],SizeOf (Arr));
          Dec (FirstPtrsCount);
     END;

     FreeMem (OutBuffer,SizeOf (OutBufferArr));
END;


{--------------------------------------------------------------------------}
{ DeCompressFile                                                           }
{                                                                          }
{ Deze routine pakt de opgegeven file, die al open is, uit en maakt een    }
{ tijdelijke file op disk aan om deze in uit te pakken. Daarna wordt de    }
{ originele file afgesloten en verwijderd en de nieuwe gerenamed. Het      }
{ her-openen moet de aanroeper doen ivm buffer groottes enzo.              }
{                                                                          }
PROCEDURE DeCompressFile (VAR pInFile : FBufferType; Path : PathString; DFilename : FilenameString);
BEGIN
     InFile:=pInFile; { open file overnemen }

     LogMessage ('Decompressing '+Path+DFilename);
     Initialize (Path+'STRDECO.$$$');
     Decompress;
     CloseFiles;
     Erase (InFile.Bestand); { wis de oude .D file } { geen error check! }
     Rename (OutFile,Path+DFilename); { hernoem de temp file }

     pInFile:=InFile; { gesloten file teruggeven }
END;


END.
