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; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 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; 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.