unit LZW;

// FIXME finish this.

{$MODE OBJFPC}
{$M+}

{
this file is distributed under the Library GNU General Public License (see the file "LGPL-2.1.TXT") with the following modification:

As a special exception, the copyright holders of this library give you permission to link this library with independent modules to produce an executable, regardless of the license terms of these independent modules, and to copy and distribute the resulting executable under terms of your choice, provided that you also meet, for each linked independent module, the terms and conditions of the license of that module. 
An independent module is a module which is not derived from or based on this library. 
If you modify this library, you may extend this exception to your version of the library, but you are not obliged to do so. 
If you do not wish to do so, delete this exception statement from your version.

If you didn't receive a copy of the file "LGPL-2.1.TXT", contact:
  Free Software Foundation
  675 Mass Ave
  Cambridge, MA  02139
  USA
}

interface
uses ring_buffers, custom_decoders;

type 
  TDecoder = class(custom_decoders.TCustomDecoder)
  published
    procedure Finish(); override;
    function FinishedP() : Boolean; override;
  protected
    procedure DecodeBlock(aEncodedBuffer : PByte; aEncodedBufferCount : Cardinal); override;
    function GetPermittedReadCount(aBufferAvailableSpace : Cardinal) : Cardinal; override;
  end;
  
implementation
uses classes;

// from "fcl-image/src/fpreadtiff.pas".

procedure DecompressLZW(var Buffer: Pointer; var Count: PtrInt);
type
  TLZWString = packed record
    Count: integer;
    Data: PByte;
  end;
  PLZWString = ^TLZWString;
const
  ClearCode = 256; // clear table, start with 9bit codes
  EoiCode = 257; // end of input
var
  NewBuffer: PByte;
  NewCount: PtrInt;
  NewCapacity: PtrInt;
  SrcPos: PtrInt;
  SrcPosBit: integer;
  CurBitLength: integer;
  Code: Word;
  Table: PLZWString;
  TableCapacity: integer;
  TableCount: integer;
  OldCode: Word;

  function GetNextCode: Word;
  var
    v: Integer;
  begin
    Result:=0;
    // CurBitLength can be 9 to 12
    //writeln('GetNextCode CurBitLength=',CurBitLength,' SrcPos=',SrcPos,' SrcPosBit=',SrcPosBit,' ',hexstr(PByte(Buffer)[SrcPos],2),' ',hexstr(PByte(Buffer)[SrcPos+1],2),' ',hexstr(PByte(Buffer)[SrcPos+2],2));
    // read two or three bytes
    if CurBitLength+SrcPosBit>16 then begin
      // read from three bytes
      if SrcPos+3>Count then
        raise EReadError.Create('LZW stream overrun');
      v:=PByte(Buffer)[SrcPos];
      inc(SrcPos);
      v:=(v shl 8)+PByte(Buffer)[SrcPos];
      inc(SrcPos);
      v:=(v shl 8)+PByte(Buffer)[SrcPos];
      v:=v shr (24-CurBitLength-SrcPosBit);
    end else begin
      // read from two bytes
      if SrcPos+2>Count then
        raise EReadError.Create('LZW stream overrun');
        
      v:=PByte(Buffer)[SrcPos];
      inc(SrcPos);
      v:=(v shl 8)+PByte(Buffer)[SrcPos];
      if CurBitLength+SrcPosBit=16 then
        inc(SrcPos);
      v:=v shr (16-CurBitLength-SrcPosBit);
    end;
    Result:=v and ((1 shl CurBitLength)-1);
    SrcPosBit:=(SrcPosBit+CurBitLength) and 7;
    //writeln('GetNextCode END SrcPos=',SrcPos,' SrcPosBit=',SrcPosBit,' Result=',Result,' Result=',hexstr(Result,4));
  end;

  procedure ClearTable;
  var
    i: Integer;
  begin
    for i:=0 to TableCount-1 do
      ReAllocMem(Table[i].Data,0);
    TableCount:=0;
  end;

  procedure InitializeTable;
  begin
    CurBitLength:=9;
    ClearTable;
  end;

  function IsInTable(Code: word): boolean;
  begin
    Result:=Code<258+TableCount;
  end;

  procedure WriteStringFromCode(Code: integer; AddFirstChar: boolean = false);
  var
    s: TLZWString;
    b: byte;
  begin
    //WriteLn('WriteStringFromCode Code=',Code,' AddFirstChar=',AddFirstChar,' x=',(NewCount div 4) mod IDF.ImageWidth,' y=',(NewCount div 4) div IDF.ImageWidth,' PixelByte=',NewCount mod 4);
    if Code<256 then begin
      // write byte
      b:=Code;
      s.Data:=@b;
      s.Count:=1;
    end else if Code>=258 then begin
      // write string
      if Code-258>=TableCount then
        raise EReadError.Create('LZW code out of bounds');
        
      s:=Table[Code-258];
    end else
      raise EReadError.Create('LZW code out of bounds');
      
    if NewCount+s.Count+1>NewCapacity then begin
      NewCapacity:=NewCapacity*2+8;
      ReAllocMem(NewBuffer,NewCapacity);
    end;
    System.Move(s.Data^,NewBuffer[NewCount],s.Count);
    //for i:=0 to s.Count-1 do write(HexStr(NewBuffer[NewCount+i],2)); // debug
    inc(NewCount,s.Count);
    if AddFirstChar then begin
      NewBuffer[NewCount]:=s.Data^;
      //write(HexStr(NewBuffer[NewCount],2)); // debug
      inc(NewCount);
    end;
    //writeln(',WriteStringFromCode'); // debug
  end;

  procedure AddStringToTable(Code, AddFirstCharFromCode: integer);
  // add string from code plus first character of string from code as new string
  var
    b1, b2: byte;
    s1, s2: TLZWString;
    p: PByte;
  begin
    //WriteLn('AddStringToTable Code=',Code,' FCFCode=',AddFirstCharFromCode,' TableCount=',TableCount,' TableCapacity=',TableCapacity);
    // grow table
    if TableCount>=TableCapacity then begin
      TableCapacity:=TableCapacity*2+128;
      ReAllocMem(Table,TableCapacity*SizeOf(TLZWString));
    end;
    // find string 1
    if Code<256 then begin
      // string is byte
      b1:=Code;
      s1.Data:=@b1;
      s1.Count:=1;
    end else if Code>=258 then begin
      // normal string
      if Code-258>=TableCount then
        raise EReadError.Create('LZW code out of bounds');
      s1:=Table[Code-258];
    end else
      raise EReadError.Create('LZW code out of bounds');
    // find string 2
    if AddFirstCharFromCode<256 then begin
      // string is byte
      b2:=AddFirstCharFromCode;
      s2.Data:=@b2;
      s2.Count:=1;
    end else begin
      // normal string
      if AddFirstCharFromCode-258>=TableCount then
        raise EReadError.Create('LZW code out of bounds');
      s2:=Table[AddFirstCharFromCode-258];
    end;
    // set new table entry
    Table[TableCount].Count:=s1.Count+1;
    p:=nil;
    GetMem(p,s1.Count+1);
    Table[TableCount].Data:=p;
    System.Move(s1.Data^,p^,s1.Count);
    // add first character from string 2
    p[s1.Count]:=s2.Data^;
    // increase TableCount
    inc(TableCount);
    case TableCount+259 of
    512,1024,2048: inc(CurBitLength);
    4096: raise EReadError.Create('LZW too many codes');
    end;
  end;

begin
  if Count=0 then exit;
  //WriteLn('TFPReaderTiff.DecompressLZW START Count=',Count);
  //for SrcPos:=0 to 19 do
  //  write(HexStr(PByte(Buffer)[SrcPos],2));
  //writeln();

  NewBuffer:=nil;
  NewCount:=0;
  NewCapacity:=Count*2;
  ReAllocMem(NewBuffer,NewCapacity);

  SrcPos:=0;
  SrcPosBit:=0;
  CurBitLength:=9;
  Table:=nil;
  TableCount:=0;
  TableCapacity:=0;
  try
    repeat
      Code:=GetNextCode;
      //WriteLn('TFPReaderTiff.DecompressLZW Code=',Code);
      if Code=EoiCode then break;
      if Code=ClearCode then begin
        InitializeTable;
        Code:=GetNextCode;
        //WriteLn('TFPReaderTiff.DecompressLZW after clear Code=',Code);
        if Code=EoiCode then break;
        if Code=ClearCode then
          raise EReadError.Create('LZW code out of bounds');
        WriteStringFromCode(Code);
        OldCode:=Code;
      end else begin
        if Code<TableCount+258 then begin
          WriteStringFromCode(Code);
          AddStringToTable(OldCode,Code);
          OldCode:=Code;
        end else if Code=TableCount+258 then begin
          WriteStringFromCode(OldCode,true);
          AddStringToTable(OldCode,OldCode);
          OldCode:=Code;
        end else
          raise EReadError.Create('LZW code out of bounds');
      end;
    until false;
  finally
    ClearTable;
    ReAllocMem(Table,0);
  end;

  ReAllocMem(NewBuffer,NewCount);
  FreeMem(Buffer);
  Buffer:=NewBuffer;
  Count:=NewCount;
end;

{ TDecoder }

procedure TDecoder.Finish();
begin
  // FIXME.
end;

function TDecoder.FinishedP() : Boolean;
begin
  Result := True;
end;

procedure TDecoder.DecodeBlock(aEncodedBuffer : PByte; aEncodedBufferCount : Cardinal);
begin
  raise EReadError.Create('not implemented yet.');
end;

function TDecoder.GetPermittedReadCount(aBufferAvailableSpace : Cardinal) : Cardinal;
begin
  Result := 0; // FIXME.
end;

end.