{$mode delphi}
unit dscreenbuffer;

interface

uses
  dtypes,
  dmath,
  dvector2i,
  dvector4f,
  dcolors;

type
// TODO inherite it from TTexture2dRgba
PScreenBuffer = ^TScreenBuffer;
TScreenBuffer = object
private
  FWidth: Integer;
  FHeight: Integer;
  FData: Pointer;
  procedure AllocData(W, H: Integer);
  procedure FreeData;
public
  constructor Init(Width: Integer = 0; Height: Integer = 0);
  destructor Done; virtual;
  function Create(Width: Integer = 0; Height: Integer = 0): PScreenBuffer; static;
  procedure Destroy;
  procedure Free;
  procedure Reinit(Width, Height: Integer);
  procedure FillAll(Color: TUint32 = 0);
  procedure Horizontal(Y, X1, X2: Integer; Color: TUint32 = 0);
  procedure SetPixel(X, Y: Integer; Color: TUint32); overload;
  procedure Blend(X, Y: Integer; Color: TUint32; Factor: Byte); overload;
  function GetPixel(X, Y: Integer): TUint32; overload;
  procedure SetPixel(X, Y: Integer; const Color: TVec4f); overload;
  procedure Circle(const P: TVec2i; R: Single; Color: TUint32);
  property Width: Integer read FWidth;
  property Height: Integer read FHeight;
  property Data: Pointer read FData;
  property Pixels[X, Y: Integer]: TUint32 read GetPixel write SetPixel; default;
end;

implementation

procedure TScreenBuffer.AllocData;
begin
  if W * H > 0 then begin
    FWidth := W;
    FHeight := H;
    GetMem(FData, FWidth * FHeight * SizeOf(TUint32));
  end;
end;

procedure TScreenBuffer.FreeData;
begin
  if FData <> nil then
    FreeMem(FData);
  FData := nil;
end;

constructor TScreenBuffer.Init;
begin
  FData := nil;
  AllocData(Width, Height);
end;

destructor TScreenBuffer.Done;
begin
  FreeData;
end;

function TScreenBuffer.Create(Width: Integer = 0; Height: Integer = 0): PScreenBuffer;
begin
  New(Result, Init(Width, Height));
end;

procedure TScreenBuffer.Destroy;
begin
  Done;
end;

procedure TScreenBuffer.Free;
begin
  if @Self <> nil then
    Dispose(PScreenBuffer(@Self), Done);
end;

procedure TScreenBuffer.Reinit(Width, Height: Integer);
begin
  FreeData;
  AllocData(Width, Height);
end;

procedure TScreenBuffer.FillAll(Color: TUint32);
var
  I: Integer;
begin
  for I := 0 to FWidth * FHeight - 1 do
    PArrayOfUint32(FData)^[I] := Color;
end;

procedure TScreenBuffer.Horizontal(Y, X1, X2: Integer; Color: TUint32 = 0);
var
  I: Integer;
begin
  Y := Y * FWidth; // just optimization
  for I := X1 to X2 do
    PArrayOfUint32(FData)^[Y + I] := Color;
end;

procedure TScreenBuffer.SetPixel(X, Y: Integer; Color: TUint32);
begin
  PArrayOfUint32(FData)^[Y * FWidth + X] := Color;
end;
  
procedure TScreenBuffer.Blend(X, Y: Integer; Color: TUint32; Factor: Byte);
begin
  SetPixel(X, Y, ColorBlend(Color, PArrayOfUint32(FData)^[Y * FWidth + X], Factor));
end;

function TScreenBuffer.GetPixel(X, Y: Integer): TUint32;
begin
  Result := PArrayOfUint32(FData)^[Y * FWidth + X];
end;

procedure TScreenBuffer.SetPixel(X, Y: Integer; const Color: TVec4f);
begin
  SetPixel(X, Y, RGBA(Color));
end;

function PixelPart(D: Float): Float; inline;
begin
  if D < 0 then
    D := 0;
  if D > 1 then
    D := 1;
  Result := arccos(D) - D * Sqrt(2 * D * (1 - D));
end;

function PixelFactor(D: Float): Byte; inline;
begin
  Result := Trunc(255 * PixelPart(D));
end;

procedure TScreenBuffer.Circle(const P: TVec2i; R: Single; Color: TUint32);
var
  X, I, J, Y, Radius, Prev, Delta: Integer;
  D, F: Float;
  Factor: Byte;
begin
  Prev := 1;
  Radius := Round(R);
  for J := Radius downto 0 do begin
    D := Sqrt(Sqr(R) - Sqr(J));
    F := Frac(D);
    Delta := Trunc(D - F);
    if Delta - Prev <= 1 then
      Prev := Delta - 1;
    // render main part of current line
    Y := P.Y - J;
    if (Y >= 0) and (Y < Height) then // FIXME more checks for X
      Horizontal(Y, Max(0, P.X - Prev), Min(Width, P.X + Prev), Color);
    Y := P.Y + J;
    if (Y >= 0) and (Y < Height) then // FIXME more checks for X
      Horizontal(Y, Max(0, P.X - Prev), Min(Width, P.X + Prev), Color);
    // render edge pixels
    if Delta - Prev > 1 then begin
      for I := Delta downto Prev + 1 do begin
        //Factor := PixelFactor(R - Sqrt(Sqr(I) + Sqr(J)));
        Factor := 255 - (255 * Sqr(I - Prev)) div Sqr(Delta - Prev);
        Blend(P.X - I, P.Y - J, Color, Factor); // FIXME more checks
        Blend(P.X + I, P.Y - J, Color, Factor);
        Blend(P.X + I, P.Y + J, Color, Factor);
        Blend(P.X - I, P.Y + J, Color, Factor);
      end;
    end else begin
      // simpler and better way
      Factor := Trunc(255 * F);
      Blend(P.X - Delta, P.Y - J, Color, Factor);
      Blend(P.X + Delta, P.Y - J, Color, Factor);
      Blend(P.X + Delta, P.Y + J, Color, Factor);
      Blend(P.X - Delta, P.Y + J, Color, Factor);
    end;
    Prev := Delta;
  end;
end;

end.
