libTextSuite/ultsRenderer.pas

unit ultsRenderer;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  ultsTypes,
  utsTextSuite, utsUtils, utsRenderer, utsTypes;

type
  TltsRendererCustomBeginRender = procedure(aArgs: Pointer); stdcall;
  TltsRendererCustomEndRender   = procedure(aArgs: Pointer); stdcall;
  TltsRendererCustomGetDrawPos  = function (aArgs: Pointer): TtsPosition; stdcall;
  TltsRendererCustomSetDrawPos  = procedure(const aValue: TtsPosition;  aArgs: Pointer); stdcall;
  TltsRendererCustomMoveDrawPos = procedure(const aOffset: TtsPosition; aArgs: Pointer); stdcall;
  TltsRendererCustomSetColor    = procedure(const aValue: TtsColor4f;   aArgs: Pointer); stdcall;
  TltsRendererCustomRender      = procedure(const aRef: Pointer; const aForcedWidth: Integer; aArgs: Pointer); stdcall;

  TltsRendererCustomCreateRef   = function (const aChar: TltsCharHandle; const aImage: TltsImageHandle; aArgs: Pointer): Pointer; stdcall;
  TltsRendererCustomFreeRef     = procedure(const aRef: Pointer; aArgs: Pointer); stdcall;

  PltsRendererCustomData = ^TltsRendererCustomData;
  TltsRendererCustomData = packed record
    args:         Pointer;

    BeginRender:  TltsRendererCustomBeginRender;
    EndRender:    TltsRendererCustomEndRender;
    GetDrawPos:   TltsRendererCustomGetDrawPos;
    SetDrawPos:   TltsRendererCustomSetDrawPos;
    MoveDrawPos:  TltsRendererCustomMoveDrawPos;
    SetColor:     TltsRendererCustomSetColor;
    Render:       TltsRendererCustomRender;

    CreatRef:     TltsRendererCustomCreateRef;
    FreeRef:      TltsRendererCustomFreeRef;
  end;

function ltsRendererCreate       (aHandle: TltsContextHandle; aType: TltsRendererType; aFormat: TtsFormat):                   TltsRendererHandle;  stdcall;
function ltsRendererCustomCreate (aHandle: TltsContextHandle; aFormat: TtsFormat; constref aData: TltsRendererCustomData):    TltsRendererHandle;  stdcall;
function ltsRendererBeginBlock   (aHandle: TltsRendererHandle; aTop, aLeft, aWidth, aHeight: Integer; aFlags: TtsBlockFlags): TltsTextBlockHandle; stdcall;
function ltsRendererEndBlock     (aHandle: TltsRendererHandle; aBlock: TltsTextBlockHandle):                                  TltsErrorCode;       stdcall;
function ltsRendererAbortBlock   (aHandle: TltsRendererHandle; aBlock: TltsTextBlockHandle):                                  TltsErrorCode;       stdcall;
function ltsRendererGetTextWidthA(aHandle: TltsRendererHandle; aFont: TltsFontHandle; aText: PAnsiChar):                      Integer;             stdcall;
function ltsRendererGetTextWidthW(aHandle: TltsRendererHandle; aFont: TltsFontHandle; aText: PWideChar):                      Integer;             stdcall;
function ltsRendererDestroy      (aHandle: TltsRendererHandle):                                                               TltsErrorCode;       stdcall;

implementation

uses
  ultsUtils, dglOpenGL, dglOpenGLES;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TltsRendererOpenGL = class(TtsRendererOpenGL)
  public
    procedure DelSlave(const aSlave: TtsRefManager); override;
    constructor Create(const aContext: TtsContext; const aFormat: TtsFormat);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TltsRendererOpenGLES = class(TtsRendererOpenGLES)
  public
    procedure DelSlave(const aSlave: TtsRefManager); override;
    constructor Create(const aContext: TtsContext; const aFormat: TtsFormat);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TltsRendererCustom = class(TtsRenderer)
  { TtsBlockRenderer }
  protected
    procedure BeginRender; override;
    procedure EndRender; override;
    function  GetDrawPos: TtsPosition; override;
    procedure SetDrawPos(const aValue: TtsPosition); override;
    procedure MoveDrawPos(const aOffset: TtsPosition); override;
    procedure SetColor(const aValue: TtsColor4f); override;
    procedure Render(const aRenderRef: TtsRenderRef; const aForcedWidth: Integer); override;

  { TtsRenderRefGenerator }
  public
    function  CreateRenderRef(const aChar: TtsChar; const aImage: TtsImage): TtsRenderRef; override;
    procedure FreeRenderRef(const aRenderRef: TtsRenderRef); override;

  { TltsRendererCustom }
  private
    fData: TltsRendererCustomData;
  public
    constructor Create(const aContext: TtsContext; const aFormat: TtsFormat; const aData: TltsRendererCustomData);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TltsRendererOpenGL////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TltsRendererOpenGL.DelSlave(const aSlave: TtsRefManager);
begin
  DelReference(aSlave);
  inherited DelSlave(aSlave);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TltsRendererOpenGL.Create(const aContext: TtsContext; const aFormat: TtsFormat);
begin
  dglOpenGL.InitOpenGL;
  dglOpenGL.ReadExtensions;
  dglOpenGL.ReadImplementationProperties;
  inherited Create(aContext, aFormat);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TltsRendererOpenGLES//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TltsRendererOpenGLES.DelSlave(const aSlave: TtsRefManager);
begin
  DelReference(aSlave);
  inherited DelSlave(aSlave);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TltsRendererOpenGLES.Create(const aContext: TtsContext; const aFormat: TtsFormat);
begin
  dglOpenGLES.InitOpenGLES;
  dglOpenGLES.ReadOpenGLCore;
  dglOpenGLES.ReadExtensions;
  dglOpenGLES.ReadCoreVersion;
  dglOpenGLES.ReadImplementationProperties;
  inherited Create(aContext, aFormat);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TltsRendererCustom////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TltsRendererCustom.CreateRenderRef(const aChar: TtsChar; const aImage: TtsImage): TtsRenderRef;
begin
  AddReference(ltsObjTypeChar, aChar);
  AddReference(ltsObjTypeImage, aImage);
  try
    if Assigned(fData.CreatRef)
      then result := fData.CreatRef(aChar, aImage, fData.args)
      else result := nil;
  finally
    DelReference(ltsObjTypeChar, aChar);
    DelReference(ltsObjTypeImage, aImage);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TltsRendererCustom.FreeRenderRef(const aRenderRef: TtsRenderRef);
begin
  if Assigned(fData.FreeRef) then
    fData.FreeRef(aRenderRef, fData.args);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TltsRendererCustom.BeginRender;
begin
  if Assigned(fData.BeginRender) then
    fData.BeginRender(fData.args);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TltsRendererCustom.EndRender;
begin
  if Assigned(fData.BeginRender) then
    fData.BeginRender(fData.args);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TltsRendererCustom.GetDrawPos: TtsPosition;
begin
  if Assigned(fData.BeginRender)
    then result := fData.GetDrawPos(fData.args)
    else result := tsPosition(0, 0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TltsRendererCustom.SetDrawPos(const aValue: TtsPosition);
begin
  if Assigned(fData.BeginRender) then
    fData.SetDrawPos(aValue, fData.args);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TltsRendererCustom.MoveDrawPos(const aOffset: TtsPosition);
begin
  if Assigned(fData.BeginRender) then
    fData.MoveDrawPos(aOffset, fData.args);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TltsRendererCustom.SetColor(const aValue: TtsColor4f);
begin
  if Assigned(fData.BeginRender) then
    fData.SetColor(aValue, fData.args);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TltsRendererCustom.Render(const aRenderRef: TtsRenderRef; const aForcedWidth: Integer);
begin
  if Assigned(fData.BeginRender) then
    fData.Render(aRenderRef, aForcedWidth, fData.args);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TltsRendererCustom.Create(const aContext: TtsContext; const aFormat: TtsFormat; const aData: TltsRendererCustomData);
begin
  inherited Create(aContext, aFormat);
  fData := aData;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Renderer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsRendererCreate(aHandle: TltsContextHandle; aType: TltsRendererType; 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);
    else
      SetLastError(ltsErrInvalidEnum, Format('%d is not a valid renderer type', [aType]));
      exit;
    end;
    AddReference(ltsObjTypeRenderer, r);
    result := r;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsRendererCustomCreate(aHandle: TltsContextHandle; aFormat: TtsFormat; constref aData: TltsRendererCustomData): 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;

    r := TltsRendererCustom.Create(c, aFormat, aData);
    AddReference(ltsObjTypeRenderer, r);
    result := r;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsRendererBeginBlock(aHandle: TltsRendererHandle; aTop, aLeft, aWidth, aHeight: Integer; aFlags: TtsBlockFlags): TltsTextBlockHandle; stdcall;
var
  r: TtsRenderer;
  b: TtsTextBlock;
begin
  try
    result := nil;
    if CheckRendererHandle(aHandle, r) then begin
      b := r.BeginBlock(aTop, aLeft, aWidth, aHeight, aFlags);
      AddReference(ltsObjTypeTextBlock, b);
      result := b;
    end;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsRendererEndBlock(aHandle: TltsRendererHandle; aBlock: TltsTextBlockHandle): TltsErrorCode; stdcall;
var
  r: TtsRenderer;
  b: TtsTextBlock;
begin
  try
    result := ltsErrNone;
    if CheckRendererHandle(aHandle, r) and CheckTextBlockHandle(aBlock, b) then begin
      DelReference(ltsObjTypeTextBlock, b);
      r.EndBlock(b);
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsRendererAbortBlock(aHandle: TltsRendererHandle; aBlock: TltsTextBlockHandle): TltsErrorCode; stdcall;
var
  r: TtsRenderer;
  b: TtsTextBlock;
begin
  try
    result := ltsErrNone;
    if CheckRendererHandle(aHandle, r) and CheckTextBlockHandle(aBlock, b) then begin
      DelReference(ltsObjTypeTextBlock, b);
      r.AbortBlock(b);
    end else
      result := LastErrorCode;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := LastErrorCode;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsRendererGetTextWidthA(aHandle: TltsRendererHandle; aFont: TltsFontHandle; aText: PAnsiChar): Integer; stdcall;
var
  r: TtsRenderer;
  f: TtsFont;
begin
  try
    if CheckRendererHandle(aHandle, r) and CheckFontHandle(aFont, f)
      then result := r.GetTextWidthA(f, aText)
      else result := -1;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := -1;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function ltsRendererGetTextWidthW(aHandle: TltsRendererHandle; aFont: TltsFontHandle; aText: PWideChar): Integer; stdcall;
var
  r: TtsRenderer;
  f: TtsFont;
begin
  try
    if CheckRendererHandle(aHandle, r) and CheckFontHandle(aFont, f)
      then result := r.GetTextWidthW(f, aText)
      else result := -1;
  except
    on ex: Exception do begin
      SetLastError(ex);
      result := -1;
    end;
  end;
end;

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

end.