{$MODE OBJFPC}
{$MODESWITCH DUPLICATELOCALS}
{$MODESWITCH AUTODEREF}
{
  TODO TFont.Draw должна по умолчанию принимать на вход utf-8 строку
       TFont.DrawA принимает на вход ansi-строку и рендерит максимально
       256 символов
  TODO добавить возможность загружать гарнитуру из font.json
       шрифты могут быть default, bold, italic и т.д.
    (
      "name": "имя гарнитуры",
      "fonts": (
        "default": (
          "texture": "путь до файла с основной текстурой для шрифта",
          "letters": [
            (
              "code": число_с_кодом_в_юникоде,
              "count": здесь_можно_задать_количество_букв_в_интервале,
              "coords": [x1, y1, w, h],
              "texture": "можно переопределить глобальную текстуру здесь",
              "lang": ["можно здесь перечислить каким языкам принадлежит буква"]
            )
          ],
        )
      )
    )
  TODO сортированный массив интервалов для ускоренного (бинарного) поиска
}
unit DDrawFont;

interface

uses
  {$IFDEF DENG_USE_DRAW_OPENGL}{$IFDEF ANDROID}GLES,{$ELSE}GL, GLU,{$ENDIF}{$ENDIF}
  dtypes,
  dutf8,
  dtexture2d,
  dvector2f,
  dvector2i,
  dstream,
  dstreamfile,
  djson,
  dresman,
  DEng,
  DDraw,
  DDrawTex;

type
PFontParameters = ^TFontParameters;
TFontParameters = object
  Eng: TEngine;
  Data: TData;
  CP1251: Boolean;
  Key: AnsiString;
end;

TDrawFontManager = object(TManager)
public
  destructor Done; virtual;
end;

PFontHolder = ^TFontHolder;
TFontHolder = object(TResourceHolder)
public type
  PInterval = ^TInterval;
  TInterval = record
    Start, Count: LongInt;
    Tex: TDrawTex;
    Width: LongInt; // used for advancing cursor position after character
    Pos, Size: TVec2i; // position and size inside texture
    Offset: TVec2i; // offset to be added to cursor
    CharsPerLine: LongInt;
  end;
public
  Eng: TEngine;
  FIntervals: array of TInterval;
  FJson: TJson;
  FFontName: AnsiString;
  destructor Done; virtual;
  function FindInterval(Index: LongInt): PInterval;
  function AddInterval(Start, Count: LongInt): PInterval;
end;

PDrawGlyph = ^TDrawGlyph;
TDrawGlyph = record
  U: UInt32; // Unicode CodePoint
  Advance: TVec2i;
  TexHandle: UInt32; // Handle to atlas with the glyph
  TexCoords: array[0 .. 3] of TVec2f;
  RefCounts: PtrInt;
  FreeType: record // freetype specific data
    GlyphIndex: UInt32;
  end;
end;

PFont = ^TFont;
TFont = object(specialize TResourceBase<TFontParameters, TFontHolder>)
private
  FHolder: PHolder;
public
  //constructor Init(Eng: TEngine);
  //constructor Init(Man: PManager; Eng: TEngine; Data: TData);
  constructor InitCP1251(Man: PManager; Eng: TEngine; Data: TData);
  constructor InitFromJson(Man: PManager; Eng: TEngine; Data: TData);
  destructor Done; virtual;
  procedure LinkToHolder(_Holder: TFont.PHolder); virtual;
  function CharToIndex(const C: Cardinal): LongInt; virtual;
  function CharSize(C: Cardinal): TVec2i; virtual;
  function CharWidth(const C: Cardinal): LongInt; virtual;
  function CharHeight(const C: Cardinal): LongInt; virtual;
  function Size(const Line: AnsiString): TVec2i; virtual;
  function Width(const Line: AnsiString): LongInt; virtual;
  function Height(const Line: AnsiString): LongInt; virtual;
  // returns size of rendered char, Index is unicode index
  function DrawChar(const P: TVec2i; Index: LongInt): TVec2i; overload;
  // draw utf-8 string
  procedure Draw(const P: TVec2i; S, SEnd: PAnsiChar); overload;
  procedure Draw(const P: TVec2i; const Line: AnsiString); overload;
  procedure DrawP(var P: TVec2i; S, SEnd: PAnsiChar); overload;
  procedure DrawP(var P: TVec2i; const Line: AnsiString); overload;
end;

PDrawText = ^TDrawText;
TDrawText = object
private
  FFont: PFont;
  FPos: TVec2i;
public
  procedure Init(Font: PFont; const P: TVec2i);
  procedure Done;
  function Pos(const P: TVec2i): PDrawText;
  function Draw(const Line: AnsiString): PDrawText;
end;

var
  FontMan: TDrawFontManager;

implementation

function GetActualManager(Man: PManager): PManager;
begin
  Result := Man;
  if Result = nil then
    Result := @FontMan;
end;

destructor TDrawFontManager.Done;
var
  It: dresman.TManager.TIterator;
begin
  It.Init(@FHashMap);
  while It.Next do begin
    Dispose(PFontHolder(It.Value^), Done);
  end;
  It.Done;
  inherited Done;
end;

function LoadFontCP1251FromData(Man: PManager; Parameters: TFont.PParameters): TFont.PHolder;
var
  Interval: TFontHolder.PInterval;
  Tex: TDrawTex;
begin
  LogTagged('R', 'LOADING ' + Parameters.Key);
  New(Result, Init);
  Tex.Init(PDrawTexManager(nil), Parameters.Eng, Parameters.Data.Stream);
  Tex.Force;
  Interval := Result^.AddInterval(0, 127);
  Interval^.Tex := Tex;
  Interval^.CharsPerLine := 16;
  Interval^.Width := 16;
  Interval^.Pos := Vec2i(0, 0);
  Interval^.Size.X := Interval^.Tex.Width div 16;
  Interval^.Size.Y := Interval^.Tex.Height div 16;
  Interval := Result^.AddInterval($0410, 32); // А-Я
  Interval^.Tex := Tex;
  Interval^.CharsPerLine := 16;
  Interval^.Width := 16;
  Interval^.Pos := Vec2i(0, Interval^.Tex.Height * 12 div 16);
  Interval^.Size.X := Interval^.Tex.Width div 16;
  Interval^.Size.Y := Interval^.Tex.Height div 16;
  Interval := Result^.AddInterval($0430, 32); // а-я
  Interval^.Tex := Tex;
  Interval^.CharsPerLine := 16;
  Interval^.Width := 16;
  Interval^.Pos := Vec2i(0, Interval^.Tex.Height * 14 div 16);
  Interval^.Size.X := Interval^.Tex.Width div 16;
  Interval^.Size.Y := Interval^.Tex.Height div 16;
  Interval := Result^.AddInterval($0401, 1); // Ё
  Interval^.Tex := Tex;
  Interval^.CharsPerLine := 16;
  Interval^.Width := 16;
  Interval^.Pos := Vec2i(Interval^.Tex.Width * 8 div 16, Interval^.Tex.Height * 10 div 16);
  Interval^.Size.X := Interval^.Tex.Width div 16;
  Interval^.Size.Y := Interval^.Tex.Height div 16;
  Interval := Result^.AddInterval($0451, 1); // ё
  Interval^.Tex := Tex;
  Interval^.CharsPerLine := 16;
  Interval^.Width := 16;
  Interval^.Pos := Vec2i(Interval^.Tex.Width * 8 div 16, Interval^.Tex.Height * 11 div 16);
  Interval^.Size.X := Interval^.Tex.Width div 16;
  Interval^.Size.Y := Interval^.Tex.Height div 16;
  Interval := Result^.AddInterval($2014, 1); // —
  Interval^.Tex := Tex;
  Interval^.CharsPerLine := 16;
  Interval^.Width := 16;
  Interval^.Pos := Vec2i(Interval^.Tex.Width * 7 div 16, Interval^.Tex.Height * 9 div 16);
  Interval^.Size.X := Interval^.Tex.Width div 16;
  Interval^.Size.Y := Interval^.Tex.Height div 16;
end;

function LoadFontJsonFromData(Man: PManager; Parameters: TFont.PParameters): TFont.PHolder;
var
  Interval: TFontHolder.PInterval;
  Json: PJson;
  Fonts, Letters: PJsonArray;
  Font, Letter: PJson;
  Rect, Offset: PJsonArray;
  LetterItem: PJsonItem;
  I: LongInt;
  Texture: AnsiString;
  Tex: TDrawTex;
begin
  New(Result, Init);
  if ParseJson(Parameters.Data.Stream, Result^.FJson) then begin
    Json := @Result^.FJson;
    Result^.FFontName := Json.Get('name', 'default');
    if Json.Find('fonts', Fonts) and (Fonts.Length > 0) then begin
      // TODO name
      Font := Fonts.Get(0, EmptyJson);
      Texture := Font.Get('texture', '');
      Tex.Init(nil, Parameters.Eng, Texture);
      Tex.Force;
      for LetterItem in Font.Get('letters', EmptyJsonArray)^ do begin
        Letter := LetterItem.Get(EmptyJson);
        Interval := Result^.AddInterval(Letter.Get('code', 0),
                                        Letter.Get('count', 1));
        Interval^.Tex.Init(Tex);
        Interval^.CharsPerLine := Letter.Get('chars_per_line', 256);
        Interval^.Width := Letter.Get('width', 0);
        Rect := Letter.Get('rect', EmptyJsonArray);
        Interval^.Pos := Vec2i(Rect.Get(0, 0), Rect.Get(1, 0));
        Interval^.Size := Vec2i(Rect.Get(2, 0), Rect.Get(3, 0));
        Offset := Letter.Get('offset', EmptyJsonArray);
        Interval^.Offset := Vec2i(Offset.Get(0, 0), Offset.Get(1, 0));
        // TODO lang
      end;
      Tex.Done;
    end;
    Result^.FJson.Done;
  end;
end;

destructor TFontHolder.Done;
var
  I: LongInt;
begin
  I := 0;
  for I := 0 to High(FIntervals) do
    FIntervals[I].Tex.Done;
  SetLength(FIntervals, 0);
  FFontName := '';
  inherited Done;
end;

function TFontHolder.FindInterval(Index: LongInt): PInterval;
var
  L, R, M: LongInt;
begin
  // TODO use binary search here
  //for I := 0 to High(FIntervals) do
  //  if (FIntervals[I].Start <= Index) and (Index < FIntervals[I].Start + FIntervals[I].Count) then
  //    Exit(@FIntervals[I]);
  //Exit(nil);

  L := 0;
  R := Length(FIntervals);
  while L < R do begin
    M := (L + R) div 2;
    if Index < FIntervals[M].Start then begin
      R := M;
    end else if Index >= FIntervals[M].Start + FIntervals[M].Count then begin
      L := M + 1;
    end else
      Exit(@FIntervals[M]);
  end;
  if (FIntervals[L].Start <= Index) and (Index < FIntervals[L].Start + FIntervals[L].Count) then begin
    Exit(@FIntervals[L]);
  end else
    Exit(nil);
end;

function TFontHolder.AddInterval(Start, Count: LongInt): PInterval;
var
  I, J: LongInt;
begin
  SetLength(FIntervals, Length(FIntervals) + 1);
  I := High(FIntervals);
  while (I > 0) and ((FIntervals[I - 1].Start + FIntervals[I - 1].Count) > Start) do begin
    Dec(I);
  end;
  for J := High(FIntervals) downto I + 1 do begin
    FIntervals[J] := FIntervals[J - 1];
  end;
  FIntervals[I].Start := Start;
  FIntervals[I].Count := Count;
  Result := @FIntervals[I];
end;

//constructor TFont.Init(Eng: TEngine);
//begin
//end;

//constructor TFont.Init(Man: PManager; Eng: TEngine; Data: TData);
//begin
//end;

constructor TFont.InitCP1251(Man: PManager; Eng: TEngine; Data: TData);
var
  Parameters: TFontParameters;
begin
  Parameters.Eng := Eng;
  Parameters.Key := 'TFont CP1251 Eng=... Data=' + Data.Stream.Name;
  Parameters.CP1251 := True;
  Parameters.Data := Data;
  InitBase(GetActualManager(Man), @Parameters, @LoadFontCP1251FromData);
  Data.Done;
end;

constructor TFont.InitFromJson(Man: PManager; Eng: TEngine; Data: TData);
var
  Parameters: TFontParameters;
begin
  Parameters.Eng := Eng;
  Parameters.Key := 'TFont Json Data=' + Data.Stream^.Name;
  Parameters.CP1251 := False;
  Parameters.Data := Data;
  InitBase(GetActualManager(Man), @Parameters, @LoadFontJsonFromData);
  Data.Done;
end;

destructor TFont.Done;
//var
//  I: LongInt;
begin
// TODO do it inside holder
//  for I := 0 to High(FIntervals) do
//    FIntervals[I].Tex.Done;
end;

procedure TFont.LinkToHolder(_Holder: TFont.PHolder);
begin
  FHolder := _Holder;
end;

function TFont.CharToIndex(const C: Cardinal): LongInt;
begin
  Result := C mod 256;
end;

function TFont.CharSize(C: Cardinal): TVec2i;
var
  Interval: TFontHolder.PInterval;
begin
  Interval := FHolder^.FindInterval(C);
  if Interval <> nil then begin
    with Interval^ do begin
      Result := Vec2i(Width, Offset.Y + Size.Y);
    end;
  end else
    Result := Vec2i(0, 0);
end;

function TFont.CharWidth(const C: Cardinal): LongInt;
var
  Interval: TFontHolder.PInterval;
begin
  {Interval := FHolder^.FindInterval(C);
  if Interval <> nil then begin
    with Interval^ do begin
      Result := Size.X;
    end;
  end else
    Result := 0;}
  Result := CharSize(C).X;
end;

function TFont.CharHeight(const C: Cardinal): LongInt;
var
  Interval: TFontHolder.PInterval;
begin
  {Interval := FHolder^.FindInterval(C);
  if Interval <> nil then begin
    with Interval^ do begin
      Result := Size.Y;
    end;
  end else
    Result := 0;}
  Result := CharSize(C).Y;
end;

function TFont.Size(const Line: AnsiString): TVec2i;
var
  I: LongInt;
  S: TVec2i;
  Buf, EndOfBuf: PAnsiChar;
  Index: Cardinal;
begin
  Buf := @Line[1];
  EndOfBuf := Buf + Length(Line);
  Result := Vec2i(0, 0);
  while DecodeUTF8CharReplace(Buf, EndOfBuf, Index, Ord('?')) do begin
    S := CharSize(Index);
    Result.X := Result.X + S.X;
    if S.Y > Result.Y then
      Result.Y := S.Y;
  end;
end;

function TFont.Width(const Line: AnsiString): LongInt;
var
  I, Index: LongInt;
  S: TVec2i;
  Buf, EndOfBuf: Pointer;
begin
  {// TODO fix duplocating with Draw
  Result := 0;
  Buf := @Line[1];
  EndOfBuf := Buf + Length(Line);
  while Buf < EndOfBuf do begin
    Index := Ord(ReadUTF8CodePoint(Buf));
    Result := Result + CharWidth(Index);
  end;}
  Result := Size(Line).X;
end;

function TFont.Height(const Line: AnsiString): LongInt;
var
  I, Index: LongInt;
  S: TVec2i;
  Buf, EndOfBuf: Pointer;
  H: LongInt;
begin
  {// TODO fix duplocating with Draw
  Result := 0;
  Buf := @Line[1];
  EndOfBuf := Buf + Length(Line);
  while Buf < EndOfBuf do begin
    Index := Ord(ReadUTF8CodePoint(Buf));
    H := CharHeight(Index);
    if H > Result then
      Result := H;
  end;}
  Result := Size(Line).Y;
end;

function TFont.DrawChar(const P: TVec2i; Index: LongInt): TVec2i;
var
  Interval: TFontHolder.PInterval;
  T: TVec2i;
begin
  Interval := FHolder^.FindInterval(Index);
  if Interval <> nil then begin
    with Interval^ do begin
      T.X := Pos.X + ((Index - Start) mod CharsPerLine) * Size.X;
      T.Y := Pos.Y + ((Index - Start) div CharsPerLine) * Size.Y;
      //Tex.Draw(FHolder.Eng, Vec2f(P), Vec2f(Size.X, Size.Y), T, Size);
      Tex.DrawLT(FHolder.Eng, Vec2f(P + Offset), Vec2f(Size.X, Size.Y), T, Size);
      Result := Vec2i(Width, 0);
    end;
  end else
    Result := Vec2i(0, 0);
end;

procedure TFont.Draw(const P: TVec2i; S, SEnd: PAnsiChar);
var
  T: TVec2i;
begin
  T := P;
  DrawP(T, S, SEnd);
end;

procedure TFont.Draw(const P: TVec2i; const Line: AnsiString);
var
  T: TVec2i;
begin
  T := P;
  DrawP(T, Line);
end;

procedure TFont.DrawP(var P: TVec2i; S, SEnd: PAnsiChar);
var
  Index: Cardinal;
begin
  while DecodeUTF8CharReplace(S, SEnd, Index, Ord('?')) do
    P.X := P.X + DrawChar(P, Index).X;
end;

procedure TFont.DrawP(var P: TVec2i; const Line: AnsiString);
begin
  DrawP(P, @Line[1], @Line[1] + Length(Line));
end;

procedure TDrawText.Init(Font: PFont; const P: TVec2i);
begin
  FFont := Font;
  FPos := P;
end;

procedure TDrawText.Done;
begin
end;

function TDrawText.Pos(const P: TVec2i): PDrawText;
begin
  FPos := P;
  Result := @Self;
end;

function TDrawText.Draw(const Line: AnsiString): PDrawText;
begin
  Result := @Self;
end;

initialization
  FontMan.Init;
finalization
  FontMan.Done;
end.
