unit dplugin_freetype;

{$MODE FPC}
{$MODESWITCH DEFAULTPARAMETERS}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}

interface

uses
  DEng, dstrnum, // DEBUG
  derror,
  dfont_plugin,
  dstream,
  freetype;

type
PFreeTypeBackend = ^TFreeTypeBackend;
TFreeTypeBackend = object(TFontBackend)
private
  Name: AnsiString; // TODO remove
  Face: freetype.FT_Face;
public
  constructor Init;
  destructor Done; virtual;

  function IsAtlas: Boolean; virtual;
  function IsRasterizable: Boolean; virtual;
  function IsScalable: Boolean; virtual;
      // A font may be scalable or fixed sized.

  function GetKerning(U1, U2: UInt32): UInt32; virtual;

  function HasSize(Size: SizeUInt): Boolean; virtual;
  function GetAvailableSizeGreater(Size: SizeUInt): SizeUInt; virtual;
  function GetAvailableSizeLess(Size: SizeUInt): SizeUInt; virtual;

  function SetGlyph(U: UInt32): Boolean; virtual;
  procedure SetSize(Size: SizeUInt); virtual;
  procedure SetOutline(Size: SizeUInt); virtual;
  procedure SetTransform(XX, XY, YX, YY: Single); virtual;
  procedure GetGlyphSizes(out W, H: SizeInt); virtual;
  procedure GetGlyphAdvance(out W, H: SizeInt); virtual;

  procedure RasterizeRGBA(
        U: UInt32;
        X, Y: PtrInt;
        W, H: PtrInt;
        RGBA: Pointer); virtual;
  function GenerateTriangles2f(
        U: UInt32;
        Vertices: Pointer;
        Stride: PtrInt;
        VerticesLimit: PtrInt): SizeUInt; virtual;
end;

TFreeTypePlugin = object(TFontPlugin)
private
  Lib: FT_Library;
  FError: FT_Error;
  FErrorMsg: PAnsiChar;
public
  constructor Init;
  destructor Done; virtual;
  function TryLoad(Stream: PStream;
                   out FontBackend: PFontBackend;
                   out Error: TError): Boolean; virtual;
      // Returns True  and FontBackend on success
      // Returns False and Error on fail
end;

implementation

constructor TFreeTypeBackend.Init;
begin
  inherited;
end;

destructor TFreeTypeBackend.Done;
begin
  FT_Done_Face(Face);
  inherited;
end;

function TFreeTypeBackend.IsAtlas: Boolean;
begin
  Exit(False);
end;

function TFreeTypeBackend.IsRasterizable: Boolean;
begin
  Exit(True);
end;

function TFreeTypeBackend.IsScalable: Boolean;
begin
  Exit(FT_IS_SCALABLE(Face));
end;

function TFreeTypeBackend.GetKerning(U1, U2: UInt32): UInt32;
begin
  // TODO
  Exit(0);
end;

function TFreeTypeBackend.HasSize(Size: SizeUInt): Boolean;
var
  I: Int32;
begin
  if FT_IS_SCALABLE(Face) then
    Exit(True);
  for I := 0 to Face^.num_fixed_sizes - 1 do begin
    // or size? or height? or width? or y_ppem
    if Face^.available_sizes[I].x_ppem = Size then
      Exit(True);
  end;
  Exit(False);
end;

function TFreeTypeBackend.GetAvailableSizeGreater(Size: SizeUInt): SizeUInt;
var
  I: Int32;
  S, A, B: SizeUInt;
begin
  if FT_IS_SCALABLE(Face) then
    Exit(Size);
  A := 0;
  B := High(SizeUInt);
  for I := 0 to Face^.num_fixed_sizes - 1 do begin
    S := Face^.available_sizes[I].x_ppem;
    if (A < S) and (S <= Size) then
      A := S;
    if (Size <= S) and (S < B) then
      B := S;
  end;
  Exit(B);
end;

function TFreeTypeBackend.GetAvailableSizeLess(Size: SizeUInt): SizeUInt;
var
  I: Int32;
  S, A, B: SizeUInt;
begin
  if FT_IS_SCALABLE(Face) then
    Exit(Size);
  A := 0;
  B := High(SizeUInt);
  for I := 0 to Face^.num_fixed_sizes - 1 do begin
    S := Face^.available_sizes[I].x_ppem;
    if (A < S) and (S <= Size) then
      A := S;
    if (Size <= S) and (S < B) then
      B := S;
  end;
  Exit(A);
end;

procedure DumpFont(Font: FT_Face);
begin
  // Log(IntToStr(Font^.num_faces));
  // Log(IntToStr(Font^.face_index));
  // Log(IntToStr(Font^.face_flags));
  // Log(IntToStr(Font^.style_flags));
  // Log(IntToStr(Font^.num_glyphs));
  // Log(Font^.family_name);
  // Log(Font^.style_name);
  // Log(IntToStr(Font^.num_fixed_sizes));
  // Log(IntToStr(Font^.num_charmaps));
  // Log(IntToStr(Font^.units_per_EM));
  // Log(IntToStr(Font^.ascender));
  // Log(IntToStr(Font^.descender));
  // Log(IntToStr(Font^.height));
  // Log(IntToStr(Font^.max_advance_width));
  // Log(IntToStr(Font^.max_advance_height));
  // Log(IntToStr(Font^.underline_position));
  // Log(IntToStr(Font^.underline_thickness));
end;

function TFreeTypeBackend.SetGlyph(U: UInt32): Boolean;
begin
  // Log(HexStr(Face) + ' ' + IntToStr(U)); // DEBUG
  DumpFont(Face);
  Exit(FT_Load_Char(Face, U, FT_LOAD_RENDER) <> 0);
end;

procedure TFreeTypeBackend.SetSize(Size: SizeUInt);
begin
  // FT_Set_Char_Size(Face, 0, Size * 64, 300, 300);
  {Error :=} FT_Set_Pixel_Sizes(Face, 0, Size);
end;

procedure TFreeTypeBackend.SetOutline(Size: SizeUInt);
begin
  // TODO
end;

procedure TFreeTypeBackend.SetTransform(XX, XY, YX, YY: Single);
begin
  // TODO
end;

procedure TFreeTypeBackend.GetGlyphSizes(out W, H: SizeInt);
begin
  W := Face^.glyph^.metrics.width div 64;
  H := Face^.glyph^.metrics.height div 64;
end;

procedure TFreeTypeBackend.GetGlyphAdvance(out W, H: SizeInt);
begin
  W := Face^.glyph^.metrics.horiAdvance div 64;
  H := 0; // Face^.glyph^.metrics.vertAdvance;
end;

procedure TFreeTypeBackend.RasterizeRGBA(
      U: UInt32;
      X, Y: PtrInt;
      W, H: PtrInt;
      RGBA: Pointer);
var
  Error: FT_Error;
  Bitmap: FT_PBitmap;
  Width, Height: SizeUInt;
  I, J: Int32;
  V: Byte;
begin
  // Error := FT_Load_Char(Face, U, FT_LOAD_RENDER);
  Bitmap := @Face^.Glyph^.bitmap;
  for I := X to X + Bitmap^.width - 1 do begin
    if I >= W then
      break;
    for J := Y to Y + Bitmap^.rows - 1 do begin
      if Y + J >= H then
        break;
      V := Bitmap^.buffer[(J - Y) * Bitmap^.Width + (I - X)];
      PByte(RGBA)[4 * (J * W + I) + 0] := 255;
      PByte(RGBA)[4 * (J * W + I) + 1] := 255;
      PByte(RGBA)[4 * (J * W + I) + 2] := 255;
      PByte(RGBA)[4 * (J * W + I) + 3] := V;
    end;
  end;
end;

function TFreeTypeBackend.GenerateTriangles2f(
      U: UInt32;
      Vertices: Pointer;
      Stride: PtrInt;
      VerticesLimit: PtrInt): SizeUInt;
begin
  Exit(0);
end;

constructor TFreeTypePlugin.Init;
begin
  FError := FT_Init_FreeType(@Lib);
  if FError <> 0 then
    FErrorMsg := 'no lib';
end;

destructor TFreeTypePlugin.Done;
begin
  FError := FT_Done_FreeType(Lib);
end;

function TFreeTypePlugin.TryLoad(Stream: PStream;
                 out FontBackend: PFontBackend;
                 out Error: TError): Boolean;
var
  Memory: Pointer;
  Size: SizeUInt;
  F: PFreeTypeBackend;
begin
  if FError <> 0 then begin
    Error.Id := FError;
    Error.Msg := FErrorMsg;
    Exit(False);
  end;
  if not Stream^.ReadToMemory(Memory, Size) then begin
    Error.Id := 1;
    Error.Msg := 'could not read';
    Exit(False);
  end;
  F := New(PFreeTypeBackend, Init);
  Error.Id := FT_New_Memory_Face(Lib, Memory, Size, 0, @F^.Face);
  if Error.Id <> 0 then begin
    Error.Msg := 'ft could not read';
    FreeMem(Memory);
    Dispose(F, Done);
    Exit(False);
  end;
  FontBackend := F;
  F^.Name := Stream^.Name;
  if FT_Select_Charmap(F^.Face, FT_ENCODING_UNICODE) <> 0 then begin
    // TODO return warning somehow...
    Log('WARNING: could not choose unicode for a font');
  end;
  Log(HexStr(F^.Face));
  FT_Set_Pixel_Sizes(F^.Face, 0, 32);
  FT_Load_Char(F^.Face, 72, FT_LOAD_RENDER);
  DumpFont(F^.Face);
  // FreeMem(Memory);
  Exit(True);
end;

var
  FreeTypePlugin: TFreeTypePlugin;
initialization
  FreeTypePlugin.Init;
  RegisterFontPlugin(@FreeTypePlugin);
finalization
  FreeTypePlugin.Done;
end.
