unit graphics_2D_implementations;

{$MODE OBJFPC}
{$M+}

interface
uses fonts, graphics_2D, framebuffers, images, colors, type_fixes, rectangles;

type
  TPixel = TUINT32;
  T2DGraphics = class(TInterfacedObject, I2DGraphics, IInterface)
  private
    fFramebuffer : TFramebufferInfo;
    fPen : IPen;
    fPixelBitfield : TPixelBitfield;
  protected
    function GetPen : IPen;
    procedure SetPen(const aPen : IPen);
  public
    destructor Destroy; override;
  protected
    function DeviceColor(const aColor : IColor) : TPixel;
    procedure PokeWithPenAt(aX, aY : TCoordinate); inline;
  published
    constructor Create(const aFramebuffer : TFramebufferInfo);
    procedure DrawLine(aX1, aY1, aX2, aY2 : TCoordinate);
    procedure DrawRectangle(aX1, aY1, aX2, aY2 : TCoordinate);
    procedure DrawEllipse(aX1, aY1, aX2, aY2 : TCoordinate);
    procedure DrawArc(aX1, aY1, aX2, aY2 : TCoordinate; aBeginning : TAngle; aEnd : TAngle);
    procedure DrawCubicBezier(const aPoints : TPointArray);
    procedure ClearBox(aX1, aY1, aX2, aY2 : TCoordinate; const aColor : IColor);

    procedure BLIT(const aImage : IImage; aX1, aY1, aX2, aY2 : TCoordinate; aDestinationX1, aDestinationY1 : Integer; aMode : TBLITMode);
    function DrawGlyph(const aFont : IFont; aDesiredHeight : TCoordinate; aXLeft, aYBaseline : TCoordinate; aCode : TCardinal{Unicode}) : TRectangle; // FIXME RTL, up-down, context dependency.
    { TODO text, bezier curves (quadratic, cubic) (not B-Spline). }
    { TODO more obscure things like flood fill }
    property Pen : IPen read GetPen write SetPen;

    function GetBuiltinPen(aID : TBuiltInPenID; aWidth, aHeight : Cardinal) : IPen;
  end;

implementation

uses loggers, sysutils;

  function abs(a : TCoordinate) : TCoordinate; inline;
  begin
    if a >= 0 then
      Result := a
    else
      Result := -a;
  end;
  
  function sgn(a : TCoordinate) : TCoordinate; inline;
  begin
    if a > 0 then
      Result := 1
    else if a = 0 then
      Result := 0
    else
      Result := -1;
  end;
  
  function max(a, b : TCoordinate) : TCoordinate; inline;
  begin
    if a > b then
      Result := a
    else
      Result := b;
  end;

function T2DGraphics.GetPen : IPen;
begin
  Result := fPen;
end;

procedure T2DGraphics.SetPen(const aPen : IPen);
begin 
  fPen := aPen;
end;

destructor T2DGraphics.Destroy;
begin
  inherited Destroy;
end;

constructor T2DGraphics.Create(const aFramebuffer : TFramebufferInfo);
begin
  fFramebuffer := aFramebuffer;
  fPixelBitfield := aFramebuffer.PixelBitfield;
  // FIXME load default pen.
end;

procedure T2DGraphics.PokeWithPenAt(aX, aY : TCoordinate); inline;
var
  vPixel : TPixel;
  vRowStride : TCardinal; // in pixels.
  vPixelSize : 1..32;
  vStart : PByte;
begin
  // TODO Pen styling...
  
  vPixelSize := fFramebuffer.PixelSize;
  vPixel := DeviceColor(fPen.Color); // FIXME cache.
  vStart := fFramebuffer.Start;
  assert((vPixelSize mod 8) = 0);
  assert((fFramebuffer.RowStride mod (vPixelSize shr 3)) = 0);
  vRowStride := fFramebuffer.RowStride div vPixelSize;

  if (aX >= 0) and (aY >= 0) and (aX < fFramebuffer.Width) and (aY < fFramebuffer.Height) then begin
    vStart := (vStart + vRowStride * aY + (vPixelSize shr 3) * aX);
    
    vStart^ := vPixel and $FF; // FIXME use correct size depending on how big.
  end;  
end;

procedure SwapX1Y1_X2Y2(var aX1, aY1, aX2, aY2 : TCoordinate); inline;
var
  VXD, VYD : TCoordinate;
begin
      VXD := aX1;
      aX1 := aX2;
      aX2 := VXD;
      
      VYD := aY1;
      aY1 := aY2;
      aY2 := VYD;
end;

procedure T2DGraphics.DrawLine(aX1, aY1, aX2, aY2 : TCoordinate);
  

var
  VX, VY : TCoordinate;
  VXD, VYD : TCoordinate;
  VStep : TCoordinate;
begin
  // don't forget the cap style at the end.
  // don't forget the pen.
  // TODO optimize (get rid of the division).
  
  VXD := aX2 - aX1;
  VYD := aY2 - aY1;
  if (VXD = 0) and (VYD = 0) then
    Exit;
  
  if abs(VXD) > abs(VYD) then begin
    if aX1 > aX2 then begin
      SwapX1Y1_X2Y2(aX1, aY1, aX2, aY2);
    end;
    
    VStep := sgn(VXD);
    if VStep <= 0 then
      Exit;
    
    VX := aX1;
    while (VX < aX2) do begin
      VY := aY1 + (VX - aX1) * VYD div VXD;
      PokeWithPenAt(VX, VY);
      Inc(VX, VStep);
    end;
  end else begin
    VStep := sgn(VYD);
    if VStep <= 0 then 
      Exit;

    VX := aY1;      
    while (VY < aY2) do begin
      VX := aX1 + (VY - aY1) * VXD div VYD;
      PokeWithPenAt(VX, VY);
      Inc(VY, VStep);
    end;
  end;
end;

procedure T2DGraphics.DrawRectangle(aX1, aY1, aX2, aY2 : TCoordinate);
begin
  // don't forget the pen.
  DrawLine(aX1, aY1, aX2, aY1);
  DrawLine(aX1, aY1, aX1, aY2);
  DrawLine(aX2, aY1, aX2, aY2);
  DrawLine(aX1, aY2, aX2, aY2);
end;

procedure T2DGraphics.DrawEllipse(aX1, aY1, aX2, aY2 : TCoordinate);
var
  VRA, VRB : TCoordinate; // radius.
  VRB2 : TCoordinate; // squared.
  VRA2 : TCoordinate; // squared.
  VR : TCoordinate; // bigger radius.
  VA : Single; // angle.
  VXM, VYM : TCoordinate; // middle.
  VX, VY : TCoordinate;
begin
  // FIXME don't forget the pen.
  
  
  VRA := abs(aX2 - aX1) div 2;
  VRB := abs(aY2 - aY1) div 2;
  
  if (VRA = 0) or (VRB = 0) then
    Exit;
  VXM := (aX2 + aX1) div 2;
  VYM := (aY2 + aY1) div 2;

  VR := max(VRA, VRB);
  
  VRB2 := VRB * VRB;
  VRA2 := VRA * VRA;

  if VRB > VRA then begin
    if aY1 > aY2 then
      SwapX1Y1_X2Y2(aX1, aY1, aX2, aY2);

    VY := aY1;
    while (VY < aY2) do begin
      VX := VRA * Trunc(SQRT(VRB2 - VY * VY)) div VRB;
      Inc(VY);
    end;
  end else begin
    if aX1 > aX2 then 
      SwapX1Y1_X2Y2(aX1, aY1, aX2, aY2);
    
    VX := aX1;
    while (VX < aX2) do begin
      VY := VRB * Trunc(SQRT(VRA2 - VX * VX)) div VRA;
      Inc(VX);
    end;
  end;
end;

procedure T2DGraphics.DrawArc(aX1, aY1, aX2, aY2 : TCoordinate; aBeginning : TAngle; aEnd : TAngle);
begin
  // don't forget the pen.
end;

procedure T2DGraphics.DrawCubicBezier(const aPoints : TPointArray); // starting point, first control point, second control point, endpoint, first control point 2, second control point 2, endpoint 2, ...
var
  VPointIndex : Integer;
  VX1, VY1 : TCoordinate;
begin
  // don't forget the pen.
  if Length(aPoints) = 0 then
    Exit;
    
  VX1 := aPoints[0].X;
  VY1 := aPoints[0].Y;
  
  // FIXME actual bezier ;)
  // parameter form: B(t) = (1-t)³P0+3(1-t)²tP1+3(1-t)t²P2+t³P3, t in range[0,1]; B, P0, P1, P2, P3 in R³.
  // The curve starts at P0 going toward P1 and arrives at P3 coming from the direction of P2.
  // Usually, it will not pass through P1 or P2. The distance between P0 and P1 determines how long the curve moves into direction P2 before turning towards P3.
  
  for VPointIndex := Low(aPoints) to High(aPoints) do begin
    with aPoints[VPointIndex] do begin
      DrawLine(VX1, VY1, X, Y);
      VX1 := X;
      VY1 := Y;
    end;
  end;
end;

function Clip(aValue, aMinimum, aMaximum : TCoordinate) : TCoordinate; inline;
begin
  if aValue < aMinimum then
    Result := aMinimum
  else if aValue > aMaximum then
    Result := aMaximum
  else
    Result := aValue;
end;

function PointInRangeP(aValue, aMinimum, aMaximum : TCoordinate) : TBoolean; inline;
begin
  if aValue < aMinimum then
    Result := False
  else if aValue > aMaximum then
    Result := False
  else
    Result := True;
end;

procedure T2DGraphics.ClearBox(aX1, aY1, aX2, aY2 : TCoordinate; const aColor : IColor);
var
  vX : TCoordinate;
  vY : TCoordinate;
  vPixel : TPixel;
  
  vRowStride : TCardinal; // in pixels.
  vRestStride : TCardinal;
  vPixelSize : 1..32;

  vStart : PDWord; // FIXME use the correct pointer size depending on vPixelSize.

  vTemp : TCoordinate;
begin
  if (fFramebuffer.RowStride = 0) then
    Exit;
    
  vPixelSize := fFramebuffer.PixelSize;
  vPixel := DeviceColor(aColor);
  vStart := fFramebuffer.Start;
  assert((vPixelSize mod 8) = 0);
  assert((fFramebuffer.RowStride mod (vPixelSize shr 3)) = 0);
  vRowStride := fFramebuffer.RowStride div vPixelSize;
    
  aX1 := Clip(aX1, 0, fFramebuffer.Width);
  aX2 := Clip(aX2, 0, fFramebuffer.Width);
  aY1 := Clip(aY1, 0, fFramebuffer.Height);
  aY2 := Clip(aY2, 0, fFramebuffer.Height);
  
  if fFramebuffer.MatrixOrder = moRowColumn then begin 
    // Swap X, Y.
    
    vTemp := aX1;
    aX1 := aY1;
    aY1 := vTemp;

    vTemp := aX2;    
    aX2 := aY2;
    aY2 := vTemp;
  end;
  
  Inc(vStart, aX1);
  Inc(vStart, aY1 * vRowStride);
  vRestStride := vRowStride - (aX2 - aX1);
  for vY := aY1 to AY2 - 1 do begin
    for vX := aX1 to aX2 - 1 do begin
      vStart^ := vPixel;
      Inc(vStart);
    end;
    
    Inc(vStart, vRestStride);
  end;

//  fFramebuffer.Frontier
//    Size : Cardinal; { could be calculated, but just to be on the safe side. }
//    Width : Cardinal; { in pixels, 0 for dummy framebuffer. }
//    Height : Cardinal; { in pixels }
//    MatrixOrder : TMatrixOrder;
end;

procedure T2DGraphics.BLIT(const aImage : IImage; aX1, aY1, aX2, aY2 : TCoordinate; aDestinationX1, aDestinationY1 : TCoordinate; aMode : TBLITMode);
var
  vDestinationX1 : TCoordinate;
  vDestinationY1 : TCoordinate;
  vDestinationX2 : TCoordinate;
  vDestinationY2 : TCoordinate;

  vSourceFramebuffer : TFramebufferInfoP;
  vSourceStart : PDWord; // FIXME variable type. FIXME colorspace conversions?
  vSourceRowStride : TCardinal; // in copied units.
  vSourceRestStride : TCardinal;

  vDestinationStart : PDWord; // FIXME variable type. FIXME colorspace conversions?

  vDestinationRowStride : TCardinal; // in copied units.
  vDestinationRestStride : TCardinal;
  vDestinationPixelSize : 1..32;
  
  vX : TCoordinate;
  vY : TCoordinate;
begin
  if (fFramebuffer.RowStride = 0) then
    Exit;
    
  assert(fFramebuffer.MatrixOrder = moColumnRow);

  if not PointInRangeP(aX1, 0, aImage.Width) or
     not PointInRangeP(aX2, 0, aImage.Height) or
     not PointInRangeP(aY1, 0, aImage.Width) or
     not PointInRangeP(aY2, 0, aImage.Height) then 
       Exit;
       
  vDestinationPixelSize := fFramebuffer.PixelSize;
  
  vSourceFramebuffer := aImage.GetFramebuffer();
  if vSourceFramebuffer^.RowStride = 0 then // dummy framebuffer.
    Exit;
    
  if vDestinationPixelSize <> vSourceFramebuffer^.PixelSize then begin
    err('BLIT: pixel sizes differ.');
    Exit;
  end;
  
  // FIXME check for matching colorspaces and/or convert the pixel.
  
  assert((vSourceFramebuffer^.PixelSize and 7) = 0);
  assert((vSourceFramebuffer^.RowStride mod (vSourceFrameBuffer^.PixelSize shr 3)) = 0);
  vSourceRowStride := vSourceFramebuffer^.RowStride div (vSourceFrameBuffer^.PixelSize shr 3);

  vSourceStart := PDWord(vSourceFramebuffer^.Start);
  Inc(vSourceStart, aX1{source});
  Inc(vSourceStart, aY1{source} * vSourceRowStride);

  assert((fFramebuffer.PixelSize and 7) = 0);
  assert((fFramebuffer.RowStride mod (vDestinationPixelSize shr 3)) = 0);
  vDestinationRowStride := fFramebuffer.RowStride div (vDestinationPixelSize shr 3);
  
  vDestinationX1 := Clip(aDestinationX1, 0, fFramebuffer.Width);
  vDestinationY1 := Clip(aDestinationY1, 0, fFramebuffer.Height);
  
  vDestinationX2 := Clip(aDestinationX1 + aX2 - aX1, 0, fFramebuffer.Width);
  vDestinationY2 := Clip(aDestinationY1 + aY2 - aY1, 0, fFramebuffer.Height);
  
  // FIXME handle left-clipping of vDestination.
  
  vDestinationStart := PDWord(fFramebuffer.Start);

  Inc(vDestinationStart, vDestinationX1);
  Inc(vDestinationStart, vDestinationY1 * vDestinationRowStride);

  // left-clipping of vDestinationX1:
  if (vDestinationX1 = 0) and (aDestinationX1 < 0) then
    Inc(vSourceStart, (vDestinationX1 - aDestinationX1));
    
  // top-clipping of vDestinationY1:
  if (vDestinationY1 = 0) and (aDestinationY1 < 0) then
    Inc(vSourceStart, (vDestinationY1 - aDestinationY1) * vSourceRowStride);

  vDestinationRestStride := vDestinationRowStride - (vDestinationX2 - vDestinationX1);
  vSourceRestStride := vSourceRowStride - (vDestinationX2 - vDestinationX1); // uses *Destination* so that eventual clipping will be taken into account correctly.

  for vY := vDestinationY1 to vDestinationY2 - 1 do begin
    for vX := vDestinationX1 to vDestinationX2 - 1 do begin
      vDestinationStart^ := vSourceStart^;
      Inc(vDestinationStart);
      Inc(vSourceStart);
    end;
    
    Inc(vDestinationStart, vDestinationRestStride);
    Inc(vSourceStart, vSourceRestStride);
  end;

  {if fFramebuffer.MatrixOrder = moRowColumn then begin
    // Swap X, Y.
    
    vTemp := aX1;
    aX1 := aY1;
    aY1 := vTemp;

    vTemp := aX2;    
    aX2 := aY2;
    aY2 := vTemp;
    etcetc
  end;}

end;

function T2DGraphics.GetBuiltinPen(aID : TBuiltInPenID; aWidth, aHeight : Cardinal) : IPen;
begin
  // FIXME peBox, peCircular, peEmpty
  Result := nil;
end;

// TODO put the first part somewhere easily accessible by the client (without using the memory graphics object)
function T2DGraphics.DeviceColor(const aColor : IColor) : TPixel;
var
  vRed, vGreen, vBlue, vAlpha : TUINT16;
  vBitIndex : TByte;
  vIBitfield : TCardinal;
  vValue : TPixel;
  vGrayColor : IGrayColor;
  vBitColor : IBitColor;
  vRGBColor : IRGBColor;
  vRGBAColor : IRGBAColor;
begin
  Result := 0;
  vAlpha := $FFFF;

  vRGBColor := aColor as IRGBColor;
  if Assigned(vRGBColor) then begin
    with vRGBColor do begin
      vRed := Red;
      vGreen := Green;
      vBlue := Blue;
    end;
    vRGBAColor := aColor as IRGBAColor;
    if Assigned(vRGBAColor) then begin
      vAlpha := vRGBAColor.Alpha;
    end;
  end else begin
    vGrayColor := aColor as IGrayColor;
    if Assigned(vGrayColor) then begin
      vRed := vGrayColor.Gray;
      vGreen := vRed;
      vBlue := vRed;
    end else begin
      vBitColor := aColor as IBitColor;
      if Assigned(vBitColor) then begin
        vRed := vBitColor.Gray * $FFFF;
        vGreen := vRed;
        vBlue := vRed;
      end else begin
        err('unsupported color representation.');
      end;
    end;
  end;

  vBitIndex := 0;
  case fFramebuffer.PixelComponents of 
  csGray:
    for vIBitfield := Low(fPixelBitfield) to High(fPixelBitfield) do begin
      with fPixelBitfield[vIBitfield] do begin
        case Name of 
        bnValue: vValue := (vRed + vGreen + vBlue) div 3;
        else vValue := 0;
        end;
        if vValue <> 0 then
          Result := Result or (vValue shr (16 - Count)) shl vBitIndex;
          
        Inc(vBitIndex, Count);
      end;
    end;
  csRGB:
    for vIBitfield := Low(fPixelBitfield) to High(fPixelBitfield) do begin
      with fPixelBitfield[vIBitfield] do begin
        case Name of 
        bnRed: vValue := vRed;
        bnGreen: vValue := vGreen;
        bnBlue: vValue := vBlue;
        bnAlpha: vValue := vAlpha;
        else vValue := 0;
        end;
        if vValue <> 0 then
          Result := Result or (vValue shr (16 - Count)) shl vBitIndex;
          
        Inc(vBitIndex, Count);
      end;
    end;
  csIndexed{Palette}: 
    assert(false); // FIXME
  // TODO CYMK, YPbPr = (Y(R-Y)(B-Y))
  end;

// PaletteResolver : array of IColor; useless here...
//    PixelBitfield : TPixelBitfield; // if any.
end;

function T2DGraphics.DrawGlyph(const aFont : IFont; aDesiredHeight : TCoordinate; aXLeft, aYBaseline : TCoordinate; aCode : TCardinal{Unicode}) : TRectangle; // FIXME RTL, up-down, context dependency.
var
  VGlyph : TGlyphP;
  VBitmapIndex : Integer;
  VPoints : TPointArray;
  VPointIndex : Integer;
  VPointsReferenceHeight : TCoordinate;
  VX : TCoordinate;
  VY : TCoordinate;
  VBStartedRectangle : Boolean;
  VYTop : TCoordinate;
  VWidth : TCoordinate;
  VHeight : TCoordinate;
  
    function min(a, b : TCoordinate) : TCoordinate; inline;
    begin
      if a < b then
        Result := a
      else
        Result := b;
    end;

    function max(a, b : TCoordinate) : TCoordinate; inline;
    begin
      if a > b then
        Result := a
      else
        Result := b;
    end;
    
    procedure Transform(VPointIndex : Integer); inline;
    begin
      with VGlyph^.Points[VPointIndex] do begin
        VX := X;
        VY := Y;
      end;
    
      with VPoints[VPointIndex] do begin
        X := VX * aDesiredHeight div VPointsReferenceHeight + aXLeft;
        Y := VY * aDesiredHeight div VPointsReferenceHeight + aYBaseline;
      end;
    end;
begin
  VBStartedRectangle := False;
  VGlyph := aFont.GetGlyph(aCode);
  if not Assigned(VGlyph) then
    VGlyph := aFont.GetFallbackGlyph();

  if not Assigned(VGlyph) then begin
    err(Format('did not find a glyph for code U+%X.', [aCode]));
    Exit;
  end;

  with VGlyph^.Bitmaps do begin
    VBitmapIndex := GetBestFit(fFramebuffer.PixelComponents, aDesiredHeight, aDesiredHeight);
    if VBitmapIndex > -1 then begin
      // FIXME scale?

      VYTop := aYBaseline - VGlyph^.Boxes[VBitmapIndex].Ascent; // FIXME.
      VWidth := Items[VBitmapIndex].Width;
      VHeight := Items[VBitmapIndex].Height;
      
      if not VBStartedRectangle then begin
        VBStartedRectangle := True;
        Result.LeftTop.X := aXLeft;
        Result.LeftTop.Y := VYTop;
        Result.RightBottom.X := aXLeft + VWidth;
        Result.RightBottom.Y := VYTop + VHeight;
      end else begin
        Result.LeftTop.X := min(Result.LeftTop.X, aXLeft);
        Result.LeftTop.Y := min(Result.LeftTop.Y, VYTop);
        Result.RightBottom.X := max(Result.RightBottom.X, aXLeft + VWidth);
        Result.RightBottom.Y := max(Result.RightBottom.Y, VYTop + VHeight);
      end;
      
      // FIXME if Pen not pEmpty then
        BLIT(Items[VBitmapIndex], 0, 0, VWidth, VHeight, aXLeft, aYBaseline, blCopy);
      Exit;
    end;
  end;
  
  // here, we don't have a bitmap. Use points to draw a new one. TODO create cache bitmap.

  VPointsReferenceHeight := VGlyph^.PointsReferenceHeight;
  SetLength(VPoints, Length(VGlyph^.Points));
  
  if Length(VPoints) > 0 then begin
    Transform(0);
    with VPoints[0] do begin
      Result.LeftTop.X := X;
      Result.LeftTop.Y := Y;
      Result.RightBottom.X := X;
      Result.RightBottom.Y := Y;
    end;
    
    for VPointIndex := Low(VPoints) to High(VPoints) do begin
      Transform(VPointIndex);
      
      with VPoints[VPointIndex] do begin
        Result.LeftTop.X := min(Result.LeftTop.X, X);
        Result.LeftTop.Y := min(Result.LeftTop.Y, Y);
        Result.RightBottom.X := max(Result.RightBottom.X, X);
        Result.RightBottom.Y := max(Result.RightBottom.Y, Y);
      end;
    end;
  end;

  if Length(VPoints) > 0 then
        // FIXME if Pen not pEmpty then
    DrawCubicBezier(VPoints);
end;

end.