unit Windows_BMP_RLE_streams;

{$MODE OBJFPC}
{$M+}

interface
uses classes, type_fixes;


{
RLE:

  code [0=command; >0: repeat]
  data [if code = 0:   0=end_of_row, 1=end_of_bitmap, 2=move position relative to (readByte, readByte), >2: the next n [RLE4:nibbles|RLE8:bytes] will be read literally ]

    0: 	end of row.
    1: 	end of bitmap.
    2: 	move current position. The next row bytes are the relative movement to the right and down. Filling the skipped bytes with background color.
    n=3-255: 	Die folgenden n Bytes (bei BI_RLE4: die folgenden n Nibbles) werden direkt übernommen; der nächste Datensatz findet sich am darauffolgenden geraden Offset (vom Start der Bilddaten aus gezählt).

    Das Resultat wird wie im unkomprimierten Fall interpretiert.
}

type
  // limitation: only supports RLE8 so far!
  TBMP_RLEStream = class(classes.TStream{compat hack})
  private
    fBitmapWidth : TCardinal;
    fBitmapRowStride : TCardinal;
    fBitmapHeight : TCardinal;
    fWrappedStream : TStream;
    fBitmapBackgroundPixel : TUINT32{or less};
    fBitmapBackgroundPixelSize : TSize;
    fBCloseStream : TBoolean;
    fXByte : TCardinal;
  public
    destructor Destroy; override;
  protected
    function EOF_P() : TBoolean; inline;
    function ReadByte() : TByte; inline;
    procedure ReadSlowly(var aBuffer; aCount : Cardinal);
    procedure Remember(const aBuffer; aCount : Cardinal); inline;
  published
    constructor Create(aWrappedStream : TStream; aBCloseStream : TBoolean; aBitmapWidth, aBitmapRowStride, aBitmapHeight : Cardinal; aBackgroundPixel : TUINT32{or less}; aBackgroundPixelSize : TSize);

    { and uncompresses. }
    procedure ReadBuffer(out aBuffer; aBufferSize : Cardinal);
  end;

implementation

uses sysutils;

constructor TBMP_RLEStream.Create(aWrappedStream : TStream; aBCloseStream : TBoolean; aBitmapWidth, aBitmapRowStride, aBitmapHeight : Cardinal; aBackgroundPixel : TUINT32{or less}; aBackgroundPixelSize : TSize);
begin
  fWrappedStream := aWrappedStream;
  fBitmapWidth := aBitmapWidth;
  fBitmapRowStride := aBitmapRowStride;
  fBitmapHeight := aBitmapHeight;
  fBitmapBackgroundPixel := aBackgroundPixel;
  fBitmapBackgroundPixelSize := aBackgroundPixelSize;
  fBCloseStream := aBCloseStream;
  fXByte := 0;
end;

function TBMP_RLEStream.EOF_P() : TBoolean;
begin
  Result := fWrappedStream.Position = fWrappedStream.Size; // ARGH!
end;

destructor TBMP_RLEStream.Destroy;
begin
  if fBCloseStream and Assigned(fWrappedStream) then
    FreeAndNil(fWrappedStream);
end;

procedure TBMP_RLEStream.Remember(const aBuffer; aCount : Cardinal);
begin
  Inc(fXByte, aCount);
  while fXByte >= fBitmapRowStride do
    Dec(fXByte, fBitmapRowStride);
  
  // FIXME.
end;

procedure TBMP_RLEStream.ReadSlowly(var aBuffer; aCount : Cardinal);
var
  vRepeat : TByte;
  vCodeBlock : array[0..255] of TByte;
  vCode : TByte;
  vX : TByte;
  vY : TByte;
  vIndex : TByte;
begin
  if aCount = 0 then
    Exit;

  // TODO what to do if RLE repeats the next 100 bytes BUT the caller doesn't want them all?
  while (not EOF) and (aCount > 0) do begin
    vRepeat := ReadByte();
    vCode := ReadByte();

    if vRepeat = 0 then begin // command
      case vCode of 
        0: begin // end of row. fill remainder of this row with "default background color".
          for vIndex := 1 to (fBitmapRowStride - fXByte) div fBitmapBackgroundPixelSize do begin
            Remember(fBitmapBackgroundPixel, fBitmapBackgroundPixelSize); // FIXME endianness.
          end;
          fXByte := 0;
        end; 
        1: ; // end of bitmap. fill remainder of bitmap with "default background color".
        2: begin // move current position by (relative) (next next), filling with background color.
          vX := ReadByte();
          vY := ReadByte();
          for vIndex := 1 to vX do begin
            Remember(fBitmapBackgroundPixel, fBitmapBackgroundPixelSize); // FIXME endianness.
          end;
          for vIndex := 1 to vY * (fBitmapRowStride div fBitmapBackgroundPixelSize) do begin
            Remember(fBitmapBackgroundPixel, fBitmapBackgroundPixelSize); // FIXME endianness.
          end;
        end;
        else begin
          fWrappedStream.ReadBuffer(vCodeBlock, vCode);
          Remember(vCodeBlock, vCode);
        end;
      end;
    end else begin // repeat
      for vIndex := 1 to vRepeat do 
        Remember(vCode, Sizeof(vCode));
    end;
  end;
end;

{
  like TStream.ReadBuffer: will try to read aBufferSize of actual uncompressed result data from the stream (after uncompression) and return it.
  If that's not possible, will raise EReadError.
}
procedure TBMP_RLEStream.ReadBuffer(out aBuffer; aBufferSize : Cardinal);
begin
  raise EReadError.Create('read error');
end;

function TBMP_RLEStream.ReadByte() : TByte;
begin
  Result := fWrappedStream.ReadByte; // ReadBuffer(Result, 1);
end;

initialization
  assert(Sizeof(TByte) = 1);

end.