libTextSuite/libTextSuite.lpr

library libTextSuite;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils,
  utsTextSuite, utsTypes, utsRendererOpenGL, utsRendererOpenGLES,
  uutlGenerics;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//external types and contstants/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
type
  {$Z4}
  TltsErrorCode = (
    ltsErrUnknown               =   -1,
    ltsErrNone                  =    0,

    // misc
    ltsErrNotInitialized        =    1,
    ltsErrInvalidEnum           =    2,
    ltsErrInvalidValue          =    3,
    ltsErrInvalidOperation      =    4,

    // invalid handles
    ltsErrInvalidContextHandle  =  100,
    ltsErrInvalidRendererHandle =  101
  );

  {$Z4}
  TltsRendererType = (
    ltsRendererOpenGL,
    ltsRendererOpenGLES,
    ltsRendererCustom
  );

  TltsContextHandle = Pointer;
  TltsRendererHandle = Pointer;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//internal types and contstants/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TltsContext = class(TtsContext)
  public
    destructor Destroy; override;
  end;
  TtsContextHashSet = specialize TutlHashSet<TtsContext>;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TltsRendererOpenGL = class(TtsRendererOpenGL)
  public
    // TODO destructor Destroy; override;
  end;

  TltsRendererOpenGLES = class(TtsRendererOpenGLES)
  public
    // TODO destructor Destroy; override;
  end;

  { TODO
  TltsRendererCustom = class(TtsRenderer)
  protected
    function  CreateRenderRef(const aChar: TtsChar; const aCharImage: TtsImage): TtsCharRenderRef; override;
    procedure FreeRenderRef(const aCharRef: TtsCharRenderRef); override;

    procedure BeginRender; override;
    procedure EndRender; override;

    procedure SetDrawPos(const X, Y: Integer); override;
    function  GetDrawPos: TtsPosition; override;
    procedure MoveDrawPos(const X, Y: Integer); override;
    procedure SetColor(const aColor: TtsColor4f); override;
    procedure Render(const aCharRef: TtsCharRenderRef; const aForcedWidth: Integer = 0); override;
  public
    // TODO  destructor Destroy; override;
  end;
  }

  TtsRendererHashSet = specialize TutlHashSet<TtsRenderer>;

var
  IsInitilized: Boolean = false;
  Contexts: TtsContextHashSet = nil;
  Renderers: TtsRendererHashSet = nil;
  LastErrorCode: TltsErrorCode = ltsErrNone;
  LastErrorMsg: String;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//helper methods////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure SetLastError(const aEx: Exception);
begin
  LastErrorCode := ltsErrUnknown;
  LastErrorMsg  := aEx.Message;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure SetLastError(const aErrorCode: TltsErrorCode; const aErrorMsg: String);
begin
  LastErrorCode := aErrorCode;
  LastErrorMsg  := aErrorMsg;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckIfInitialized: Boolean;
begin
  result := IsInitilized;
  if not result then
    SetLastError(ltsErrNotInitialized, 'libTextSuite has not been initialized. call ltsInitialize before using any other methods.');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckContextHandle(const aHandle: TltsContextHandle; out aContext: TtsContext): Boolean;
begin
  result := CheckIfInitialized;
  if result then begin
    aContext := TltsContext(aHandle);
    result := Contexts.Contains(aContext);
    if not result then
      SetLastError(ltsErrInvalidContextHandle, Format('0x%.16x is not a valid context handle', [{%H-}PtrUInt(aHandle)]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckRendererHandle(const aHandle: TltsContextHandle; out aRenderer: TtsRenderer): Boolean;
begin
  result := CheckIfInitialized;
  if result then begin
    aRenderer := TtsRenderer(aHandle);
    result := Renderers.Contains(aRenderer);
    if not result then
      SetLastError(ltsErrInvalidRendererHandle, Format('0x%.16x is not a valid renderer handle', [{%H-}PtrUInt(aHandle)]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ValidateCodePage(const aValue: TtsCodePage): Boolean;
begin
  result := (aValue >= Low(TtsCodePage)) and (aValue <= High(TtsCodePage));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ValidateFormat(const aValue: TtsFormat): Boolean;
begin
  result := (aValue >= Low(TtsFormat)) and (aValue <= High(TtsFormat));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Context///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextCreate: TltsContextHandle; stdcall;
var
  c: TltsContext;
begin
  try
    result := nil;
    if not CheckIfInitialized then
      exit;
    c := TltsContext.Create;
    Contexts.Add(c);
    result := c;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextGetCodePage(const aHandle: TltsContextHandle; var aCodePage: TtsCodePage): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then aCodePage := c.CodePage
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextGetDefaultChar(const aHandle: TltsContextHandle; var aValue: WideChar): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then aValue := c.CodePageDefault
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextSetCodePage(const aHandle: TltsContextHandle; const aCodePage: TtsCodePage): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c) then begin
      if not ValidateCodePage(aCodePage) then begin
        SetLastError(ltsErrInvalidEnum, Format('%d is not a valid enum value for CodePage', [aCodePage]));
        result := LastErrorCode;
      end else
        c.CodePage := aCodePage;
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextSetDefaultChar(const aHandle: TltsContextHandle; const aValue: WideChar): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then c.CodePageDefault := aValue
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsContextDestroy(const aHandle: TltsContextHandle): TltsErrorCode; stdcall;
var
  c: TtsContext;
begin
  try
    result := ltsErrNone;
    if CheckContextHandle(aHandle, c)
      then Contexts.Remove(c)
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Renderer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsRendererCreate(const aHandle: TltsContextHandle; const aType: TltsRendererType; const aFormat: TtsFormat): TltsRendererHandle; stdcall;
var
  c: TtsContext;
  r: TtsRenderer;
begin
  try
    result := nil;
    if not CheckContextHandle(aHandle, c) then
      exit;

    if not ValidateFormat(aFormat) then begin
      SetLastError(ltsErrInvalidEnum, Format('%d is not a valid format', [aFormat]));
      exit;
    end;

    case aType of
      ltsRendererOpenGL:    r := TltsRendererOpenGL.Create(c, aFormat);
      ltsRendererOpenGLES:  r := TltsRendererOpenGLES.Create(c, aFormat);
      // TODO ltsRendererCustom:    r := TltsRendererCustom.Create(c, aFormat);
    else
      SetLastError(ltsErrInvalidEnum, Format('%d is not a valid renderer type', [aType]));
      exit;
    end;
    Renderers.Add(r);
    result := r;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsRendererDestroy(const aHandle: TltsRendererHandle): TltsErrorCode; stdcall;
var
  r: TtsRenderer;
begin
  try
    result := ltsErrNone;
    if CheckRendererHandle(aHandle, r)
      then Renderers.Remove(r)
      else result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Global////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsInitialize: TltsErrorCode; stdcall;
begin
  try
    Contexts := TtsContextHashSet.Create(true);
    Renderers := TtsRendererHashSet.Create(true);
    IsInitilized := true;
    result := ltsErrNone;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsGetLastErrorCode: TltsErrorCode; stdcall;
begin
  result := LastErrorCode;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsGetLastErrorMsg: PAnsiChar; stdcall;
begin
  result := PAnsiChar(LastErrorMsg);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsFinalize: TltsErrorCode; stdcall;
begin
  try
    IsInitilized := false;
    FreeAndNil(Renderers);
    FreeAndNil(Contexts);
    result := ltsErrNone;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
exports
  ltsContextCreate,
  ltsContextGetCodePage,
  ltsContextGetDefaultChar,
  ltsContextSetCodePage,
  ltsContextSetDefaultChar,
  ltsContextDestroy,

  ltsRendererCreate,
  ltsRendererDestroy,

  ltsInitialize,
  ltsGetLastErrorCode,
  ltsGetLastErrorMsg,
  ltsFinalize;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TltsContext///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TltsContext.Destroy;
var
  i: Integer;
begin
  if Assigned(Renderers) then begin
    for i := fRenderers.Count-1 downto 0 do
      Renderers.Remove(fRenderers[i] as TtsRenderer);
  end;
  // TODO cleanup generators
  inherited Destroy;
end;

end.