|
- 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 (const aHandle: TltsContextHandle; const aType: TltsRendererType; const aFormat: TtsFormat): TltsRendererHandle; stdcall;
- function ltsRendererCustomCreate (const aHandle: TltsContextHandle; const aFormat: TtsFormat; const aData: PltsRendererCustomData): TltsRendererHandle; stdcall;
- function ltsRendererBeginBlock (const aHandle: TltsRendererHandle; const aTop, aLeft, aWidth, aHeight: Integer; const aFlags: TtsBlockFlags): TltsTextBlockHandle; stdcall;
- function ltsRendererEndBlock (const aHandle: TltsRendererHandle; const aBlock: TltsTextBlockHandle): TltsErrorCode; stdcall;
- function ltsRendererAbortBlock (const aHandle: TltsRendererHandle; const aBlock: TltsTextBlockHandle): TltsErrorCode; stdcall;
- function ltsRendererGetTextWidthA(const aHandle: TltsRendererHandle; const aFont: TltsFontHandle; const aText: PAnsiChar): Integer; stdcall;
- function ltsRendererGetTextWidthW(const aHandle: TltsRendererHandle; const aFont: TltsFontHandle; const aText: PWideChar): Integer; stdcall;
- function ltsRendererDestroy (const 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(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);
- 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(const aHandle: TltsContextHandle; const aFormat: TtsFormat; const aData: PltsRendererCustomData): TltsRendererHandle; stdcall;
- var
- c: TtsContext;
- r: TtsRenderer;
- begin
- try
- result := nil;
- if not CheckContextHandle(aHandle, c) then
- exit;
-
- if not Assigned(aData) then begin
- SetLastError(ltsErrInvalidValue, Format('prameter ''aData'' is not assigned', [aFormat]));
- exit;
- end;
-
- 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(const aHandle: TltsRendererHandle; const aTop, aLeft, aWidth, aHeight: Integer; const 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(const aHandle: TltsRendererHandle; const 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(const aHandle: TltsRendererHandle; const 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(const aHandle: TltsRendererHandle; const aFont: TltsFontHandle; const 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(const aHandle: TltsRendererHandle; const aFont: TltsFontHandle; const 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(const 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.
|