{$MODESWITCH AUTODEREF}
unit dbit;

interface

uses
  dtypes,
  dstrnum,
  dmath,
  dcolors,
  dstream,
  dstream_op,
  dtexture2d;

const
  BIT_RLE        = 2;
  BIT_COLORING   = 4;

type
TTexture2dFormatBit = object(TTexture2dFormat)
  function ReadHeaderAndCheckSupported(Stream: PStream; var W, H, F: Integer): Boolean;
  function CheckFormat(Stream: PStream): Boolean; virtual;
  function Load(Stream: PStream; var Texture: TTexture2dRgba): Boolean; virtual;
end;

implementation

function TTexture2dFormatBit.ReadHeaderAndCheckSupported(Stream: PStream; var W, H, F: Integer): Boolean;
begin
  W := Stream.ReadInt;
  H := Stream.ReadInt;
  F := Stream.ReadInt;
  Result := IsPot(W) and (W = H) and (W >= 8) and (W <= 4096);
end;

function TTexture2dFormatBit.CheckFormat(Stream: PStream): Boolean;
var
  W, H, F: Integer;
begin
  Result := ReadHeaderAndCheckSupported(Stream, W, H, F);
end;

procedure DoColoring(Texture: TTexture2dRgba; X, Y: Integer; C: TColor);
var
  B: TColor;
begin
  B := Texture[X, Y];
  Texture[X, Y] := C;
  if (X - 1 >= 0) and (B = Texture[X - 1, Y]) then
    DoColoring(Texture, X - 1, Y, C);
  if (X + 1 < Texture.Width) and (B = Texture[X + 1, Y]) then
    DoColoring(Texture, X + 1, Y, C);
  if (Y - 1 >= 0) and (B = Texture[X, Y - 1]) then
    DoColoring(Texture, X, Y - 1, C);
  if (Y + 1 < Texture.Height) and (B = Texture[X, Y + 1]) then
    DoColoring(Texture, X, Y + 1, C);
end;

function TTexture2dFormatBit.Load(Stream: PStream; var Texture: TTexture2dRgba): Boolean;
var
  X, Y, I, W, H, F: Integer;
  C, Main, Bg: TColor;
  B: Byte;
begin
  Result := False;

  if not ReadHeaderAndCheckSupported(Stream, W, H, F) then
    Exit;

  Main := RGBA($FF, $FF, $FF, $FF);
  Bg := RGBA(0, 0, 0, 0);
  if (F and BIT_COLORING) > 0 then begin
    Main := Stream.ReadUInt;
    Bg := Stream.ReadUInt;
  end;

  // TODO: use TTexture2dMono, direct load bitmask
  Texture.InitRGBA(W, H);
  if (F and BIT_RLE) = 0 then begin
    for Y := 0 to H - 1 do begin
      X := 0;
      while X < W do begin
        B := Stream.ReadByte;
        for I := 0 to 7 do
          if B and (1 shl I) > 0 then begin
            Texture[X + I, Y] := Main;
          end else
            Texture[X + I, Y] := Bg;
        Inc(X, 8);
      end;
    end;
  end else if (F and BIT_RLE) > 0 then begin
    X := 0;
    while LongInt(X) < LongInt(W * H) do begin
      B := Stream.ReadByte;
      for I := 0 to (B and 15) - 1 do begin
        Texture[X, 0] := Bg;
        Inc(X);
      end; 
      for I := 0 to (B shr 4) - 1 do begin
        Texture[X, 0] := Main;
        Inc(X);
      end; 
    end;
  end;

  if (F and BIT_COLORING) > 0 then begin
    B := Stream.ReadByte;
    for I := 0 to B - 1 do begin
      C := Stream.ReadUInt;
      X := Stream.ReadByte;
      Y := Stream.ReadByte;
      if Texture[X, Y] = C then
        continue;
      DoColoring(Texture, X, Y, C);
    end;
  end;

  Result := True;
end;

var
  Format: TTexture2dFormatBit;
initialization
  Format.Init;
  RegistTexture2dFormat(@Format);
end.
