opengl
/
libTextSuite
1
0
Форкнуть 0
Код Задачи 0 Pull Request'ы 0 Релизы 0 Вики Активность
Просмотр исходного кода

* implementation almost finished but not tested yet 

* updates submodule: TextSuite
master
Bergmann89 10 лет назад
Родитель
582e478693
Сommit
cb3db5ffd8
14 измененных файлов: 2780 добавлений и 376 удалений
Единый вид
Опции Diff
Показать статистику Скачать Patch файл Скачать Diff файл
  1. +1
    -1
      TextSuite
  2. +50
    -2
      libTextSuite.lpi
  3. +86
    -373
      libTextSuite.lpr
  4. +187
    -0
      ultsContext.pas
  5. +284
    -0
      ultsFont.pas
  6. +196
    -0
      ultsFontCreator.pas
  7. +64
    -0
      ultsGeneral.pas
  8. +458
    -0
      ultsImage.pas
  9. +378
    -0
      ultsPostProcessor.pas
  10. +212
    -0
      ultsRenderer.pas
  11. +460
    -0
      ultsTextBlock.pas
  12. +88
    -0
      ultsTypes.pas
  13. +312
    -0
      ultsUtils.pas
  14. +4
    -0
      utsTextSuite.inc

+ 1
- 1
TextSuite

@@ -1 +1 @@
Subproject commit 893e9166cd762b505bb8cd72ce7f999a1b5e97b3
Subproject commit 414584359b16746bee43cf52d661ee6112ee824b

+ 50
- 2
libTextSuite.lpi Просмотреть файл

@@ -31,12 +31,60 @@
<FormatVersion Value="1"/> <FormatVersion Value="1"/>
</local> </local>
</RunParams> </RunParams>
<Units Count="1">
<Units Count="11">
<Unit0> <Unit0>
<Filename Value="libTextSuite.lpr"/> <Filename Value="libTextSuite.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="libTextSuite"/>
</Unit0> </Unit0>
<Unit1>
<Filename Value="ultsUtils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ultsUtils"/>
</Unit1>
<Unit2>
<Filename Value="ultsTypes.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ultsTypes"/>
</Unit2>
<Unit3>
<Filename Value="ultsContext.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ultsContext"/>
</Unit3>
<Unit4>
<Filename Value="ultsRenderer.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ultsRenderer"/>
</Unit4>
<Unit5>
<Filename Value="ultsTextBlock.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ultsTextBlock"/>
</Unit5>
<Unit6>
<Filename Value="ultsGeneral.pas"/>
<IsPartOfProject Value="True"/>
</Unit6>
<Unit7>
<Filename Value="ultsFont.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ultsFont"/>
</Unit7>
<Unit8>
<Filename Value="ultsFontCreator.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ultsFontCreator"/>
</Unit8>
<Unit9>
<Filename Value="ultsImage.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ultsImage"/>
</Unit9>
<Unit10>
<Filename Value="ultsPostProcessor.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ultsPostProcessor"/>
</Unit10>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>


+ 86
- 373
libTextSuite.lpr Просмотреть файл

@@ -4,365 +4,8 @@ library libTextSuite;


uses uses
Classes, SysUtils, 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<TtsContext>;

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

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

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

procedure BeginRender; override;
procedure EndRender; override;

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

TtsRendererHashSet = specialize TutlHashSet<TtsRenderer>;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
exports exports
ltsContextCreate, ltsContextCreate,
ltsContextGetCodePage, ltsContextGetCodePage,
@@ -372,27 +15,97 @@ exports
ltsContextDestroy, ltsContextDestroy,


ltsRendererCreate, ltsRendererCreate,
ltsRendererBeginBlock,
ltsRendererEndBlock,
ltsRendererDestroy, 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, ltsInitialize,
ltsGetLastErrorCode, ltsGetLastErrorCode,
ltsGetLastErrorMsg, ltsGetLastErrorMsg,
ltsFinalize; 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. end.



+ 187
- 0
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.


+ 284
- 0
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.


+ 196
- 0
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.


+ 64
- 0
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.


+ 458
- 0
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.


+ 378
- 0
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.


+ 212
- 0
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.


+ 460
- 0
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.


+ 88
- 0
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.


+ 312
- 0
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<TtsContext>;
TtsRendererHashSet = specialize TutlHashSet<TtsRenderer>;
TtsTextBlockHashSet = specialize TutlHashSet<TtsTextBlock>;
TtsFontHashSet = specialize TutlHashSet<TtsFont>;
TtsFontCreatorHashSet = specialize TutlHashSet<TtsFontCreator>;
TtsImageHashSet = specialize TutlHashSet<TtsImage>;
TtsPostProcessorHashSet = specialize TutlHashSet<TtsPostProcessor>;

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.


+ 4
- 0
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}

Редактирование Предпросмотр
Загрузка…
Отмена
Сохранить