From cb3db5ffd8520ef3204718a28c60774194bbdc23 Mon Sep 17 00:00:00 2001 From: Bergmann89 Date: Sat, 24 Oct 2015 16:56:07 +0200 Subject: [PATCH] * implementation almost finished but not tested yet * updates submodule: TextSuite --- TextSuite | 2 +- libTextSuite.lpi | 52 ++++- libTextSuite.lpr | 459 ++++++++--------------------------------- ultsContext.pas | 187 +++++++++++++++++ ultsFont.pas | 284 ++++++++++++++++++++++++++ ultsFontCreator.pas | 196 ++++++++++++++++++ ultsGeneral.pas | 64 ++++++ ultsImage.pas | 458 +++++++++++++++++++++++++++++++++++++++++ ultsPostProcessor.pas | 378 ++++++++++++++++++++++++++++++++++ ultsRenderer.pas | 212 +++++++++++++++++++ ultsTextBlock.pas | 460 ++++++++++++++++++++++++++++++++++++++++++ ultsTypes.pas | 88 ++++++++ ultsUtils.pas | 312 ++++++++++++++++++++++++++++ utsTextSuite.inc | 4 + 14 files changed, 2780 insertions(+), 376 deletions(-) create mode 100644 ultsContext.pas create mode 100644 ultsFont.pas create mode 100644 ultsFontCreator.pas create mode 100644 ultsGeneral.pas create mode 100644 ultsImage.pas create mode 100644 ultsPostProcessor.pas create mode 100644 ultsRenderer.pas create mode 100644 ultsTextBlock.pas create mode 100644 ultsTypes.pas create mode 100644 ultsUtils.pas create mode 100644 utsTextSuite.inc diff --git a/TextSuite b/TextSuite index 893e916..4145843 160000 --- a/TextSuite +++ b/TextSuite @@ -1 +1 @@ -Subproject commit 893e9166cd762b505bb8cd72ce7f999a1b5e97b3 +Subproject commit 414584359b16746bee43cf52d661ee6112ee824b diff --git a/libTextSuite.lpi b/libTextSuite.lpi index 6930e7e..1607976 100644 --- a/libTextSuite.lpi +++ b/libTextSuite.lpi @@ -31,12 +31,60 @@ - + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/libTextSuite.lpr b/libTextSuite.lpr index 1a9b018..77105e8 100644 --- a/libTextSuite.lpr +++ b/libTextSuite.lpr @@ -4,365 +4,8 @@ library libTextSuite; uses Classes, SysUtils, - utsTextSuite, utsTypes, utsRendererOpenGL, utsRendererOpenGLES, - uutlGenerics; + ultsContext, ultsRenderer, ultsTextBlock, ultsGeneral, ultsFont, ultsFontCreator, ultsImage, ultsPostProcessor; -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -//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, @@ -372,27 +15,97 @@ exports ltsContextDestroy, ltsRendererCreate, + ltsRendererBeginBlock, + ltsRendererEndBlock, ltsRendererDestroy, + ltsFontCreatorCreate, + ltsFontCreatorGetFontByName, + ltsFontCreatorGetFontByFile, + ltsFontCreatorGetFontByStream, + ltsFontCreatorDestroy, + + ltsFontGetPostProcessor, + ltsFontGetTabWidth, + ltsFontGetCharSpacing, + ltsFontGetLineSpacing, + ltsFontGetMetric, + ltsFontGetFontname, + ltsFontGetFacename, + ltsFontGetStylename, + ltsFontGetFullname, + ltsFontGetCopyright, + ltsFontSetPostProcessor, + ltsFontSetTabWidth, + ltsFontSetCharSpacing, + ltsFontSetLineSpacing, + + ltsTextBlockGetRect, + ltsTextBlockGetWidth, + ltsTextBlockGetHeight, + ltsTextBlockGetFlags, + ltsTextBlockGetTop, + ltsTextBlockGetLeft, + ltsTextBlockGetVertAlign, + ltsTextBlockGetHorzAlign, + ltsTextBlockGetClipping, + ltsTextBlockGetColor, + ltsTextBlockGetFont, + ltsTextBlockSetTop, + ltsTextBlockSetLeft, + ltsTextBlockSetVertAlign, + ltsTextBlockSetHorzAlign, + ltsTextBlockSetClipping, + ltsTextBlockSetColor, + ltsTextBlockSetFont, + ltsTextBlockGetActualHeight, + ltsTextBlockGetTextWidthA, + ltsTextBlockGetTextWidthW, + ltsTextBlockTextOutA, + ltsTextBlockTextOutW, + + ltsImageCreate, + ltsImageIsEmpty, + ltsImageGetWidth, + ltsImageGetHeight, + ltsImageGetLineSize, + ltsImageGetDataSize, + ltsImageGetFormat, + ltsImageGetData, + ltsImageGetScanline, + lstImageGetPixelAt, + ltsImageAssign, + ltsImageCreateEmpty, + ltsImageLoadFromFunc, + ltsImageResize, + ltsImageFillColor, + ltsImageFillPattern, + ltsImageBlend, + ltsImageBlur, + ltsImageDestroy, + + ltsPostProcessorAddRange, + ltsPostProcessorAddChars, + ltsPostProcessorClearRanges, + ltsPostProcessorFillColorCreate, + ltsPostProcessorFillPatterCreate, + ltsPostProcessorBorderCreate, + ltsPostProcessorShadowCreate, + ltsPostProcessorListCreate, + ltsPostProcessorListGetCount, + ltsPostProcessorListGetItem, + ltsPostProcessorListGetOwnsObjects, + ltsPostProcessorListSetOwnsObjects, + ltsPostProcessorListAdd, + ltsPostProcessorListDel, + ltsPostProcessorListClear, + ltsPostProcessorListRem, + ltsPostProcessorListIndexOf, + 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. diff --git a/ultsContext.pas b/ultsContext.pas new file mode 100644 index 0000000..4ed1dac --- /dev/null +++ b/ultsContext.pas @@ -0,0 +1,187 @@ +unit ultsContext; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + utsTextSuite, utsUtils, + ultsTypes; + +type +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TltsContext = class(TtsContext) + public + procedure DelSlave(const aSlave: TtsRefManager); override; + end; + + function ltsContextCreate (): TltsContextHandle; stdcall; + function ltsContextGetCodePage (const aHandle: TltsContextHandle; var aCodePage: TtsCodePage): TltsErrorCode; stdcall; + function ltsContextGetDefaultChar (const aHandle: TltsContextHandle; var aValue: WideChar): TltsErrorCode; stdcall; + function ltsContextSetCodePage (const aHandle: TltsContextHandle; const aCodePage: TtsCodePage): TltsErrorCode; stdcall; + function ltsContextSetDefaultChar (const aHandle: TltsContextHandle; const aValue: WideChar): TltsErrorCode; stdcall; + function ltsContextAnsiToWide (const aHandle: TltsContextHandle; const aText: PAnsiChar): PWideChar; stdcall; + function ltsContextDestroy (const aHandle: TltsContextHandle): TltsErrorCode; stdcall; + +implementation + +uses + ultsUtils; + +var + WideStringBuffer: WideString; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TltsContext/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TltsContext.DelSlave(const aSlave: TtsRefManager); +begin + DelReference(aSlave); + inherited DelSlave(aSlave); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//Context/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsContextCreate: TltsContextHandle; stdcall; +var + c: TltsContext; +begin + try + result := nil; + if not CheckIfInitialized then + exit; + c := TltsContext.Create; + AddReference(ltsObjTypeContext, 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.DefaultChar + 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.DefaultChar := aValue + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsContextAnsiToWide(const aHandle: TltsContextHandle; const aText: PAnsiChar): PWideChar; stdcall; +var + c: TtsContext; + w: PWideChar; +begin + try + result := nil; + if CheckContextHandle(aHandle, c) then begin + w := c.AnsiToWide(aText); + if not Assigned(w) then + exit; + WideStringBuffer := w; + tsStrDispose(w); + result := PWideChar(WideStringBuffer); + end else + result := nil; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsContextDestroy(const aHandle: TltsContextHandle): TltsErrorCode; stdcall; +var + c: TtsContext; +begin + try + result := ltsErrNone; + if CheckContextHandle(aHandle, c) + then DelReference(ltsObjTypeContext, c) + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +end. + diff --git a/ultsFont.pas b/ultsFont.pas new file mode 100644 index 0000000..5591de7 --- /dev/null +++ b/ultsFont.pas @@ -0,0 +1,284 @@ +unit ultsFont; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + utsTextSuite, + ultsTypes; + +function ltsFontGetPostProcessor (const aHandle: TltsFontHandle): TltsPostProcessorHandle; stdcall; +function ltsFontGetTabWidth (const aHandle: TltsFontHandle; var aValue: Integer): TltsErrorCode; stdcall; +function ltsFontGetCharSpacing (const aHandle: TltsFontHandle; var aValue: Integer): TltsErrorCode; stdcall; +function ltsFontGetLineSpacing (const aHandle: TltsFontHandle; var aValue: Single): TltsErrorCode; stdcall; +function ltsFontGetMetric (const aHandle: TltsFontHandle; var aValue: TtsFontMetric): TltsErrorCode; stdcall; + +function ltsFontGetFontname (const aHandle: TltsFontHandle): PAnsiChar; stdcall; +function ltsFontGetFacename (const aHandle: TltsFontHandle): PAnsiChar; stdcall; +function ltsFontGetStylename (const aHandle: TltsFontHandle): PAnsiChar; stdcall; +function ltsFontGetFullname (const aHandle: TltsFontHandle): PAnsiChar; stdcall; +function ltsFontGetCopyright (const aHandle: TltsFontHandle): PAnsiChar; stdcall; + +function ltsFontSetPostProcessor (const aHandle: TltsFontHandle; const aValue: TltsPostProcessorHandle): TltsErrorCode; stdcall; +function ltsFontSetTabWidth (const aHandle: TltsFontHandle; const aValue: Integer): TltsErrorCode; stdcall; +function ltsFontSetCharSpacing (const aHandle: TltsFontHandle; const aValue: Integer): TltsErrorCode; stdcall; +function ltsFontSetLineSpacing (const aHandle: TltsFontHandle; const aValue: Single): TltsErrorCode; stdcall; + +implementation + +uses + ultsUtils; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//Font////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontGetPostProcessor(const aHandle: TltsFontHandle): TltsPostProcessorHandle; stdcall; +var + f: TtsFont; +begin + try + if CheckFontHandle(aHandle, f) + then result := f.PostProcessor + else result := nil; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontGetTabWidth(const aHandle: TltsFontHandle; var aValue: Integer): TltsErrorCode; stdcall; +var + f: TtsFont; +begin + try + result := ltsErrNone; + if CheckFontHandle(aHandle, f) + then aValue := f.TabWidth + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontGetCharSpacing(const aHandle: TltsFontHandle; var aValue: Integer): TltsErrorCode; stdcall; +var + f: TtsFont; +begin + try + result := ltsErrNone; + if CheckFontHandle(aHandle, f) + then aValue := f.CharSpacing + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontGetLineSpacing(const aHandle: TltsFontHandle; var aValue: Single): TltsErrorCode; stdcall; +var + f: TtsFont; +begin + try + result := ltsErrNone; + if CheckFontHandle(aHandle, f) + then aValue := f.LineSpacing + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontGetMetric(const aHandle: TltsFontHandle; var aValue: TtsFontMetric): TltsErrorCode; stdcall; +var + f: TtsFont; +begin + try + result := ltsErrNone; + if CheckFontHandle(aHandle, f) + then aValue := f.Metric + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontGetFontname(const aHandle: TltsFontHandle): PAnsiChar; stdcall; +var + f: TtsFont; +begin + try + if CheckFontHandle(aHandle, f) + then result := PAnsiChar(f.Names.Fontname) + else result := nil; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontGetFacename(const aHandle: TltsFontHandle): PAnsiChar; stdcall; +var + f: TtsFont; +begin + try + if CheckFontHandle(aHandle, f) + then result := PAnsiChar(f.Names.FaceName) + else result := nil; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontGetStylename(const aHandle: TltsFontHandle): PAnsiChar; stdcall; +var + f: TtsFont; +begin + try + if CheckFontHandle(aHandle, f) + then result := PAnsiChar(f.Names.StyleName) + else result := nil; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontGetFullname(const aHandle: TltsFontHandle): PAnsiChar; stdcall; +var + f: TtsFont; +begin + try + if CheckFontHandle(aHandle, f) + then result := PAnsiChar(f.Names.FullName) + else result := nil; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontGetCopyright(const aHandle: TltsFontHandle): PAnsiChar; stdcall; +var + f: TtsFont; +begin + try + if CheckFontHandle(aHandle, f) + then result := PAnsiChar(f.Names.Copyright) + else result := nil; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontSetPostProcessor(const aHandle: TltsFontHandle; const aValue: TltsPostProcessorHandle): TltsErrorCode; stdcall; +var + f: TtsFont; + p: TtsPostProcessor; +begin + try + result := ltsErrNone; + if CheckFontHandle(aHandle, f) and CheckPostProcessorHandle(aValue, TtsPostProcessor, p) + then f.PostProcessor := p + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontSetTabWidth(const aHandle: TltsFontHandle; const aValue: Integer): TltsErrorCode; stdcall; +var + f: TtsFont; +begin + try + result := ltsErrNone; + if CheckFontHandle(aHandle, f) + then f.TabWidth := aValue + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontSetCharSpacing(const aHandle: TltsFontHandle; const aValue: Integer): TltsErrorCode; stdcall; +var + f: TtsFont; +begin + try + result := ltsErrNone; + if CheckFontHandle(aHandle, f) + then f.CharSpacing := aValue + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontSetLineSpacing(const aHandle: TltsFontHandle; const aValue: Single): TltsErrorCode; stdcall; +var + f: TtsFont; +begin + try + result := ltsErrNone; + if CheckFontHandle(aHandle, f) + then f.LineSpacing := aValue + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +end. + diff --git a/ultsFontCreator.pas b/ultsFontCreator.pas new file mode 100644 index 0000000..edcf54a --- /dev/null +++ b/ultsFontCreator.pas @@ -0,0 +1,196 @@ +unit ultsFontCreator; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + utsTextSuite, + ultsTypes; + +function ltsFontCreatorCreate (const aHandle: TltsContextHandle; const aType: TltsFontCreatorType): TltsFontCreatorHandle; stdcall; +function ltsFontCreatorGetFontByName (const aHandle: TltsFontCreatorHandle; const aFontname: PAnsiChar; const aSize: Integer; + const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TltsFontHandle; stdcall; +function ltsFontCreatorGetFontByFile (const aHandle: TltsFontCreatorHandle; const aFilename: PAnsiChar; const aSize: Integer; + const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TltsFontHandle; stdcall; +function ltsFontCreatorGetFontByStream(const aHandle: TltsFontCreatorHandle; const aStream: PltsStream; const aSize: Integer; + const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TltsFontHandle; stdcall; +function ltsFontCreatorDestroy (const aHandle: TltsFontCreatorHandle): TltsErrorCode; stdcall; + +implementation + +uses + utsUtils, + ultsUtils; + +type +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TltsFontCreatorFreeType = class(TtsFontCreatorFreeType) + public + procedure DelSlave(const aSlave: TtsRefManager); override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TltsFontCreatorGDI = class(TtsFontCreatorGDI) + public + procedure DelSlave(const aSlave: TtsRefManager); override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TltsFontCreatorFreeType/////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TltsFontCreatorFreeType.DelSlave(const aSlave: TtsRefManager); +begin + DelReference(aSlave); + inherited DelSlave(aSlave); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TltsFontCreatorGDI//////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TltsFontCreatorGDI.DelSlave(const aSlave: TtsRefManager); +begin + DelReference(aSlave); + inherited DelSlave(aSlave); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//FontCreato/////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontCreatorCreate(const aHandle: TltsContextHandle; const aType: TltsFontCreatorType): TltsFontCreatorHandle; stdcall; +var + c: TtsContext; + fc: TtsFontCreator; +begin + try + result := nil; + if not CheckContextHandle(aHandle, c) then + exit; + + case aType of + ltsFontCreatorFreeType: fc := TltsFontCreatorFreeType.Create(c); + ltsFontCreatorGDI: fc := TltsFontCreatorGDI.Create(c); + // TODO ltsRendererCustom: r := TltsRendererCustom.Create(c, aFormat); + else + SetLastError(ltsErrInvalidEnum, Format('%d is not a valid font creator type', [aType])); + exit; + end; + AddReference(ltsObjTypeFontCreator, fc); + result := fc; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontCreatorGetFontByName(const aHandle: TltsFontCreatorHandle; const aFontname: PAnsiChar; + const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TltsFontHandle; stdcall; +var + fc: TtsFontCreator; + f: TtsFont; +begin + try + result := nil; + if not CheckFontCreatorHandle(aHandle, fc) then + exit; + f := fc.GetFontByName(aFontname, aSize, aStyle, aAntiAliasing); + if not Assigned(f) then begin + SetLastError(ltsErrInvalidOperation, 'GetFontByName is not supported by this font creator'); + exit; + end; + AddReference(ltsObjTypeFont, f); + result := f; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontCreatorGetFontByFile(const aHandle: TltsFontCreatorHandle; const aFilename: PAnsiChar; + const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TltsFontHandle; stdcall; +var + fc: TtsFontCreator; + f: TtsFont; +begin + try + result := nil; + if not CheckFontCreatorHandle(aHandle, fc) then + exit; + f := fc.GetFontByFile(aFilename, aSize, aStyle, aAntiAliasing); + if not Assigned(f) then begin + SetLastError(ltsErrInvalidOperation, 'GetFontByFile is not supported by this font creator'); + exit; + end; + AddReference(ltsObjTypeFont, f); + result := f; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontCreatorGetFontByStream(const aHandle: TltsFontCreatorHandle; const aStream: PltsStream; + const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TltsFontHandle; stdcall; +var + fc: TtsFontCreator; + f: TtsFont; + s: TStream; +begin + try + result := nil; + if not CheckFontCreatorHandle(aHandle, fc) then + exit; + + s := TltsStreamImpl.Create(aStream); + try + f := fc.GetFontByStream(s, aSize, aStyle, aAntiAliasing); + finally + FreeAndNil(s); + end; + + if not Assigned(f) then begin + SetLastError(ltsErrInvalidOperation, 'GetFontByStream is not supported by this font creator'); + exit; + end; + AddReference(ltsObjTypeFont, f); + result := f; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsFontCreatorDestroy(const aHandle: TltsFontCreatorHandle): TltsErrorCode; stdcall; +var + fc: TtsFontCreator; +begin + try + result := ltsErrNone; + if CheckFontCreatorHandle(aHandle, fc) then begin + DelReference(ltsObjTypeFontCreator, fc); + FreeAndNil(fc); + end else + result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +end. + diff --git a/ultsGeneral.pas b/ultsGeneral.pas new file mode 100644 index 0000000..ed0db8e --- /dev/null +++ b/ultsGeneral.pas @@ -0,0 +1,64 @@ +unit ultsGeneral; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + ultsTypes; + +function ltsInitialize: TltsErrorCode; stdcall; +function ltsGetLastErrorCode: TltsErrorCode; stdcall; +function ltsGetLastErrorMsg: PAnsiChar; stdcall; +function ltsFinalize: TltsErrorCode; stdcall; + +implementation + +uses + ultsUtils; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//General/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsInitialize: TltsErrorCode; stdcall; +begin + try + result := ltsErrNone; + Initialize; + 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 + Finalize; + result := ltsErrNone; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +end. + diff --git a/ultsImage.pas b/ultsImage.pas new file mode 100644 index 0000000..4db6c5a --- /dev/null +++ b/ultsImage.pas @@ -0,0 +1,458 @@ +unit ultsImage; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + utsTextSuite, + ultsTypes; + +type + TltsImageFunc = procedure(const aHandle: TltsImageHandle; const X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer); stdcall; + TltsBlendColorFunc = function (const aHandle: TltsImageHandle; const aSrc, aDst: TtsColor4f; aArgs: Pointer): TtsColor4f; stdcall; + +function ltsImageCreate (const aContext: TltsContextHandle): TltsImageHandle; stdcall; +function ltsImageIsEmpty (const aHandle: TltsImageHandle; var aValue: Boolean): TltsErrorCode; stdcall; +function ltsImageGetWidth (const aHandle: TltsImageHandle): Integer; stdcall; +function ltsImageGetHeight (const aHandle: TltsImageHandle): Integer; stdcall; +function ltsImageGetLineSize (const aHandle: TltsImageHandle): Integer; stdcall; +function ltsImageGetDataSize (const aHandle: TltsImageHandle): Integer; stdcall; +function ltsImageGetFormat (const aHandle: TltsImageHandle; var aValue: TtsFormat): TltsErrorCode; stdcall; +function ltsImageGetData (const aHandle: TltsImageHandle): Pointer; stdcall; +function ltsImageGetScanline (const aHandle: TltsImageHandle; const aIndex: Integer): Pointer; stdcall; +function lstImageGetPixelAt (const aHandle: TltsImageHandle; const aX, aY: Integer; var aColor: TtsColor4f): TltsErrorCode; stdcall; +function ltsImageAssign (const aHandle, aSource: TltsImageHandle): TltsErrorCode; stdcall; +function ltsImageCreateEmpty (const aHandle: TltsImageHandle; const aFormat: TtsFormat; const aWidth, aHeight: Integer): TltsErrorCode; stdcall; +function ltsImageLoadFromFunc (const aHandle: TltsImageHandle; const aCallback: TltsImageFunc; aArgs: Pointer): TltsErrorCode; stdcall; +function ltsImageResize (const aHandle: TltsImageHandle; const aWidth, aHeight, aX, aY: Integer): TltsErrorCode; stdcall; +function ltsImageFillColor (const aHandle: TltsImageHandle; const aColor: TtsColor4f; const aMask: TtsColorChannels; const aModes: TtsImageModes): TltsErrorCode; stdcall; +function ltsImageFillPattern (const aHandle, aPattern: TltsImageHandle; const aX, aY: Integer; const aMask: TtsColorChannels; const aModes: TtsImageModes): TltsErrorCode; stdcall; +function ltsImageBlend (const aHandle, aSource: TltsImageHandle; const aX, aY: Integer; const aBlendFunc: TltsBlendColorFunc; aArgs: Pointer): TltsErrorCode; stdcall; +function ltsImageBlur (const aHandle: TltsImageHandle; const aHorzRad, aHorzStr, aVertRad, aVertStr: Single; const aMask: TtsColorChannels): TltsErrorCode; stdcall; +function ltsImageDestroy (const aHandle: TltsImageHandle): TltsErrorCode; stdcall; + +implementation + +uses + ultsUtils, utsUtils; + +type + PLoadArgs = ^TLoadArgs; + TLoadArgs = packed record + args: Pointer; + handle: TltsImageHandle; + callback: TltsImageFunc + end; + + PBlendArgs = ^TBlendArgs; + TBlendArgs = packed record + args: Pointer; + handle: TltsImageHandle; + callback: TltsBlendColorFunc; + end; + +procedure ImageLoadCallback(const aImage: TtsImage; X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer); +var + p: PLoadArgs; +begin + p := PLoadArgs(aArgs); + p^.callback(p^.handle, X, Y, aPixel, p^.args); +end; + +function ImageBlendCallback(const aSrc, aDst: TtsColor4f; aArgs: Pointer): TtsColor4f; +var + p: PBlendArgs; +begin + p := PBlendArgs(aArgs); + result := p^.callback(p^.handle, aSrc, aDst, p^.args); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//ltsImage////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageCreate(const aContext: TltsContextHandle): TltsImageHandle; stdcall; +var + img: TtsImage; + c: TtsContext; +begin + try + result := nil; + if not CheckContextHandle(aContext, c) then + exit; + img := TtsImage.Create(c); + AddReference(ltsObjTypeImage, img); + result := img; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageIsEmpty(const aHandle: TltsImageHandle; var aValue: Boolean): TltsErrorCode; stdcall; +var + img: TtsImage; +begin + try + result := ltsErrNone; + if CheckImageHandle(aHandle, img) + then aValue := img.IsEmpty + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageGetWidth(const aHandle: TltsImageHandle): Integer; stdcall; +var + img: TtsImage; +begin + try + if CheckImageHandle(aHandle, img) + then result := img.Width + else result := -1; + except + on ex: Exception do begin + SetLastError(ex); + result := -1; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageGetHeight(const aHandle: TltsImageHandle): Integer; stdcall; +var + img: TtsImage; +begin + try + if CheckImageHandle(aHandle, img) + then result := img.Height + else result := -1; + except + on ex: Exception do begin + SetLastError(ex); + result := -1; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageGetLineSize(const aHandle: TltsImageHandle): Integer; stdcall; +var + img: TtsImage; +begin + try + if CheckImageHandle(aHandle, img) + then result := img.LineSize + else result := -1; + except + on ex: Exception do begin + SetLastError(ex); + result := -1; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageGetDataSize(const aHandle: TltsImageHandle): Integer; stdcall; +var + img: TtsImage; +begin + try + if CheckImageHandle(aHandle, img) + then result := img.DataSize + else result := -1; + except + on ex: Exception do begin + SetLastError(ex); + result := -1; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageGetFormat(const aHandle: TltsImageHandle; var aValue: TtsFormat): TltsErrorCode; stdcall; +var + img: TtsImage; +begin + try + result := ltsErrNone; + if CheckImageHandle(aHandle, img) + then aValue := img.Format + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageGetData(const aHandle: TltsImageHandle): Pointer; stdcall; +var + img: TtsImage; +begin + try + if CheckImageHandle(aHandle, img) + then result := img.Data + else result := nil; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageGetScanline(const aHandle: TltsImageHandle; const aIndex: Integer): Pointer; stdcall; +var + img: TtsImage; +begin + try + if CheckImageHandle(aHandle, img) then begin + result := img.Scanline[aIndex]; + if not Assigned(result) then + SetLastError(ltsErrInvalidValue, Format('index (%d) is out of range', [aIndex])); + end else + result := nil; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function lstImageGetPixelAt(const aHandle: TltsImageHandle; const aX, aY: Integer; var aColor: TtsColor4f): TltsErrorCode; stdcall; +var + img: TtsImage; +begin + try + result := ltsErrNone; + if CheckImageHandle(aHandle, img) then begin + if not img.GetPixelAt(aX, aY, aColor) then begin + SetLastError(ltsErrInvalidValue, Format('x (%d) or y (%d) is out of range', [aX, aY])); + result := LastErrorCode; + end; + end else + result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageAssign(const aHandle, aSource: TltsImageHandle): TltsErrorCode; stdcall; +var + img, src: TtsImage; +begin + try + result := ltsErrNone; + if CheckImageHandle(aHandle, img) and CheckImageHandle(aSource, src) + then img.Assign(src) + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageCreateEmpty(const aHandle: TltsImageHandle; const aFormat: TtsFormat; const aWidth, aHeight: Integer): TltsErrorCode; stdcall; +var + img: TtsImage; +begin + try + result := ltsErrNone; + if not ValidateFormat(aFormat) then begin + result := LastErrorCode; + end else if (aWidth < 0) then begin + SetLastError(ltsErrInvalidValue, 'width must be a positive value'); + result := LastErrorCode; + end else if (aHeight < 0) then begin + SetLastError(ltsErrInvalidValue, 'height must be a positive value'); + result := LastErrorCode; + end else if not CheckImageHandle(aHandle, img) then begin + result := LastErrorCode; + end else + img.CreateEmpty(aFormat, aWidth, aHeight); + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageLoadFromFunc(const aHandle: TltsImageHandle; const aCallback: TltsImageFunc; aArgs: Pointer): TltsErrorCode; stdcall; +var + img: TtsImage; + la: TLoadArgs; +begin + try + result := ltsErrNone; + if CheckImageHandle(aHandle, img) then begin + la.args := aArgs; + la.callback := aCallback; + la.handle := aHandle; + img.LoadFromFunc(@ImageLoadCallback, @la); + end else + result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageResize(const aHandle: TltsImageHandle; const aWidth, aHeight, aX, aY: Integer): TltsErrorCode; stdcall; +var + img: TtsImage; +begin + try + result := ltsErrNone; + if (aWidth < 0) then begin + SetLastError(ltsErrInvalidValue, 'width must be a positive value'); + result := LastErrorCode; + end else if (aHeight < 0) then begin + SetLastError(ltsErrInvalidValue, 'height must be a positive value'); + result := LastErrorCode; + end else if not CheckImageHandle(aHandle, img) then begin + result := LastErrorCode; + end else + img.Resize(aWidth, aHeight, aX, aY); + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageFillColor(const aHandle: TltsImageHandle; const aColor: TtsColor4f; const aMask: TtsColorChannels; const aModes: TtsImageModes): TltsErrorCode; stdcall; +var + img: TtsImage; +begin + try + result := ltsErrNone; + if CheckImageHandle(aHandle, img) + then img.FillColor(aColor, aMask, aModes) + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageFillPattern(const aHandle, aPattern: TltsImageHandle; const aX, aY: Integer; const aMask: TtsColorChannels; const aModes: TtsImageModes): TltsErrorCode; stdcall; +var + img, pattern: TtsImage; +begin + try + result := ltsErrNone; + if CheckImageHandle(aHandle, img) and CheckImageHandle(aPattern, pattern) + then img.FillPattern(pattern, aX, aY, aMask, aModes) + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageBlend(const aHandle, aSource: TltsImageHandle; const aX, aY: Integer; const aBlendFunc: TltsBlendColorFunc; aArgs: Pointer): TltsErrorCode; stdcall; +var + img, src: TtsImage; + ba: TBlendArgs; +begin + try + result := ltsErrNone; + if CheckImageHandle(aHandle, img) and CheckImageHandle(aSource, src) then begin + ba.args := aArgs; + ba.handle := aHandle; + ba.callback := aBlendFunc; + img.Blend(src, aX, aY, @ImageBlendCallback, @ba); + end else + result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageBlur(const aHandle: TltsImageHandle; const aHorzRad, aHorzStr, aVertRad, aVertStr: Single; const aMask: TtsColorChannels): TltsErrorCode; stdcall; +var + img: TtsImage; + horz, vert: TtsKernel1D; +begin + try + result := ltsErrNone; + if CheckImageHandle(aHandle, img) then begin + horz := TtsKernel1D.Create(aHorzRad, aHorzStr); + vert := TtsKernel1D.Create(aVertRad, aVertStr); + try + img.Blur(horz, vert, aMask); + finally + FreeAndNil(horz); + FreeAndNil(vert); + end; + end else + result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsImageDestroy(const aHandle: TltsImageHandle): TltsErrorCode; stdcall; +var + img: TtsImage; +begin + try + result := ltsErrNone; + if CheckImageHandle(aHandle, img) then begin + DelReference(ltsObjTypeImage, img); + FreeAndNil(img); + end else + result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +end. + diff --git a/ultsPostProcessor.pas b/ultsPostProcessor.pas new file mode 100644 index 0000000..0670c51 --- /dev/null +++ b/ultsPostProcessor.pas @@ -0,0 +1,378 @@ +unit ultsPostProcessor; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + ultsTypes, utsTextSuite; + +function ltsPostProcessorAddRange (const aHandle: TltsPostProcessorHandle; const aUsage: TtsCharRangeUsage; const aStart, aStop: WideChar): TltsErrorCode; stdcall; +function ltsPostProcessorAddChars (const aHandle: TltsPostProcessorHandle; const aUsage: TtsCharRangeUsage; const aChars: PWideChar): TltsErrorCode; stdcall; +function ltsPostProcessorClearRanges (const aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall; + +function ltsPostProcessorFillColorCreate (const aContext: TltsContextHandle; const aColor: TtsColor4f; + const aModes: TtsImageModes; const aChannels: TtsColorChannels): TltsPostProcessorHandle; stdcall; +function ltsPostProcessorFillPatterCreate (const aContext: TltsContextHandle; const aPattern: TltsImageHandle; const aOwnsPatter: Boolean; + const aPosition: TtsPosition; const aModes: TtsImageModes; const aChannels: TtsColorChannels): TltsPostProcessorHandle; stdcall; +function ltsPostProcessorBorderCreate (const aContext: TltsContextHandle; const aWidth, aStrength: Single; + const aColor: TtsColor4f; const aKeepSize: Boolean): TltsPostProcessorHandle; stdcall; +function ltsPostProcessorShadowCreate (const aContext: TltsContextHandle; const aRadius, aStrength: Single; + const aOffset: TtsPosition; const aColor: TtsColor4f): TltsPostProcessorHandle; stdcall; + +function ltsPostProcessorListCreate (const aContext: TltsContextHandle): TltsPostProcessorHandle; stdcall; +function ltsPostProcessorListGetCount (const aHandle: TltsPostProcessorHandle): Integer; stdcall; +function ltsPostProcessorListGetItem (const aHandle: TltsPostProcessorHandle; const aIndex: Integer): TltsPostProcessorHandle; stdcall; +function ltsPostProcessorListGetOwnsObjects (const aHandle: TltsPostProcessorHandle; var aValue: Boolean): TltsErrorCode; stdcall; +function ltsPostProcessorListSetOwnsObjects (const aHandle: TltsPostProcessorHandle; const aValue: Boolean): TltsErrorCode; stdcall; +function ltsPostProcessorListAdd (const aHandle, aItem: TltsPostProcessorHandle): TltsErrorCode; stdcall; +function ltsPostProcessorListDel (const aHandle: TltsPostProcessorHandle; const aIndex: Integer): TltsErrorCode; stdcall; +function ltsPostProcessorListClear (const aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall; +function ltsPostProcessorListRem (const aHandle, aItem: TltsPostProcessorHandle): Integer; stdcall; +function ltsPostProcessorListIndexOf (const aHandle, aItem: TltsPostProcessorHandle): Integer; stdcall; + +implementation + +uses + ultsUtils; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//ltsPostProcessor////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorAddRange(const aHandle: TltsPostProcessorHandle; const aUsage: TtsCharRangeUsage; const aStart, aStop: WideChar): TltsErrorCode; stdcall; +var + pp: TtsPostProcessor; +begin + try + result := ltsErrNone; + if ValidateCharRangeUsage(aUsage) and CheckPostProcessorHandle(aHandle, TtsPostProcessor, pp) + then pp.AddRange(aUsage, aStart, aStop) + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorAddChars(const aHandle: TltsPostProcessorHandle; const aUsage: TtsCharRangeUsage; const aChars: PWideChar): TltsErrorCode; stdcall; +var + pp: TtsPostProcessor; +begin + try + result := ltsErrNone; + if ValidateCharRangeUsage(aUsage) and CheckPostProcessorHandle(aHandle, TtsPostProcessor, pp) + then pp.AddChars(aUsage, aChars) + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorClearRanges(const aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall; +var + pp: TtsPostProcessor; +begin + try + result := ltsErrNone; + if CheckPostProcessorHandle(aHandle, TtsPostProcessor, pp) + then pp.ClearRanges + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorFillColorCreate(const aContext: TltsContextHandle; const aColor: TtsColor4f; const aModes: TtsImageModes; const aChannels: TtsColorChannels): TltsPostProcessorHandle; stdcall; +var + c: TtsContext; + pp: TtsPostProcessor; +begin + try + result := nil; + if CheckContextHandle(aContext, c) then begin + pp := TtsPostProcessorFillColor.Create(c, aColor, aModes, aChannels); + AddReference(ltsObjTypePostProcessor, pp); + result := pp; + end; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorFillPatterCreate(const aContext: TltsContextHandle; const aPattern: TltsImageHandle; const aOwnsPatter: Boolean; const aPosition: TtsPosition; const aModes: TtsImageModes; const aChannels: TtsColorChannels): TltsPostProcessorHandle; stdcall; +var + c: TtsContext; + img: TtsImage; + pp: TtsPostProcessor; +begin + try + result := nil; + img := nil; + if CheckContextHandle(aContext, c) and CheckImageHandle(aPattern, img) then begin + pp := TtsPostProcessorFillPattern.Create(c, img, aOwnsPatter, aPosition, aModes, aChannels); + AddReference(ltsObjTypePostProcessor, pp); + if aOwnsPatter then + DelReference(ltsObjTypeImage, img); + result := pp; + end; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorBorderCreate(const aContext: TltsContextHandle; const aWidth, aStrength: Single; const aColor: TtsColor4f; const aKeepSize: Boolean): TltsPostProcessorHandle; stdcall; +var + c: TtsContext; + pp: TtsPostProcessor; +begin + try + result := nil; + if CheckContextHandle(aContext, c) then begin + pp := TtsPostProcessorBorder.Create(c, aWidth, aStrength, aColor, aKeepSize); + AddReference(ltsObjTypePostProcessor, pp); + result := pp; + end; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorShadowCreate(const aContext: TltsContextHandle; const aRadius, aStrength: Single; const aOffset: TtsPosition; const aColor: TtsColor4f): TltsPostProcessorHandle; stdcall; +var + c: TtsContext; + pp: TtsPostProcessor; +begin + try + result := nil; + if CheckContextHandle(aContext, c) then begin + pp := TtsPostProcessorShadow.Create(c, aRadius, aStrength, aOffset, aColor); + AddReference(ltsObjTypePostProcessor, pp); + result := pp; + end; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorListCreate(const aContext: TltsContextHandle): TltsPostProcessorHandle; stdcall; +var + c: TtsContext; + pp: TtsPostProcessor; +begin + try + result := nil; + if CheckContextHandle(aContext, c) then begin + pp := TtsPostProcessorList.Create(c, false); + AddReference(ltsObjTypePostProcessor, pp); + result := pp; + end; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorListGetCount(const aHandle: TltsPostProcessorHandle): Integer; stdcall; +var + pp: TtsPostProcessorList; +begin + try + if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) + then result := pp.Count + else result := -1; + except + on ex: Exception do begin + SetLastError(ex); + result := -1; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorListGetItem(const aHandle: TltsPostProcessorHandle; const aIndex: Integer): TltsPostProcessorHandle; stdcall; +var + pp: TtsPostProcessorList; +begin + try + result := nil; + if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) then begin + if (aIndex < 0) or (aIndex >= pp.Count) + then SetLastError(ltsErrInvalidValue, 'index is out of range') + else result := pp.Items[aIndex]; + end else + result := nil; + except + on ex: Exception do begin + SetLastError(ex); + result := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorListGetOwnsObjects(const aHandle: TltsPostProcessorHandle; var aValue: Boolean): TltsErrorCode; stdcall; +var + pp: TtsPostProcessorList; +begin + try + result := ltsErrNone; + if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) + then aValue := pp.OwnsObjects + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorListSetOwnsObjects(const aHandle: TltsPostProcessorHandle; const aValue: Boolean): TltsErrorCode; stdcall; +var + pp: TtsPostProcessorList; +begin + try + result := ltsErrNone; + if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) + then pp.OwnsObjects := aValue + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorListAdd(const aHandle, aItem: TltsPostProcessorHandle): TltsErrorCode; stdcall; +var + pp, itm: TtsPostProcessorList; +begin + try + result := ltsErrNone; + if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) and + CheckPostProcessorHandle(aItem, TtsPostProcessor, itm) + then pp.Add(itm) + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorListDel(const aHandle: TltsPostProcessorHandle; const aIndex: Integer): TltsErrorCode; stdcall; +var + pp: TtsPostProcessorList; +begin + try + result := ltsErrNone; + if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) then begin + if (aIndex < 0) or (aIndex >= pp.Count) then begin + SetLastError(ltsErrInvalidValue, 'index is out of range'); + result := LastErrorCode + end + else pp.Delete(aIndex); + end else + result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorListClear(const aHandle: TltsPostProcessorHandle): TltsErrorCode; stdcall; +var + pp: TtsPostProcessorList; +begin + try + result := ltsErrNone; + if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) + then pp.ClearRanges + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorListRem(const aHandle, aItem: TltsPostProcessorHandle): Integer; stdcall; +var + pp, itm: TtsPostProcessorList; +begin + try + result := -1; + if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) and + CheckPostProcessorHandle(aItem, TtsPostProcessor, itm) + then result := pp.Remove(itm) + else result := -1; + except + on ex: Exception do begin + SetLastError(ex); + result := -1; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsPostProcessorListIndexOf(const aHandle, aItem: TltsPostProcessorHandle): Integer; stdcall; +var + pp, itm: TtsPostProcessorList; +begin + try + result := -1; + if CheckPostProcessorHandle(aHandle, TtsPostProcessorList, pp) and + CheckPostProcessorHandle(aItem, TtsPostProcessor, itm) + then result := pp.IndexOf(itm) + else result := -1; + except + on ex: Exception do begin + SetLastError(ex); + result := -1; + end; + end; +end; + +end. + diff --git a/ultsRenderer.pas b/ultsRenderer.pas new file mode 100644 index 0000000..103c891 --- /dev/null +++ b/ultsRenderer.pas @@ -0,0 +1,212 @@ +unit ultsRenderer; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + ultsTypes, + utsTextSuite, utsUtils; + +function ltsRendererCreate (const aHandle: TltsContextHandle; const aType: TltsRendererType; const aFormat: TtsFormat): 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; + +type +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TltsRendererOpenGL = class(TtsRendererOpenGL) + public + procedure DelSlave(const aSlave: TtsRefManager); override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TltsRendererOpenGLES = class(TtsRendererOpenGLES) + public + procedure DelSlave(const aSlave: TtsRefManager); override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TltsRendererOpenGL//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TltsRendererOpenGL.DelSlave(const aSlave: TtsRefManager); +begin + DelReference(aSlave); + inherited DelSlave(aSlave); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TltsRendererOpenGLES////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TltsRendererOpenGLES.DelSlave(const aSlave: TtsRefManager); +begin + DelReference(aSlave); + inherited DelSlave(aSlave); +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; + 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. + diff --git a/ultsTextBlock.pas b/ultsTextBlock.pas new file mode 100644 index 0000000..91054b3 --- /dev/null +++ b/ultsTextBlock.pas @@ -0,0 +1,460 @@ +unit ultsTextBlock; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + utsTextSuite, + ultsTypes; + +function ltsTextBlockGetRect (const aHandle: TltsTextBlockHandle; var aValue: TtsRect): TltsErrorCode; stdcall; +function ltsTextBlockGetWidth (const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; +function ltsTextBlockGetHeight (const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; +function ltsTextBlockGetFlags (const aHandle: TltsTextBlockHandle; var aValue: TtsBlockFlags): TltsErrorCode; stdcall; + +function ltsTextBlockGetTop (const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; +function ltsTextBlockGetLeft (const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; +function ltsTextBlockGetVertAlign (const aHandle: TltsTextBlockHandle; var aValue: TtsVertAlignment): TltsErrorCode; stdcall; +function ltsTextBlockGetHorzAlign (const aHandle: TltsTextBlockHandle; var aValue: TtsHorzAlignment): TltsErrorCode; stdcall; +function ltsTextBlockGetClipping (const aHandle: TltsTextBlockHandle; var aValue: TtsClipping): TltsErrorCode; stdcall; +function ltsTextBlockGetColor (const aHandle: TltsTextBlockHandle; var aValue: TtsColor4f): TltsErrorCode; stdcall; +function ltsTextBlockGetFont (const aHandle: TltsTextBlockHandle; var aValue: TltsFontHandle): TltsErrorCode; stdcall; + +function ltsTextBlockSetTop (const aHandle: TltsTextBlockHandle; const aValue: Integer): TltsErrorCode; stdcall; +function ltsTextBlockSetLeft (const aHandle: TltsTextBlockHandle; const aValue: Integer): TltsErrorCode; stdcall; +function ltsTextBlockSetVertAlign (const aHandle: TltsTextBlockHandle; const aValue: TtsVertAlignment): TltsErrorCode; stdcall; +function ltsTextBlockSetHorzAlign (const aHandle: TltsTextBlockHandle; const aValue: TtsHorzAlignment): TltsErrorCode; stdcall; +function ltsTextBlockSetClipping (const aHandle: TltsTextBlockHandle; const aValue: TtsClipping): TltsErrorCode; stdcall; +function ltsTextBlockSetColor (const aHandle: TltsTextBlockHandle; const aValue: TtsColor4f): TltsErrorCode; stdcall; +function ltsTextBlockSetFont (const aHandle: TltsTextBlockHandle; const aValue: TltsFontHandle): TltsErrorCode; stdcall; + +function ltsTextBlockGetActualHeight(const aHandle: TltsTextBlockHandle): Integer; stdcall; +function ltsTextBlockGetTextWidthA (const aHandle: TltsTextBlockHandle; const aText: PAnsiChar): Integer; stdcall; +function ltsTextBlockGetTextWidthW (const aHandle: TltsTextBlockHandle; const aText: PWideChar): Integer; stdcall; + +function ltsTextBlockTextOutA (const aHandle: TltsTextBlockHandle; const aText: PAnsiChar): TltsErrorCode; stdcall; +function ltsTextBlockTextOutW (const aHandle: TltsTextBlockHandle; const aText: PWideChar): TltsErrorCode; stdcall; + +implementation + +uses + ultsUtils; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TextBlock///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetRect(const aHandle: TltsTextBlockHandle; var aValue: TtsRect): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then aValue := b.Rect + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetWidth(const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then aValue := b.Width + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetHeight(const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then aValue := b.Height + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetFlags(const aHandle: TltsTextBlockHandle; var aValue: TtsBlockFlags): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then aValue := b.Flags + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetTop(const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then aValue := b.Top + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetLeft(const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then aValue := b.Left + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetVertAlign(const aHandle: TltsTextBlockHandle; var aValue: TtsVertAlignment): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then aValue := b.VertAlign + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetHorzAlign(const aHandle: TltsTextBlockHandle; var aValue: TtsHorzAlignment): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then aValue := b.HorzAlign + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetClipping(const aHandle: TltsTextBlockHandle; var aValue: TtsClipping): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then aValue := b.Clipping + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetColor(const aHandle: TltsTextBlockHandle; var aValue: TtsColor4f): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then aValue := b.CurrentColor + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetFont(const aHandle: TltsTextBlockHandle; var aValue: TltsFontHandle): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then aValue := b.CurrentFont + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockSetTop(const aHandle: TltsTextBlockHandle; const aValue: Integer): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then b.Top := aValue + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockSetLeft(const aHandle: TltsTextBlockHandle; const aValue: Integer): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then b.Left := aValue + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockSetVertAlign(const aHandle: TltsTextBlockHandle; const aValue: TtsVertAlignment): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then b.VertAlign := aValue + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockSetHorzAlign(const aHandle: TltsTextBlockHandle; const aValue: TtsHorzAlignment): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then b.HorzAlign := aValue + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockSetClipping(const aHandle: TltsTextBlockHandle; const aValue: TtsClipping): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then b.Clipping := aValue + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockSetColor(const aHandle: TltsTextBlockHandle; const aValue: TtsColor4f): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then b.CurrentColor := aValue + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockSetFont(const aHandle: TltsTextBlockHandle; const aValue: TltsFontHandle): TltsErrorCode; stdcall; +var + b: TtsTextBlock; + f: TtsFont; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) and CheckFontHandle(aValue, f) + then b.CurrentFont := f + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetActualHeight(const aHandle: TltsTextBlockHandle): Integer; stdcall; +var + b: TtsTextBlock; +begin + try + if CheckTextBlockHandle(aHandle, b) + then result := b.GetActualBlockHeight + else result := -1; + except + on ex: Exception do begin + SetLastError(ex); + result := -1; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetTextWidthA(const aHandle: TltsTextBlockHandle; const aText: PAnsiChar): Integer; stdcall; +var + b: TtsTextBlock; +begin + try + if CheckTextBlockHandle(aHandle, b) + then result := b.GetTextWidthA(aText) + else result := -1; + except + on ex: Exception do begin + SetLastError(ex); + result := -1; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockGetTextWidthW(const aHandle: TltsTextBlockHandle; const aText: PWideChar): Integer; stdcall; +var + b: TtsTextBlock; +begin + try + if CheckTextBlockHandle(aHandle, b) + then result := b.GetTextWidthW(aText) + else result := -1; + except + on ex: Exception do begin + SetLastError(ex); + result := -1; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockTextOutA(const aHandle: TltsTextBlockHandle; const aText: PAnsiChar): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then b.TextOutA(aText) + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ltsTextBlockTextOutW(const aHandle: TltsTextBlockHandle; const aText: PWideChar): TltsErrorCode; stdcall; +var + b: TtsTextBlock; +begin + try + result := ltsErrNone; + if CheckTextBlockHandle(aHandle, b) + then b.TextOutW(aText) + else result := LastErrorCode; + except + on ex: Exception do begin + SetLastError(ex); + result := LastErrorCode; + end; + end; +end; + +end. + diff --git a/ultsTypes.pas b/ultsTypes.pas new file mode 100644 index 0000000..ae54810 --- /dev/null +++ b/ultsTypes.pas @@ -0,0 +1,88 @@ +unit ultsTypes; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + {$Z4} + TltsErrorCode = ( + ltsErrUnknown = -1, + ltsErrNone = 0, + + // misc + ltsErrNotInitialized = 1, + ltsErrInvalidEnum = 2, + ltsErrInvalidValue = 3, + ltsErrInvalidOperation = 4, + ltsErrInvalidType = 5, + + // invalid handles + ltsErrInvalidContextHandle = 100, + ltsErrInvalidRendererHandle = 101, + ltsErrInvalidTextBlockHandle = 102, + ltsErrInvalidFontHandle = 103, + ltsErrInvalidFontCreatorHandle = 104, + ltsErrInvalidImageHandle = 105, + ltsErrInvalidPostProcHandle = 106 + ); + + {$Z4} + TltsObjectType = ( + ltsObjTypeUnknown, + ltsObjTypeContext, + ltsObjTypeRenderer, + ltsObjTypeFontCreator, + ltsObjTypeFont, + ltsObjTypeTextBlock, + ltsObjTypeImage, + ltsObjTypePostProcessor + ); + + {$Z4} + TltsRendererType = ( + ltsRendererUnknown, + ltsRendererOpenGL, + ltsRendererOpenGLES, + ltsRendererCustom + ); + + {$Z4} + TltsFontCreatorType = ( + ltsFontCreatorUnknown, + ltsFontCreatorFreeType, + ltsFontCreatorGDI, + ltsFontCreatorCustom + ); + + TltsHandle = Pointer; + TltsContextHandle = TltsHandle; + TltsRendererHandle = TltsHandle; + TltsTextBlockHandle = TltsHandle; + TltsFontCreatorHandle = TltsHandle; + TltsFontHandle = TltsHandle; + TltsPostProcessorHandle = TltsHandle; + TltsImageHandle = TltsHandle; + + TltsStreamOrigin = ( + ltsStreamOriginBegin = Integer(soBeginning), + ltsStreamOriginCurrent = Integer(soCurrent), + ltsStreamOriginEnd = Integer(soEnd) + ); + + TltsStreamFuncRead = function(const aArgs: Pointer; const aBuffer: Pointer; const aSize: Integer): Integer; stdcall; + TltsStreamFuncSeek = function(const aArgs: Pointer; const aOrigin: TltsStreamOrigin; const aPos: Integer): Integer; stdcall; + PltsStream = ^TltsStream; + TltsStream = packed record + args: Pointer; + read: TltsStreamFuncRead; + seek: TltsStreamFuncSeek; + end; + +implementation + +end. + diff --git a/ultsUtils.pas b/ultsUtils.pas new file mode 100644 index 0000000..e52796f --- /dev/null +++ b/ultsUtils.pas @@ -0,0 +1,312 @@ +unit ultsUtils; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + uutlGenerics, + ultsTypes, + utsTextSuite; + +type + TtsPostProcessorClass = class of TtsPostProcessor; + +procedure SetLastError(const aEx: Exception); +procedure SetLastError(const aErrorCode: TltsErrorCode; const aErrorMsg: String); + +function CheckIfInitialized: Boolean; +function CheckContextHandle(const aHandle: TltsContextHandle; out aContext: TtsContext): Boolean; +function CheckRendererHandle(const aHandle: TltsContextHandle; out aRenderer: TtsRenderer): Boolean; +function CheckTextBlockHandle(const aHandle: TltsTextBlockHandle; out aTextBlock: TtsTextBlock): Boolean; +function CheckFontHandle(const aHandle: TltsFontHandle; out aFont: TtsFont): Boolean; +function CheckFontCreatorHandle(const aHandle: TltsFontCreatorHandle; out aFontCreator: TtsFontCreator): Boolean; +function CheckImageHandle(const aHandle: TltsImageHandle; out aImage: TtsImage): Boolean; +function CheckPostProcessorHandle(const aHandle: TltsPostProcessorHandle; const aType: TtsPostProcessorClass; out aPostProcessor): Boolean; + +procedure AddReference(const aType: TltsObjectType; const aRef: TObject); +procedure DelReference(const aType: TltsObjectType; const aRef: TObject); +procedure DelReference(const aRef: TObject); + +function ValidateCodePage(const aValue: TtsCodePage): Boolean; +function ValidateFormat(const aValue: TtsFormat): Boolean; +function ValidateCharRangeUsage(const aValue: TtsCharRangeUsage): Boolean; + +procedure Initialize; +procedure Finalize; + +type + TltsStreamImpl = class(TStream) + private + fStream: PltsStream; + public + function Read(var Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; overload; + + constructor Create(const aStream: PltsStream); + end; + +var + LastErrorCode: TltsErrorCode = ltsErrNone; + LastErrorMsg: String; + +implementation + +type + TtsContextHashSet = specialize TutlHashSet; + TtsRendererHashSet = specialize TutlHashSet; + TtsTextBlockHashSet = specialize TutlHashSet; + TtsFontHashSet = specialize TutlHashSet; + TtsFontCreatorHashSet = specialize TutlHashSet; + TtsImageHashSet = specialize TutlHashSet; + TtsPostProcessorHashSet = specialize TutlHashSet; + +var + IsInitilized: Boolean = false; + + Contexts: TtsContextHashSet = nil; + Renderers: TtsRendererHashSet = nil; + TextBlocks: TtsTextBlockHashSet = nil; + Fonts: TtsFontHashSet = nil; + FontCreators: TtsFontCreatorHashSet = nil; + Images: TtsImageHashSet = nil; + PostProcessors: TtsPostProcessorHashSet = nil; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +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 := TtsContext(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 CheckTextBlockHandle(const aHandle: TltsTextBlockHandle; out aTextBlock: TtsTextBlock): Boolean; +begin + result := CheckIfInitialized; + if result then begin + aTextBlock := TtsTextBlock(aHandle); + result := TextBlocks.Contains(aTextBlock); + if not result then + SetLastError(ltsErrInvalidTextBlockHandle, Format('0x%.16x is no a valid text block handle', [{%H-}PtrUInt(aHandle)])); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function CheckFontHandle(const aHandle: TltsFontHandle; out aFont: TtsFont): Boolean; +begin + result := CheckIfInitialized; + if result then begin + aFont := TtsFont(aHandle); + result := Fonts.Contains(aFont); + if not result then + SetLastError(ltsErrInvalidFontHandle, Format('0x%.16x is no a valid font handle', [{%H-}PtrUInt(aHandle)])); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function CheckFontCreatorHandle(const aHandle: TltsFontCreatorHandle; out aFontCreator: TtsFontCreator): Boolean; +begin + result := CheckIfInitialized; + if result then begin + aFontCreator := TtsFontCreator(aHandle); + result := FontCreators.Contains(aFontCreator); + if not result then + SetLastError(ltsErrInvalidFontCreatorHandle, Format('0x%.16x is no a valid font creator handle', [{%H-}PtrUInt(aHandle)])); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function CheckImageHandle(const aHandle: TltsImageHandle; out aImage: TtsImage): Boolean; +begin + result := CheckIfInitialized; + if result then begin + aImage := TtsImage(aHandle); + result := Images.Contains(aImage); + if not result then + SetLastError(ltsErrInvalidImageHandle, Format('0x%.16x is no a valid image handle', [{%H-}PtrUInt(aHandle)])); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function CheckPostProcessorHandle(const aHandle: TltsPostProcessorHandle; const aType: TtsPostProcessorClass; out aPostProcessor): Boolean; +begin + result := CheckIfInitialized; + if result then begin + TtsPostProcessor(aPostProcessor) := TtsPostProcessor(aHandle); + result := PostProcessors.Contains(TtsPostProcessor(aPostProcessor)); + if not result then begin + SetLastError(ltsErrInvalidPostProcHandle, Format('0x%.16x is no a valid image handle', [{%H-}PtrUInt(aHandle)])); + exit; + end; + result := (TtsPostProcessor(aPostProcessor) is aType); + if not result then begin + SetLastError(ltsErrInvalidType, Format('0x%.16x is no a %s post processor', [{%H-}PtrUInt(aHandle), aType.ClassName])); + exit; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure AddReference(const aType: TltsObjectType; const aRef: TObject); +begin + case aType of + ltsObjTypeContext: Contexts.Add(aRef as TtsContext); + ltsObjTypeRenderer: Renderers.Add(aRef as TtsRenderer); + ltsObjTypeFont: Fonts.Add(aRef as TtsFont); + ltsObjTypeTextBlock: TextBlocks.Add(aRef as TtsTextBlock); + ltsObjTypeFontCreator: FontCreators.Add(aRef as TtsFontCreator); + ltsObjTypeImage: Images.Add(aRef as TtsImage); + ltsObjTypePostProcessor: PostProcessors.Add(aRef as TtsPostProcessor); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure DelReference(const aType: TltsObjectType; const aRef: TObject); +begin + case aType of + ltsObjTypeContext: Contexts.Remove(aRef as TtsContext); + ltsObjTypeRenderer: Renderers.Remove(aRef as TtsRenderer); + ltsObjTypeFont: Fonts.Remove(aRef as TtsFont); + ltsObjTypeTextBlock: TextBlocks.Remove(aRef as TtsTextBlock); + ltsObjTypeFontCreator: FontCreators.Remove(aRef as TtsFontCreator); + ltsObjTypeImage: Images.Remove(aRef as TtsImage); + ltsObjTypePostProcessor: PostProcessors.Remove(aRef as TtsPostProcessor); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure DelReference(const aRef: TObject); +begin + if (aRef is TtsRenderer) then + DelReference(ltsObjTypeRenderer, aRef) + else if (aRef is TtsTextBlock) then + DelReference(ltsObjTypeTextBlock, aRef) + else if (aRef is TtsFont) then + DelReference(ltsObjTypeFont, aRef) + else if (aRef is TtsContext) then + DelReference(ltsObjTypeContext, aRef) + else if (aRef is TtsFontCreator) then + DelReference(ltsObjTypeFontCreator, aRef) + else if (aRef is TtsImage) then + DelReference(ltsObjTypeImage, aRef) + else if (aRef is TtsPostProcessor) then + DelReference(ltsObjTypePostProcessor, aRef); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ValidateCodePage(const aValue: TtsCodePage): Boolean; +begin + result := (aValue >= Low(TtsCodePage)) and (aValue <= High(TtsCodePage)); + if not result then + SetLastError(ltsErrInvalidEnum, Format('%d is not a valid code page value', [aValue])); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ValidateFormat(const aValue: TtsFormat): Boolean; +begin + result := (aValue >= Low(TtsFormat)) and (aValue <= High(TtsFormat)); + if not result then + SetLastError(ltsErrInvalidEnum, Format('%d is not a valid format value', [aValue])); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function ValidateCharRangeUsage(const aValue: TtsCharRangeUsage): Boolean; +begin + result := (aValue >= Low(TtsCharRangeUsage)) and (aValue <= High(TtsCharRangeUsage)); + if not result then + SetLastError(ltsErrInvalidEnum, Format('%d is not a valid char range usage value', [aValue])); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure Initialize; +begin + Contexts := TtsContextHashSet.Create(true); + Renderers := TtsRendererHashSet.Create(false); + TextBlocks := TtsTextBlockHashSet.Create(false); + FontCreators := TtsFontCreatorHashSet.Create(false); + Fonts := TtsFontHashSet.Create(false); + Images := TtsImageHashSet.Create(false); + PostProcessors := TtsPostProcessorHashSet.Create(false); + IsInitilized := true; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure Finalize; +begin + IsInitilized := false; + FreeAndNil(PostProcessors); + FreeAndNil(Images); + FreeAndNil(TextBlocks); + FreeAndNil(Fonts); + FreeAndNil(FontCreators); + FreeAndNil(Renderers); + FreeAndNil(Contexts); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TltsStreamImpl//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TltsStreamImpl.Read(var Buffer; Count: Longint): Longint; +begin + if not Assigned(fStream) or not Assigned(fStream^.read) + then result := inherited Read(Buffer, Count) + else result := fStream^.read(fStream^.args, @buffer, Count); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TltsStreamImpl.Seek(Offset: Longint; Origin: Word): Longint; +begin + if not Assigned(fStream) or not Assigned(fStream^.seek) + then result := inherited Seek(Offset, Origin) + else result := fStream^.seek(fStream^.args, TltsStreamOrigin(Origin), Offset); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TltsStreamImpl.Create(const aStream: PltsStream); +begin + inherited Create; + fStream := aStream; +end; + +end. + diff --git a/utsTextSuite.inc b/utsTextSuite.inc new file mode 100644 index 0000000..695359f --- /dev/null +++ b/utsTextSuite.inc @@ -0,0 +1,4 @@ +{$DEFINE TS_ENABLE_OPENGL_SUPPORT} +{$DEFINE TS_ENABLE_OPENGLES_SUPPORT} +{$DEFINE TS_ENABLE_GDI_SUPPORT} +{$DEFINE TS_ENABLE_FREETYPE_SUPPORT}