* refactored whole code

examples/Delphi/Delphi.dof

@@ -134,5 +134,6 @@ Comments=
 Count=1
 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
 [HistoryLists\hlSearchPath]
-Count=1
+Count=2
 Item0=..\utils;..\..
+Item1=..\utils;..\..;..\..\inc

examples/Delphi/uMainForm.pas

@@ -5,7 +5,7 @@ interface
 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,
   uglcContext,
-  utsTextSuite, utsRendererOpenGL, utsFontCreatorGDI, utsTypes, utsPostProcess;
+  utsTextSuite, utsTypes, utsUtils, utsConstants, utsPostProcessor;
 
 type
   TMainForm = class(TForm)
@@ -16,8 +16,9 @@ type
     fContext: TglcContext;
     ftsContext: TtsContext;
     ftsRenderer: TtsRendererOpenGL;
-    ftsCreator1: TtsFontGeneratorGDI;
-    ftsCreator2: TtsFontGeneratorGDI;
+    ftsCreator: TtsFontCreatorGDI;
+    ftsPostProcessList1: TtsPostProcessorList;
+    ftsPostProcessList2: TtsPostProcessorList;    
     ftsFont1: TtsFont;
     ftsFont2: TtsFont; 
     procedure Render;
@@ -41,7 +42,7 @@ const
 procedure TMainForm.FormCreate(Sender: TObject);
 var
   pf: TglcContextPixelFormatSettings;
-  pp: TtsPostProcessStep;
+  pp: TtsPostProcessor;
   img: TtsImage;
 
 const
@@ -59,42 +60,50 @@ begin
   ftsContext  := TtsContext.Create;
   ftsRenderer := TtsRendererOpenGL.Create(ftsContext, tsFormatRGBA8);
 
-  ftsCreator1 := TtsFontGeneratorGDI.Create(ftsContext);
-  ftsFont1    := ftsCreator1.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', ftsRenderer, 40, [], tsAANormal);
+  // Post processors
+  ftsPostProcessList1 := TtsPostProcessorList.Create(ftsContext, true);
+  ftsPostProcessList2 := TtsPostProcessorList.Create(ftsContext, true);
 
-  pp := TtsPostProcessFillColor.Create(tsColor4f(0, 0, 0, 1), TS_MODES_REPLACE_ALL, TS_CHANNELS_RGB);
-  pp.AddUsageChars(tsUsageExclude, 'Lorem');
-  ftsCreator1.AddPostProcessStep(pp);
+  pp := TtsPostProcessorFillColor.Create(ftsContext, tsColor4f(0, 0, 0, 1), TS_IMAGE_MODES_REPLACE_ALL, TS_COLOR_CHANNELS_RGB);
+  pp.AddChars(tsUsageExclude, 'Lorem');
+  ftsPostProcessList1.Add(pp);
 
-  pp := TtsPostProcessFillColor.Create(tsColor4f(1.0, 0.0, 0.0, 1.0), TS_MODES_MODULATE_ALL, TS_CHANNELS_RGB);
-  pp.AddUsageChars(tsUsageInclude, 'Lorem');
-  ftsCreator1.AddPostProcessStep(pp);
+  pp := TtsPostProcessorFillColor.Create(ftsContext, tsColor4f(1.0, 0.0, 0.0, 1.0), TS_IMAGE_MODES_MODULATE_ALL, TS_COLOR_CHANNELS_RGB);
+  pp.AddChars(tsUsageInclude, 'Lorem');
+  ftsPostProcessList1.Add(pp);
 
   img := TtsImage.Create;
   img.CreateEmpty(tsFormatAlpha8, 4, 4);
   Move(PATTER_DATA[0], img.Data^, 16);
-  pp := TtsPostProcessFillPattern.Create(img, true, 0, 0, TS_MODES_MODULATE_ALL, TS_CHANNELS_RGBA);
-  pp.AddUsageChars(tsUsageInclude, 'Lorem');
-  ftsCreator1.AddPostProcessStep(pp);
-
-  ftsCreator2 := TtsFontGeneratorGDI.Create(ftsContext);
-  ftsFont2    := ftsCreator2.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', ftsRenderer, 40, [tsStyleStrikeout], tsAANormal);
-
-  pp := TtsPostProcessFillColor.Create(tsColor4f(0, 0, 0.5, 1), TS_MODES_REPLACE_ALL, TS_CHANNELS_RGB);
-  pp.AddUsageChars(tsUsageExclude, 'e');
-  ftsCreator2.AddPostProcessStep(pp);
-
-  pp := TtsPostProcessBorder.Create(3.0, 0.5, tsColor4f(0.0, 0.5, 0.0, 1.0), true);
-  pp.AddUsageChars(tsUsageInclude, 'e');
-  ftsCreator2.AddPostProcessStep(pp);
+  pp := TtsPostProcessorFillPattern.Create(ftsContext, img, true, tsPosition(0, 0), TS_IMAGE_MODES_MODULATE_ALL, TS_COLOR_CHANNELS_RGBA);
+  pp.AddChars(tsUsageInclude, 'Lorem');
+  ftsPostProcessList2.Add(pp);
+
+  pp := TtsPostProcessorFillColor.Create(ftsContext, tsColor4f(0, 0, 0.5, 1), TS_IMAGE_MODES_REPLACE_ALL, TS_COLOR_CHANNELS_RGB);
+  pp.AddChars(tsUsageExclude, 'e');
+  ftsPostProcessList2.Add(pp);
+
+  pp := TtsPostProcessorBorder.Create(ftsContext, 3.0, 0.5, tsColor4f(0.0, 0.5, 0.0, 1.0), true);
+  pp.AddChars(tsUsageInclude, 'e');
+  ftsPostProcessList2.Add(pp);
+
+  // font creator and fonts
+  ftsCreator := TtsFontCreatorGDI.Create(ftsContext);
+
+  ftsFont1 := ftsCreator.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', 40, [], tsAANormal);
+  ftsFont1.PostProcessor := ftsPostProcessList1;
+  
+  ftsFont2 := ftsCreator.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', 40, [tsStyleStrikeout], tsAANormal);
+  ftsFont2.PostProcessor := ftsPostProcessList2;
 end;
 
 procedure TMainForm.FormDestroy(Sender: TObject);
 begin
   FreeAndNil(ftsFont2);
-  FreeAndNil(ftsCreator2);
-  FreeAndNil(ftsFont1);
-  FreeAndNil(ftsCreator1);
+  FreeAndNil(ftsFont1);  
+  FreeAndNil(ftsCreator);
+  FreeAndNil(ftsPostProcessList2);
+  FreeAndNil(ftsPostProcessList1);  
   FreeAndNil(ftsRenderer);
   FreeAndNil(ftsContext);
   FreeAndNil(fContext);

examples/Delphi/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}

examples/PostProcess/PostProcess.lpi

@@ -43,7 +43,6 @@
         <ComponentName Value="MainForm"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
-        <UnitName Value="uMainForm"/>
       </Unit1>
     </Units>
   </ProjectOptions>
@@ -54,7 +53,7 @@
       <Filename Value="PostProcess"/>
     </Target>
     <SearchPaths>
-      <IncludeFiles Value="$(ProjOutDir)"/>
+      <IncludeFiles Value="$(ProjOutDir);..\..\inc"/>
       <OtherUnitFiles Value="..\utils;..\.."/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>

examples/PostProcess/uMainForm.pas

@@ -7,7 +7,7 @@ interface
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
   uglcContext,
-  utsTextSuite, utsRendererOpenGL, utsFontCreatorGDI, utsTypes, utsPostProcess;
+  utsTextSuite, utsUtils, utsConstants;
 
 type
   TMainForm = class(TForm)
@@ -18,8 +18,9 @@ type
     fContext: TglcContext;
     ftsContext: TtsContext;
     ftsRenderer: TtsRendererOpenGL;
-    ftsCreator1: TtsFontGeneratorGDI;
-    ftsCreator2: TtsFontGeneratorGDI;
+    ftsCreator: TtsFontCreatorGDI;
+    ftsPostProcessor1: TtsPostProcessorList;
+    ftsPostProcessor2: TtsPostProcessorList;
     ftsFont1: TtsFont;
     ftsFont2: TtsFont;
     procedure Render;
@@ -43,7 +44,7 @@ const
 procedure TMainForm.FormCreate(Sender: TObject);
 var
   pf: TglcContextPixelFormatSettings;
-  pp: TtsPostProcessStep;
+  pp: TtsPostProcessor;
   img: TtsImage;
 
 const
@@ -59,44 +60,52 @@ begin
   fContext.BuildContext;
 
   ftsContext  := TtsContext.Create;
-  ftsRenderer := TtsRendererOpenGL.Create(ftsContext, tsFormatRGBA8);
+  ftsRenderer := TtsRendererOpenGL.Create(ftsContext, TtsFormat.tsFormatRGBA8);
 
-  ftsCreator1 := TtsFontGeneratorGDI.Create(ftsContext);
-  ftsFont1    := ftsCreator1.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', ftsRenderer, 40, [], tsAANormal);
+  // post processors
+  ftsPostProcessor1 := TtsPostProcessorList.Create(ftsContext, true);
+  ftsPostProcessor2 := TtsPostProcessorList.Create(ftsContext, true);
 
-  pp := TtsPostProcessFillColor.Create(tsColor4f(0, 0, 0, 1), TS_MODES_REPLACE_ALL, TS_CHANNELS_RGB);
-  pp.AddUsageChars(tsUsageExclude, 'Lorem');
-  ftsCreator1.AddPostProcessStep(pp);
+  pp := TtsPostProcessorFillColor.Create(ftsContext, tsColor4f(0, 0, 0, 1), TS_IMAGE_MODES_REPLACE_ALL, TS_COLOR_CHANNELS_RGB);
+  pp.AddChars(TtsCharRangeUsage.tsUsageExclude, 'Lorem');
+  ftsPostProcessor1.Add(pp);
 
-  pp := TtsPostProcessFillColor.Create(tsColor4f(1.0, 0.0, 0.0, 1.0), TS_MODES_MODULATE_ALL, TS_CHANNELS_RGB);
-  pp.AddUsageChars(tsUsageInclude, 'Lorem');
-  ftsCreator1.AddPostProcessStep(pp);
+  pp := TtsPostProcessorFillColor.Create(ftsContext, tsColor4f(1.0, 0.0, 0.0, 1.0), TS_IMAGE_MODES_MODULATE_ALL, TS_COLOR_CHANNELS_RGB);
+  pp.AddChars(TtsCharRangeUsage.tsUsageInclude, 'Lorem');
+  ftsPostProcessor1.Add(pp);
 
   img := TtsImage.Create;
-  img.CreateEmpty(tsFormatAlpha8, 4, 4);
+  img.CreateEmpty(TtsFormat.tsFormatAlpha8, 4, 4);
   Move(PATTER_DATA[0], img.Data^, 16);
-  pp := TtsPostProcessFillPattern.Create(img, true, 0, 0, TS_MODES_MODULATE_ALL, TS_CHANNELS_RGBA);
-  pp.AddUsageChars(tsUsageInclude, 'Lorem');
-  ftsCreator1.AddPostProcessStep(pp);
+  pp := TtsPostProcessorFillPattern.Create(ftsContext, img, true, tsPosition(0, 0), TS_IMAGE_MODES_MODULATE_ALL, TS_COLOR_CHANNELS_RGBA);
+  pp.AddChars(TtsCharRangeUsage.tsUsageInclude, 'Lorem');
+  ftsPostProcessor2.Add(pp);
 
-  ftsCreator2 := TtsFontGeneratorGDI.Create(ftsContext);
-  ftsFont2    := ftsCreator2.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', ftsRenderer, 40, [tsStyleStrikeout], tsAANormal);
+  pp := TtsPostProcessorFillColor.Create(ftsContext, tsColor4f(0, 0, 0.5, 1), TS_IMAGE_MODES_REPLACE_ALL, TS_COLOR_CHANNELS_RGB);
+  pp.AddChars(TtsCharRangeUsage.tsUsageExclude, 'e');
+  ftsPostProcessor2.Add(pp);
 
-  pp := TtsPostProcessFillColor.Create(tsColor4f(0, 0, 0.5, 1), TS_MODES_REPLACE_ALL, TS_CHANNELS_RGB);
-  pp.AddUsageChars(tsUsageExclude, 'e');
-  ftsCreator2.AddPostProcessStep(pp);
+  pp := TtsPostProcessorBorder.Create(ftsContext, 3.0, 0.5, tsColor4f(0.0, 0.5, 0.0, 1.0), true);
+  pp.AddChars(TtsCharRangeUsage.tsUsageInclude, 'e');
+  ftsPostProcessor2.Add(pp);
 
-  pp := TtsPostProcessBorder.Create(3.0, 0.5, tsColor4f(0.0, 0.5, 0.0, 1.0), true);
-  pp.AddUsageChars(tsUsageInclude, 'e');
-  ftsCreator2.AddPostProcessStep(pp);
+  // font creator and fonts
+  ftsCreator := TtsFontCreatorGDI.Create(ftsContext);
+
+  ftsFont1 := ftsCreator.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', 40, [], TtsAntiAliasing.tsAANormal);
+  ftsFont1.PostProcessor := ftsPostProcessor1;
+
+  ftsFont2 := ftsCreator.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', 40, [TtsFontStyle.tsStyleStrikeout], TtsAntiAliasing.tsAANormal);
+  ftsFont2.PostProcessor := ftsPostProcessor2;
 end;
 
 procedure TMainForm.FormDestroy(Sender: TObject);
 begin
   FreeAndNil(ftsFont2);
-  FreeAndNil(ftsCreator2);
   FreeAndNil(ftsFont1);
-  FreeAndNil(ftsCreator1);
+  FreeAndNil(ftsCreator);
+  FreeAndNil(ftsPostProcessor2);
+  FreeAndNil(ftsPostProcessor1);
   FreeAndNil(ftsRenderer);
   FreeAndNil(ftsContext);
   FreeAndNil(fContext);
@@ -127,9 +136,9 @@ begin
   glEnable(GL_BLEND);
   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 
-  block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [tsBlockFlagWordWrap]);
+  block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [TtsBlockFlag.tsBlockFlagWordWrap]);
   try
-    block.HorzAlign := tsHorzAlignJustify;
+    block.HorzAlign := TtsHorzAlignment.tsHorzAlignJustify;
     block.ChangeFont(ftsFont1);
     block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
     block.TextOutW(TEST_TEXT + sLineBreak);

examples/SimpleFreeType/SimpleFreeType.lpi

@@ -43,6 +43,7 @@
         <ComponentName Value="MainForm"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
+        <UnitName Value="uMainForm"/>
       </Unit1>
     </Units>
   </ProjectOptions>
@@ -53,7 +54,7 @@
       <Filename Value="SimpleFreeType"/>
     </Target>
     <SearchPaths>
-      <IncludeFiles Value="$(ProjOutDir)"/>
+      <IncludeFiles Value="$(ProjOutDir);..\..\inc"/>
       <OtherUnitFiles Value="..\utils;..\.."/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>

examples/SimpleFreeType/uMainForm.pas

@@ -7,7 +7,7 @@ interface
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
   uglcContext,
-  utsTextSuite, utsRendererOpenGL, utsFontCreatorFreeType, utsTypes;
+  utsTextSuite, utsUtils;
 
 type
   TMainForm = class(TForm)
@@ -18,7 +18,7 @@ type
     fContext: TglcContext;
     ftsContext: TtsContext;
     ftsRenderer: TtsRendererOpenGL;
-    ftsCreator: TtsFontGeneratorFreeType;
+    ftsCreator: TtsFontCreatorFreeType;
     ftsFont: TtsFont;
     procedure Render;
   public
@@ -47,9 +47,9 @@ begin
   fContext.BuildContext;
 
   ftsContext  := TtsContext.Create;
-  ftsRenderer := TtsRendererOpenGL.Create(ftsContext, tsFormatAlpha8);
-  ftsCreator  := TtsFontGeneratorFreeType.Create(ftsContext);
-  ftsFont     := ftsCreator.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', ftsRenderer, 20, [], tsAANormal);
+  ftsRenderer := TtsRendererOpenGL.Create(ftsContext, TtsFormat.tsFormatAlpha8);
+  ftsCreator  := TtsFontCreatorFreeType.Create(ftsContext);
+  ftsFont     := ftsCreator.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', 20, [], TtsAntiAliasing.tsAANormal);
 end;
 
 procedure TMainForm.FormDestroy(Sender: TObject);
@@ -86,9 +86,9 @@ begin
   glEnable(GL_BLEND);
   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 
-  block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [tsBlockFlagWordWrap]);
+  block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [TtsBlockFlag.tsBlockFlagWordWrap]);
   try
-    block.HorzAlign := tsHorzAlignJustify;
+    block.HorzAlign := TtsHorzAlignment.tsHorzAlignJustify;
     block.ChangeFont(ftsFont);
     block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
     block.TextOutW(TEST_TEXT);

examples/SimpleGDI/SimpleGDI.lpi

@@ -32,7 +32,7 @@
         <PackageName Value="LCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="2">
+    <Units Count="21">
       <Unit0>
         <Filename Value="SimpleGDI.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -43,7 +43,103 @@
         <ComponentName Value="MainForm"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
+        <UnitName Value="uMainForm"/>
       </Unit1>
+      <Unit2>
+        <Filename Value="..\..\utsContext.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsContext"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="..\..\utsTextSuite.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsTextSuite"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="..\..\utsUtils.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsUtils"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="..\..\utsTypes.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsTypes"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="..\..\utsRenderer.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsRenderer"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="..\..\utsTextBlock.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsTextBlock"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="..\..\utsFont.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsFont"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="..\..\utsFontCreator.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsFontCreator"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="..\..\utsChar.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsChar"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="..\..\utsImage.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsImage"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="..\..\utsConstants.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsConstants"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="..\..\utsPostProcessor.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsPostProcessor"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="..\..\utsCodePages.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsCodePages"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="..\..\utsCharCache.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsCharCache"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="..\..\utsOpenGLUtils.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsOpenGLUtils"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="..\..\utsRendererOpenGL.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsRendererOpenGL"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="..\..\utsRendererOpenGLES.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsRendererOpenGLES"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="..\..\utsFontCreatorFreeType.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsFontCreatorFreeType"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="..\..\utsFontCreatorGDI.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="utsFontCreatorGDI"/>
+      </Unit20>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -53,7 +149,7 @@
       <Filename Value="SimpleGDI"/>
     </Target>
     <SearchPaths>
-      <IncludeFiles Value="$(ProjOutDir)"/>
+      <IncludeFiles Value="$(ProjOutDir);..\..\inc"/>
       <OtherUnitFiles Value="..\utils;..\.."/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
@@ -64,6 +160,11 @@
         </Win32>
       </Options>
     </Linking>
+    <Other>
+      <CompilerMessages>
+        <IgnoredMessages idx5024="True"/>
+      </CompilerMessages>
+    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

examples/SimpleGDI/SimpleGDI.lpr

@@ -7,8 +7,7 @@ uses
   cthreads,
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, uMainForm
-  { you can add units after this };
+  Forms, uMainForm;
 
 {$R *.res}
 

examples/SimpleGDI/uMainForm.pas

@@ -6,8 +6,8 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
-  uglcContext,
-  utsTextSuite, utsRendererOpenGL, utsFontCreatorGDI, utsTypes;
+  uglcContext, utsUtils,
+  utsTextSuite;
 
 type
   TMainForm = class(TForm)
@@ -18,7 +18,7 @@ type
     fContext: TglcContext;
     ftsContext: TtsContext;
     ftsRenderer: TtsRendererOpenGL;
-    ftsCreator: TtsFontGeneratorGDI;
+    ftsCreator: TtsFontCreatorGDI;
     ftsFont: TtsFont;
     procedure Render;
   public
@@ -47,9 +47,9 @@ begin
   fContext.BuildContext;
 
   ftsContext  := TtsContext.Create;
-  ftsRenderer := TtsRendererOpenGL.Create(ftsContext, tsFormatAlpha8);
-  ftsCreator  := TtsFontGeneratorGDI.Create(ftsContext);
-  ftsFont     := ftsCreator.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', ftsRenderer, 20, [], tsAANormal);
+  ftsRenderer := TtsRendererOpenGL.Create(ftsContext, TtsFormat.tsFormatAlpha8);
+  ftsCreator  := TtsFontCreatorGDI.Create(ftsContext);
+  ftsFont     := ftsCreator.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', 20, [], TtsAntiAliasing.tsAANormal);
 end;
 
 procedure TMainForm.FormDestroy(Sender: TObject);
@@ -86,9 +86,9 @@ begin
   glEnable(GL_BLEND);
   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 
-  block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [tsBlockFlagWordWrap]);
+  block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [TtsBlockFlag.tsBlockFlagWordWrap]);
   try
-    block.HorzAlign := tsHorzAlignJustify;
+    block.HorzAlign := TtsHorzAlignment.tsHorzAlignJustify;
     block.ChangeFont(ftsFont);
     block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
     block.TextOutW(TEST_TEXT);

inc/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}

utsChar.pas

@@ -0,0 +1,37 @@
+unit utsChar;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  utsTypes;
+
+type
+  TtsChar = class(TObject)
+  private
+    fCharCode: WideChar;
+    fGlyphMetric: TtsGlyphMetric;
+  protected
+    fRenderRef: TtsRenderRef;
+  public
+    property CharCode:    WideChar       read fCharCode;
+    property RenderRef:   TtsRenderRef   read fRenderRef;
+    property GlyphMetric: TtsGlyphMetric read fGlyphMetric write fGlyphMetric;
+
+    constructor Create(const aCharCode: WideChar);
+  end;
+
+implementation
+
+constructor TtsChar.Create(const aCharCode: WideChar);
+begin
+  inherited Create;
+  fCharCode := aCharCode;
+end;
+
+end.
+

utsCharCache.pas

@@ -0,0 +1,508 @@
+unit utsCharCache;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  utsChar, utsFont, utsUtils, utsContext, utsTypes, utsImage;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsCharArray = packed record
+    Chars: array [Byte] of TtsChar;
+    Count: Byte;
+  end;
+  PtsCharArray = ^TtsCharArray;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsRenderRefGenerator = class(TtsRefManager)
+  private
+    fContext: TtsContext;
+    fFormat: TtsFormat;
+  public
+    property Context: TtsContext read fContext;
+    property Format:  TtsFormat  read fFormat;
+
+    function  CreateRenderRef(const aChar: TtsChar; const aImage: TtsImage): TtsRenderRef; virtual; abstract;
+    procedure FreeRenderRef(const aRenderRef: TtsRenderRef); virtual; abstract;
+
+    constructor Create(const aContext: TtsContext; const aFormat: TtsFormat);
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsChars = class(TObject)
+  private
+    fRenderRefGenerator: TtsRenderRefGenerator;
+    fFont: TtsFont;
+    fCanCreate: Boolean;
+    fChars: array[Byte] of PtsCharArray;
+    function GenerateChar(const aCharCode: WideChar): TtsChar;
+  public
+    function GetChar(const aCharCode: WideChar): TtsChar;
+    function AddChar(const aCharCode: WideChar): TtsChar;
+    procedure DelChar(const aCharCode: WideChar);
+    procedure AddCharRange(const aStart, aStop: WideChar);
+    procedure DelCharRange(const aStart, aStop: WideChar);
+    procedure Clear;
+  public
+    property CanCreate: Boolean read fCanCreate write fCanCreate;
+    property Char[const aCharCode: WideChar]: TtsChar read GetChar;
+
+    function GetTextWidthW(aText: PWideChar): Integer;
+    function GetTextWidthA(aText: PAnsiChar): Integer;
+
+    constructor Create(const aRenderRefGen: TtsRenderRefGenerator; const aFont: TtsFont);
+    destructor Destroy; override;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  PtsCharCacheItem = ^TtsCharCacheItem;
+  TtsCharCacheItem = packed record
+    key: TtsFont;
+    val: TtsChars;
+  end;
+
+  TtsCharCache = class(TtsRefManager)
+  private
+    fRenderRefGenerator: TtsRenderRefGenerator;
+    fItems: TList;
+    function GetChars(const aKey: TtsFont): TtsChars;
+    function Find(const aMin, aMax: Integer; const aKey: TtsFont; out aIndex: Integer): Integer;
+  protected
+    procedure DelSlave(const aSlave: TtsRefManager); override;
+  public
+    property Chars[const aKey: TtsFont]: TtsChars read GetChars;
+
+    procedure Clear;
+
+    constructor Create(const aRenderRefGen: TtsRenderRefGenerator);
+    destructor Destroy; override;
+  end;
+
+implementation
+
+uses
+  Math,
+  utsConstants;
+
+type
+  TtsWritableChar = class(TtsChar)
+  public
+    property RenderRef: TtsRenderRef read fRenderRef write fRenderRef;
+  end;
+
+
+{$IFNDEF fpc}
+  {$IFDEF WIN64}
+  PtrUInt   = System.UInt64;
+  {$ELSE}
+  PtrUInt = Cardinal;
+  {$ENDIF}
+{$ENDIF}
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsChars//////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsChars.GenerateChar(const aCharCode: WideChar): TtsChar;
+var
+  GlyphSize: TtsPosition;
+  CharImage: TtsImage;
+  m: TtsGlyphMetric;
+  c: TtsWritableChar;
+
+  procedure FillLine(aData: PByte);
+  var
+    w, i: Integer;
+    c: TtsColor4f;
+    tmp: PByte;
+  begin
+    w := CharImage.Width;
+    while (w > 0) do begin
+      tmp := aData;
+      tsFormatUnmap(CharImage.Format, tmp, c);
+      for i := 0 to 3 do
+        c.arr[i] := 1.0;
+      tsFormatMap(CharImage.Format, aData, c);
+      dec(w);
+    end;
+  end;
+
+  procedure DrawLine(aLinePosition, aLineSize: Integer);
+  var
+    ImgSize, ImgPos, Origin: TtsPosition;
+    Rect: TtsRect;
+    YOffset, y: Integer;
+  begin
+    if aLineSize <= 0 then
+      exit;
+
+    aLinePosition := aLinePosition - aLineSize;
+
+    // calculate width and height
+    ImgPos  := tsPosition(0, 0);
+    ImgSize := tsPosition(CharImage.Width, CharImage.Height);
+    Origin  := m.GlyphOrigin;
+    Rect    := m.GlyphRect;
+
+    // expand left rect border to origin
+    if (Origin.x > 0) then begin
+      dec(Rect.Left, Origin.x);
+      Origin.x := 0;
+    end;
+
+    // expand right rect border to advanced
+    if (Rect.Right - Rect.Left < m.Advance) then begin
+      Rect.Right := Rect.Left + m.Advance;
+    end;
+
+    // expand bottom rect border
+    if (Origin.y - aLinePosition > Rect.Bottom) then begin
+      Rect.Bottom := Origin.y - aLinePosition;
+    end;
+
+    // expand top rect border
+    if (Origin.y - aLinePosition - aLineSize < Rect.Top) then begin
+      Rect.Top := Origin.y - aLinePosition - aLineSize;
+      Origin.y := aLinePosition + aLineSize;
+    end;
+
+    // update image size
+    if (Rect.Right - Rect.Left > ImgSize.x) then begin
+      ImgSize.x := Rect.Right - Rect.Left;
+      ImgPos.x  := Max(-Rect.Left, 0);
+      inc(Rect.Left,  ImgPos.x);
+      inc(Rect.Right, ImgPos.x);
+    end;
+    if (Rect.Bottom - Rect.Top > ImgSize.y) then begin
+      ImgSize.y := Rect.Bottom - Rect.Top;
+      ImgPos.y  := Max(-Rect.Top, 0);
+      inc(Rect.Top,    ImgPos.y);
+      inc(Rect.Bottom, ImgPos.y);
+    end;
+    CharImage.Resize(ImgSize.x, ImgSize.y, ImgPos.x, ImgPos.y);
+
+    // draw lines
+    YOffset := Rect.Top + Origin.y - aLinePosition;
+    for y := 1 to aLineSize do
+      FillLine(CharImage.ScanLine[YOffset - y]);
+
+    // move glyph rect
+    m.GlyphOrigin := Origin;
+    m.GlyphRect   := Rect;
+  end;
+
+begin
+  result := nil;
+  if (aCharCode <> #0) and
+     (not fFont.GetGlyphMetrics(aCharCode, m.GlyphOrigin, GlyphSize, m.Advance) or
+      not ((m.GlyphOrigin.x <> 0) or
+           (m.GlyphOrigin.y <> 0) or
+           (GlyphSize.x <> 0) or
+           (GlyphSize.y <> 0) or
+           (m.Advance <> 0))) then
+        exit;
+
+  CharImage := TtsImage.Create;
+  try
+    if (aCharCode = #0) then begin
+      CharImage.CreateEmpty(fRenderRefGenerator.Format, 3, 1);
+      m.GlyphOrigin := tsPosition(0, 1);
+      m.Advance     := 1;
+    end else if (GlyphSize.x > 0) and (GlyphSize.y > 0) then
+      fFont.GetCharImage(aCharCode, CharImage, fRenderRefGenerator.Format);
+
+    if CharImage.IsEmpty and ([tsStyleUnderline, tsStyleStrikeout] * fFont.Metric.Style <> []) then begin
+      CharImage.CreateEmpty(fRenderRefGenerator.Format, max(m.Advance, 1), 1);
+      m.GlyphOrigin.y := 1;
+    end;
+
+    c := TtsWritableChar.Create(aCharCode);
+    try
+      if (aCharCode = #0)
+        then m.GlyphRect := tsRect(1, 0, 2, 1)
+        else m.GlyphRect := tsRect(0, 0, CharImage.Width, CharImage.Height);
+
+      try
+        if (tsStyleUnderline in fFont.Metric.Style) then
+          DrawLine(fFont.Metric.UnderlinePos, fFont.Metric.UnderlineSize);
+        if (tsStyleStrikeout in fFont.Metric.Style) then
+          DrawLine(fFont.Metric.StrikeoutPos, fFont.Metric.StrikeoutSize);
+      except
+        CharImage.FillColor(tsColor4f(1, 0, 0, 0), TS_COLOR_CHANNELS_RGB, TS_IMAGE_MODES_MODULATE_ALPHA);
+      end;
+
+      c.GlyphMetric := m;
+      if Assigned(fFont.PostProcessor) then
+        fFont.PostProcessor.Execute(c, CharImage);
+      c.RenderRef := fRenderRefGenerator.CreateRenderRef(c, CharImage);
+      result := c;
+    except
+      FreeAndNil(c);
+    end;
+  finally
+    FreeAndNil(CharImage);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsChars.GetChar(const aCharCode: WideChar): TtsChar;
+var
+  arr: PtsCharArray;
+begin
+  arr := fChars[(Ord(aCharCode) shr 8) and $FF];
+  if Assigned(arr) then
+    result := arr^.Chars[Ord(aCharCode) and $FF]
+  else
+    result := nil;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsChars.AddChar(const aCharCode: WideChar): TtsChar;
+var
+  h, l: Integer;
+  arr: PtsCharArray;
+begin
+  result := GetChar(aCharCode);
+  if not Assigned(result) and fCanCreate then begin
+    result := GenerateChar(aCharCode);
+    if Assigned(result) then begin
+      h := (Ord(aCharCode) shr 8) and $FF;
+      arr := fChars[h];
+      if not Assigned(arr) then begin
+        New(arr);
+        FillChar(arr^, SizeOf(arr^), 0);
+        fChars[h] := arr;
+      end;
+      l := Ord(aCharCode) and $FF;
+      arr^.Chars[l] := result;
+      inc(arr^.Count);
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsChars.DelChar(const aCharCode: WideChar);
+var
+  h, l: Integer;
+  c: TtsChar;
+  arr: PtsCharArray;
+begin
+  // find char array
+  h := (Ord(aCharCode) shr 8) and $FF;
+  arr := fChars[h];
+  if not Assigned(arr) then
+    exit;
+
+  // find char
+  l := Ord(aCharCode) and $FF;
+  c := arr^.Chars[l];
+  if not Assigned(c) then
+    exit;
+
+  // remove char
+  arr^.Chars[l] := nil;
+  dec(arr^.Count);
+  if (arr^.Count <= 0) then begin
+    fChars[h] := nil;
+    Dispose(arr);
+  end;
+
+  if Assigned(c.RenderRef) then
+    fRenderRefGenerator.FreeRenderRef(c.RenderRef);
+  FreeAndNil(c);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsChars.AddCharRange(const aStart, aStop: WideChar);
+var
+  c: WideChar;
+begin
+  for c := aStart to aStop do
+    AddChar(c);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsChars.DelCharRange(const aStart, aStop: WideChar);
+var
+  c: WideChar;
+begin
+  for c := aStart to aStop do
+    DelChar(c);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsChars.Clear;
+var
+  h, l: Integer;
+  c: TtsChar;
+  arr: PtsCharArray;
+begin
+  for h := Low(fChars) to High(fChars) do begin
+    arr := fChars[h];
+    if Assigned(arr) then begin
+      for l := Low(arr^.Chars) to High(arr^.Chars) do begin
+        c := arr^.Chars[l];
+        if Assigned(c) then begin
+          if Assigned(c.RenderRef) then
+            fRenderRefGenerator.FreeRenderRef(c.RenderRef);
+          FreeAndNil(c);
+        end;
+      end;
+      Dispose(arr);
+      fChars[h] := nil;
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsChars.GetTextWidthW(aText: PWideChar): Integer;
+var
+  c: TtsChar;
+begin
+  result := 0;
+  if not Assigned(aText) then
+    exit;
+
+  while (aText^ <> #0) do begin
+    c := AddChar(aText^);
+    if not Assigned(c) then
+      c := AddChar(fRenderRefGenerator.Context.DefaultChar);
+    if Assigned(c) then begin
+      if (result > 0) then
+        result := result + fFont.CharSpacing;
+      result := result + c.GlyphMetric.Advance;
+    end;
+    inc(aText);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsChars.GetTextWidthA(aText: PAnsiChar): Integer;
+var
+  tmp: PWideChar;
+begin
+  tmp := fRenderRefGenerator.Context.AnsiToWide(aText);
+  try
+    result := GetTextWidthW(tmp);
+  finally
+    tsStrDispose(tmp);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsChars.Create(const aRenderRefGen: TtsRenderRefGenerator; const aFont: TtsFont);
+begin
+  inherited Create;
+  fRenderRefGenerator := aRenderRefGen;
+  fFont               := aFont;
+  fCanCreate          := true;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsChars.Destroy;
+begin
+  Clear;
+  inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsRenderRefGenerator/////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsRenderRefGenerator.Create(const aContext: TtsContext; const aFormat: TtsFormat);
+begin
+  inherited Create(aContext);
+  fContext := aContext;
+  fFormat  := aFormat;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsCharCache//////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsCharCache.GetChars(const aKey: TtsFont): TtsChars;
+var
+  pos, index: Integer;
+  p: PtsCharCacheItem;
+begin
+  pos := Find(0, fItems.Count-1, aKey, index);
+  if (pos < 0) then begin
+    result := TtsChars.Create(fRenderRefGenerator, aKey);
+    aKey.AddMaster(self);
+    new(p);
+    p^.key := aKey;
+    p^.val := result;
+    fItems.Insert(index, p);
+  end else
+    result := PtsCharCacheItem(fItems[pos])^.val;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsCharCache.Find(const aMin, aMax: Integer; const aKey: TtsFont; out aIndex: Integer): Integer;
+var
+  i: Integer;
+begin
+  if (aMin <= aMax) then begin
+    i := aMin + Trunc((aMax - aMin) / 2);
+    if (aKey = PtsCharCacheItem(fItems[i])^.key) then
+      result := i
+    else if (PtrUInt(aKey) < PtrUInt(PtsCharCacheItem(fItems[i])^.key)) then
+      result := Find(aMin, i-1, aKey, aIndex)
+    else
+      result := Find(i+1, aMax, aKey, aIndex);
+  end else begin
+    result := -1;
+    aIndex := aMin;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsCharCache.DelSlave(const aSlave: TtsRefManager);
+var
+  pos, index: Integer;
+  p: PtsCharCacheItem;
+begin
+  pos := Find(0, fItems.Count-1, aSlave as TtsFont, index);
+  if (pos >= 0) then begin
+    p := PtsCharCacheItem(fItems[pos]);
+    fItems.Delete(pos);
+    FreeAndNil(p^.val);
+    Dispose(p);
+  end;
+  inherited DelSlave(aSlave);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsCharCache.Clear;
+var
+  p: PtsCharCacheItem;
+  i: Integer;
+begin
+  for i := 0 to fItems.Count-1 do begin
+    p := PtsCharCacheItem(fItems[i]);
+    FreeAndNil(p^.val);
+    Dispose(p);
+  end;
+  fItems.Clear;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsCharCache.Create(const aRenderRefGen: TtsRenderRefGenerator);
+begin
+  inherited Create(aRenderRefGen);
+  fRenderRefGenerator := aRenderRefGen;
+  fItems              := TList.Create;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsCharCache.Destroy;
+begin
+  Clear;
+  FreeAndNil(fItems);
+  inherited Destroy;
+end;
+
+end.
+

utsCodePages.pas

@@ -1,17 +1,13 @@
 unit utsCodePages;
 
 {$IFDEF FPC}
-{$mode delphi}{$H+}
+  {$mode objfpc}{$H+}
 {$ENDIF}
 
 interface
 
 uses
-  Classes, SysUtils, utsTypes;
-
-type
-  PtsCodePageValues = ^TtsCodePageValues;
-  TtsCodePageValues = array [AnsiChar] of word;
+  utsTypes;
 
 const
   CP_8859_2 : TtsCodePageValues = (
@@ -893,55 +889,6 @@ const
     $0111, $00F1, $0323, $00F3, $00F4, $01A1, $00F6, $00F7, $00F8, $00F9, $00FA, $00FB, $00FC, $01B0, $20AB, $00FF
   );
 
-const
-  ANSI_TO_WIDE_CODE_PAGE_LUT: array[TtsCodePage] of PtsCodePageValues = (
-    nil,          //tsUTF8
-    nil,          //tsISO_8859_1
-    @CP_8859_2,   //tsISO_8859_2
-    @CP_8859_3,   //tsISO_8859_3
-    @CP_8859_4,   //tsISO_8859_4
-    @CP_8859_5,   //tsISO_8859_5
-    @CP_8859_6,   //tsISO_8859_6
-    @CP_8859_7,   //tsISO_8859_7
-    @CP_8859_8,   //tsISO_8859_8
-    @CP_8859_9,   //tsISO_8859_9
-    @CP_8859_10,  //tsISO_8859_10
-    @CP_8859_11,  //tsISO_8859_11
-    @CP_8859_13,  //tsISO_8859_13
-    @CP_8859_14,  //tsISO_8859_14
-    @CP_8859_15,  //tsISO_8859_15
-    @CP_8859_16,  //tsISO_8859_16
-    @CP_037,      //tsISO_037
-    @CP_437,      //tsISO_437
-    @CP_500,      //tsISO_500
-    @CP_737,      //tsISO_737
-    @CP_775,      //tsISO_775
-    @CP_850,      //tsISO_850
-    @CP_852,      //tsISO_852
-    @CP_855,      //tsISO_855
-    @CP_857,      //tsISO_857
-    @CP_860,      //tsISO_860
-    @CP_861,      //tsISO_861
-    @CP_862,      //tsISO_862
-    @CP_863,      //tsISO_863
-    @CP_864,      //tsISO_864
-    @CP_865,      //tsISO_865
-    @CP_866,      //tsISO_866
-    @CP_869,      //tsISO_869
-    @CP_874,      //tsISO_874
-    @CP_875,      //tsISO_875
-    @CP_1026,     //tsISO_1026
-    @CP_1250,     //tsISO_1250
-    @CP_1251,     //tsISO_1251
-    @CP_1252,     //tsISO_1252
-    @CP_1253,     //tsISO_1253
-    @CP_1254,     //tsISO_1254
-    @CP_1255,     //tsISO_1255
-    @CP_1256,     //tsISO_1256
-    @CP_1257,     //tsISO_1257
-    @CP_1258      //tsISO_1258
-  );
-
 implementation
 
 end.

utsConstants.pas

@@ -0,0 +1,98 @@
+unit utsConstants;
+
+{$IFDEF FPC}
+  {$mode delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  utsTypes, utsUtils, utsCodePages;
+
+const
+  TS_IMAGE_MODE_FUNCTIONS: array[TtsImageMode] of TtsBlendValueFunc = (
+    tsBlendValueIgnore,
+    tsBlendValueReplace,
+    tsBlendValueModulate);
+
+  TS_IMAGE_MODES_REPLACE_ALL: TtsImageModes = (
+    tsModeReplace,
+    tsModeReplace,
+    tsModeReplace,
+    tsModeReplace);
+  TS_IMAGE_MODES_MODULATE_ALPHA: TtsImageModes = (
+    tsModeReplace,
+    tsModeReplace,
+    tsModeReplace,
+    tsModeModulate);
+  TS_IMAGE_MODES_MODULATE_ALL: TtsImageModes = (
+    tsModeModulate,
+    tsModeModulate,
+    tsModeModulate,
+    tsModeModulate);    
+
+  TS_COLOR_CHANNELS_RGB: TtsColorChannels = [
+    tsChannelRed,
+    tsChannelGreen,
+    tsChannelBlue];
+  TS_COLOR_CHANNELS_RGBA: TtsColorChannels = [
+    tsChannelRed,
+    tsChannelGreen,
+    tsChannelBlue,
+    tsChannelAlpha];
+
+  TS_CODE_PAGE_LUT: array[TtsCodePage] of PtsCodePageValues = (
+      nil,          //tsUTF8
+      nil,          //tsISO_8859_1
+      @CP_8859_2,   //tsISO_8859_2
+      @CP_8859_3,   //tsISO_8859_3
+      @CP_8859_4,   //tsISO_8859_4
+      @CP_8859_5,   //tsISO_8859_5
+      @CP_8859_6,   //tsISO_8859_6
+      @CP_8859_7,   //tsISO_8859_7
+      @CP_8859_8,   //tsISO_8859_8
+      @CP_8859_9,   //tsISO_8859_9
+      @CP_8859_10,  //tsISO_8859_10
+      @CP_8859_11,  //tsISO_8859_11
+      @CP_8859_13,  //tsISO_8859_13
+      @CP_8859_14,  //tsISO_8859_14
+      @CP_8859_15,  //tsISO_8859_15
+      @CP_8859_16,  //tsISO_8859_16
+      @CP_037,      //tsISO_037
+      @CP_437,      //tsISO_437
+      @CP_500,      //tsISO_500
+      @CP_737,      //tsISO_737
+      @CP_775,      //tsISO_775
+      @CP_850,      //tsISO_850
+      @CP_852,      //tsISO_852
+      @CP_855,      //tsISO_855
+      @CP_857,      //tsISO_857
+      @CP_860,      //tsISO_860
+      @CP_861,      //tsISO_861
+      @CP_862,      //tsISO_862
+      @CP_863,      //tsISO_863
+      @CP_864,      //tsISO_864
+      @CP_865,      //tsISO_865
+      @CP_866,      //tsISO_866
+      @CP_869,      //tsISO_869
+      @CP_874,      //tsISO_874
+      @CP_875,      //tsISO_875
+      @CP_1026,     //tsISO_1026
+      @CP_1250,     //tsISO_1250
+      @CP_1251,     //tsISO_1251
+      @CP_1252,     //tsISO_1252
+      @CP_1253,     //tsISO_1253
+      @CP_1254,     //tsISO_1254
+      @CP_1255,     //tsISO_1255
+      @CP_1256,     //tsISO_1256
+      @CP_1257,     //tsISO_1257
+      @CP_1258      //tsISO_1258
+    );
+
+  TS_MATRIX_IDENTITY: TtsMatrix4f = ((1, 0, 0, 0), (0, 1, 0, 0), (0, 0, 1, 0), (0, 0, 0, 1));
+
+implementation
+
+end.
+

utsContext.pas

@@ -0,0 +1,58 @@
+unit utsContext;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  utsUtils, utsTypes;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsContext = class(TtsRefManager)
+  private
+    fCodePage: TtsCodePage;
+    fDefaultChar: WideChar;
+  public
+    property CodePage:    TtsCodePage read fCodePage    write fCodePage;
+    property DefaultChar: WideChar    read fDefaultChar write fDefaultChar;
+
+    function AnsiToWide(const aText: PAnsiChar): PWideChar; overload;
+    function AnsiToWide(const aText: PAnsiChar; const aLength: Integer): PWideChar; overload;
+
+    constructor Create;
+  end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsContext////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsContext.AnsiToWide(const aText: PAnsiChar): PWideChar;
+begin
+  result := AnsiToWide(aText, Length(aText));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsContext.AnsiToWide(const aText: PAnsiChar; const aLength: Integer): PWideChar;
+begin
+  result := nil;
+  if not Assigned(aText) then
+    exit;
+  result := tsStrAlloc(aLength);
+  tsAnsiToWide(result, aLength, aText, fCodePage, fDefaultChar);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsContext.Create;
+begin
+  inherited Create(nil);
+  fCodePage    := tsUTF8;
+  fDefaultChar := '?';
+end;
+
+end.
+

utsFont.pas

@@ -0,0 +1,65 @@
+unit utsFont;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  utsUtils, utsFontCreator, utsTypes, utsPostProcessor, utsImage;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsFont = class(TtsMultiMasterRefManager)
+  private
+    fCreator: TtsFontCreator;
+    fMetric: TtsFontMetric;
+    fPostProcessor: TtsPostProcessor;
+
+    fTabWidth: Integer;
+    fCharSpacing: Integer;
+    fLineSpacing: Single;
+  protected
+    {%H-}constructor Create(const aCreator: TtsFontCreator; const aMetric: TtsFontMetric);
+  public
+    property Creator:       TtsFontCreator   read fCreator;
+    property Metric:        TtsFontMetric    read fMetric;
+    property PostProcessor: TtsPostProcessor read fPostProcessor write fPostProcessor;
+
+    property TabWidth:    Integer read fTabWidth    write fTabWidth;
+    property CharSpacing: Integer read fCharSpacing write fCharSpacing;
+    property LineSpacing: Single  read fLineSpacing write fLineSpacing;
+
+    procedure GetTextMetric(out aMetric: TtsTextMetric);
+    procedure GetCharImage(const aCharCode: WideChar; const aCharImage: TtsImage; const aFormat: TtsFormat); virtual; abstract;
+    function GetGlyphMetrics(const aCharCode: WideChar; out aGlyphOrigin, aGlyphSize: TtsPosition; out aAdvance: Integer): Boolean; virtual; abstract;
+  end;
+
+implementation
+
+///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsFont//////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsFont.Create(const aCreator: TtsFontCreator; const aMetric: TtsFontMetric);
+begin
+  inherited Create(aCreator);
+  fCreator := aCreator;
+  fMetric  := aMetric;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsFont.GetTextMetric(out aMetric: TtsTextMetric);
+begin
+  aMetric.Ascent            := fMetric.Ascent;
+  aMetric.Descent           := fMetric.Descent;
+  aMetric.ExternalLeading   := fMetric.ExternalLeading;
+  aMetric.BaseLineOffset    := fMetric.BaseLineOffset;
+  aMetric.CharSpacing       := CharSpacing;
+  aMetric.LineHeight        := fMetric.Ascent + fMetric.Descent + fMetric.ExternalLeading;
+  aMetric.LineSpacing       := Trunc(fMetric.Size * fLineSpacing);
+end;
+
+end.
+

utsFontCreator.pas

@@ -0,0 +1,36 @@
+unit utsFontCreator;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  utsUtils, utsContext;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsFontCreator = class(TtsRefManager)
+  private
+    fContext: TtsContext;
+  public
+    property Context: TtsContext read fContext;
+
+    constructor Create(const aContext: TtsContext);
+  end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsFontCreator////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsFontCreator.Create(const aContext: TtsContext);
+begin
+  inherited Create(aContext);
+  fContext := aContext;
+end;
+
+end.
+

utsFontCreatorFreeType.pas

@@ -1,14 +1,14 @@
 unit utsFontCreatorFreeType;
 
 {$IFDEF FPC}
-{$mode delphi}{$H+}
+  {$mode objfpc}{$H+}
 {$ENDIF}
 
 interface
 
 uses
   Classes, SysUtils,
-  utsTextSuite, utsTypes, utsFreeType;
+  utsFreeType, utsFontCreator, utsFont, utsTypes, utsImage, utsContext;
 
 type
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -24,31 +24,25 @@ type
   TtsFontFreeType = class(TtsFont)
   private
     fHandle: TtsFreeTypeFaceHandle;
+  protected
+    {%H-}constructor Create(const aHandle: TtsFreeTypeFaceHandle; const aCreator: TtsFontCreator; const aMetric: TtsFontMetric);
   public
-    constructor Create(const aHandle: TtsFreeTypeFaceHandle; const aRenderer: TtsRenderer;
-      const aGenerator: TtsFontGenerator; const aProperties: TtsFontProperties);
+    procedure GetCharImage(const aCharCode: WideChar; const aCharImage: TtsImage; const aFormat: TtsFormat); override;
+    function GetGlyphMetrics(const aCharCode: WideChar; out aGlyphOrigin, aGlyphSize: TtsPosition; out aAdvance: Integer): Boolean; override;
+
     destructor Destroy; override;
   end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TtsFontGeneratorFreeType = class(TtsFontGenerator)
+  TtsFontCreatorFreeType = class(TtsFontCreator)
   private
     fHandle: FT_Library;
 
-    function ConvertFont(const aFont: TtsFont): TtsFontFreeType;
-    procedure LoadNames(const aFace: FT_Face; var aProperties: TtsFontProperties);
-    function CreateFont(const aFace: FT_Face; const aRenderer: TtsRenderer; const aSize: Integer;
-      const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
-  protected
-    function GetGlyphMetrics(const aFont: TtsFont; const aCharCode: WideChar;
-      out aGlyphOrigin, aGlyphSize: TtsPosition; out aAdvance: Integer): Boolean; override;
-    procedure GetCharImage(const aFont: TtsFont; const aCharCode: WideChar;
-      const aCharImage: TtsImage); override;
+    procedure LoadNames(const aFace: FT_Face; var aMetric: TtsFontMetric);
+    function CreateFont(const aFace: FT_Face; const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
   public
-    function GetFontByFile(const aFilename: String; const aRenderer: TtsRenderer; const aSize: Integer;
-      const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont; overload;
-    function GetFontByStream(const aStream: TStream;  const aRenderer: TtsRenderer; const aSize: Integer;
-      const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont; overload;
+    function GetFontByFile(const aFilename: String; const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont; overload;
+    function GetFontByStream(const aStream: TStream; const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont; overload;
 
     constructor Create(const aContext: TtsContext);
     destructor Destroy; override;
@@ -57,7 +51,8 @@ type
 implementation
 
 uses
-  utsUtils, math;
+  Math,
+  utsUtils;
 
 const
   FT_SIZE_FACTOR  = 64;
@@ -82,32 +77,150 @@ end;
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 //TtsFontFreeType///////////////////////////////////////////////////////////////////////////////////////////////////////
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TtsFontFreeType.Create(const aHandle: TtsFreeTypeFaceHandle; const aRenderer: TtsRenderer;
-  const aGenerator: TtsFontGenerator; const aProperties: TtsFontProperties);
+constructor TtsFontFreeType.Create(const aHandle: TtsFreeTypeFaceHandle; const aCreator: TtsFontCreator; const aMetric: TtsFontMetric);
 begin
-  inherited Create(aRenderer, aGenerator, aProperties);
+  inherited Create(aCreator, aMetric);
   fHandle := aHandle;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TtsFontFreeType.Destroy;
+procedure TtsFontFreeType.GetCharImage(const aCharCode: WideChar; const aCharImage: TtsImage; const aFormat: TtsFormat);
+var
+  err: FT_Error;
+  g: FT_GlyphSlot;
+  b: PFT_Bitmap;
+
+  procedure CopyGray;
+  var
+    x, y: Integer;
+    src, dst: PByte;
+    c: TtsColor4f;
+  begin
+    aCharImage.CreateEmpty(aFormat, b^.width, b^.rows);
+    c := tsColor4f(1, 1, 1, 1);
+    for y := 0 to b^.rows-1 do begin
+      src := b^.buffer;
+      inc(src, y * b^.pitch);
+      dst := aCharImage.Scanline[y];
+      for x := 0 to b^.width-1 do begin
+        c.a := src^ / $FF;
+        inc(src, 1);
+        tsFormatMap(aCharImage.Format, dst, c);
+      end;
+    end;
+  end;
+
+  procedure CopyMono;
+  var
+    x, y, i, cnt: Integer;
+    src, dst: PByte;
+    tmp: Byte;
+    c: TtsColor4f;
+  begin
+    aCharImage.CreateEmpty(aFormat, b^.width, b^.rows);
+    c := tsColor4f(1, 1, 1, 1);
+    for y := 0 to b^.rows-1 do begin
+      src := b^.buffer;
+      inc(src, y * b^.pitch);
+      dst := aCharImage.Scanline[y];
+      x := b^.width;
+      while (x > 0) do begin
+        cnt := min(8, x);
+        tmp := src^;
+        inc(src, 1);
+        for i := 1 to cnt do begin
+          if ((tmp and $80) > 0) then
+            c.a := 1.0
+          else
+            c.a := 0.0;
+          tmp := (tmp and not $80) shl 1;
+          tsFormatMap(aCharImage.Format, dst, c);
+        end;
+        dec(x, cnt);
+      end;
+    end;
+  end;
+
 begin
-  FreeAndNil(fHandle);
-  inherited Destroy;
+  g := fHandle.fFace^.glyph;
+
+  if not (Metric.AntiAliasing in [tsAANormal, tsAANone]) then
+    raise Exception.Create('unknown anti aliasing');
+  case Metric.AntiAliasing of
+    tsAANormal:
+      err := FT_Load_Char(fHandle.fFace, Ord(aCharCode), FT_LOAD_DEFAULT or FT_LOAD_RENDER);
+    tsAANone:
+      err := FT_Load_Char(fHandle.fFace, Ord(aCharCode), FT_LOAD_MONOCHROME or FT_LOAD_TARGET_MONO or FT_LOAD_RENDER);
+  else
+    exit;
+  end;
+  if (err <> 0) then
+    raise EtsException.Create('unable to set glyph metrix: error=' + IntToStr(err));
+  if (g^.format <> FT_GLYPH_FORMAT_BITMAP) then
+    raise EtsException.Create('invalid glyph format');
+
+  b := @g^.bitmap;
+  case b^.pixel_mode of
+    FT_PIXEL_MODE_MONO:
+      CopyMono;
+    FT_PIXEL_MODE_GRAY:
+      CopyGray;
+  else
+    raise EtsException.Create('unknown glyph bitmap format');
+  end;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TtsFontGeneratorFreeType//////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontFreeType.GetGlyphMetrics(const aCharCode: WideChar; out aGlyphOrigin, aGlyphSize: TtsPosition; out aAdvance: Integer): Boolean;
+var
+  err: FT_Error;
+begin
+  result := false;
+
+  aGlyphOrigin.x := 0;
+  aGlyphOrigin.x := 0;
+  aGlyphSize.x   := 0;
+  aGlyphSize.y   := 0;
+  aAdvance       := 0;
+
+  case Metric.AntiAliasing of
+    tsAANormal:
+      err := FT_Load_Char(fHandle.fFace, Ord(aCharCode), FT_LOAD_DEFAULT);
+    tsAANone:
+      err := FT_Load_Char(fHandle.fFace, Ord(aCharCode), FT_LOAD_MONOCHROME);
+  else
+    raise EtsException.Create('unknown anti aliasing');
+  end;
+  case err of
+    FT_ERR_None:
+      { nop };
+    FT_ERR_Invalid_Character_Code:
+      exit;
+  else
+    raise EtsException.Create('unable to set glyph metrix: error=' + IntToStr(err));
+  end;
+
+  result := true;
+  with fHandle.fFace^.glyph^.metrics do begin
+    aAdvance        := horiAdvance  div FT_SIZE_FACTOR;
+    aGlyphOrigin.x  := horiBearingX div FT_SIZE_FACTOR;
+    aGlyphOrigin.y  := horiBearingY div FT_SIZE_FACTOR;
+    aGlyphSize.x    := width        div FT_SIZE_FACTOR;
+    aGlyphSize.y    := height       div FT_SIZE_FACTOR;
+  end;
+end;
+
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TtsFontGeneratorFreeType.ConvertFont(const aFont: TtsFont): TtsFontFreeType;
+destructor TtsFontFreeType.Destroy;
 begin
-  if not (aFont is TtsFontFreeType) then
-    raise EtsException.Create('aFont need to be a TtsFontGDI object');
-  result := (aFont as TtsFontFreeType);
+  FreeAndNil(fHandle);
+  inherited Destroy;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsFontGeneratorFreeType.LoadNames(const aFace: FT_Face; var aProperties: TtsFontProperties);
+//TtsFontCreatorFreeType//////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsFontCreatorFreeType.LoadNames(const aFace: FT_Face; var aMetric: TtsFontMetric);
 var
   i, cnt: FT_Int;
   err: FT_Error;
@@ -162,26 +275,26 @@ begin
 
     case name.name_id of
       TT_NAME_ID_COPYRIGHT:
-        if (aProperties.Copyright = '') then
-          aProperties.Copyright := Decode;
+        if (aMetric.Copyright = '') then
+          aMetric.Copyright := Decode;
 
       TT_NAME_ID_FONT_FAMILY:
-        if (aProperties.Fontname = '') then
-          aProperties.Fontname := Decode;
+        if (aMetric.Fontname = '') then
+          aMetric.Fontname := Decode;
 
       TT_NAME_ID_FULL_NAME:
-        if (aProperties.FullName = '') then
-          aProperties.FullName := Decode;
+        if (aMetric.FullName = '') then
+          aMetric.FullName := Decode;
     end;
   end;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TtsFontGeneratorFreeType.CreateFont(const aFace: FT_Face; const aRenderer: TtsRenderer; const aSize: Integer;
-  const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
+function TtsFontCreatorFreeType.CreateFont(const aFace: FT_Face; const aSize: Integer; const aStyle: TtsFontStyles;
+  const aAntiAliasing: TtsAntiAliasing): TtsFont;
 var
   err: FT_Error;
-  prop: TtsFontProperties;
+  metric: TtsFontMetric;
   os2: PTT_OS2;
   hz: PTT_HoriHeader;
 begin
@@ -189,173 +302,45 @@ begin
   if (err <> 0) then
     raise EtsException.Create('unable to set char size: error=' + IntToStr(err));
 
-  FillByte(prop{%H-}, SizeOf(prop), 0);
-  prop.AntiAliasing := tsAANormal;
-  prop.FaceName     := aFace^.family_name;
-  prop.StyleName    := aFace^.style_name;
-  LoadNames(aFace, prop);
+  FillChar(metric{%H-}, SizeOf(metric), #0);
+  metric.AntiAliasing := tsAANormal;
+  metric.FaceName     := String(aFace^.family_name);
+  metric.StyleName    := String(aFace^.style_name);
+  LoadNames(aFace, metric);
 
-  prop.Size         := aSize;
-  prop.AntiAliasing := aAntiAliasing;
-  prop.DefaultChar  := '?';
-  prop.Style        := aStyle + [tsStyleBold, tsStyleItalic];
+  metric.Size         := aSize;
+  metric.AntiAliasing := aAntiAliasing;
+  metric.DefaultChar  := '?';
+  metric.Style        := aStyle + [tsStyleBold, tsStyleItalic];
   if ((aFace^.style_flags and FT_STYLE_FLAG_BOLD) = 0) then
-    Exclude(prop.Style, tsStyleBold);
+    Exclude(metric.Style, tsStyleBold);
   if ((aFace^.style_flags and FT_STYLE_FLAG_ITALIC) = 0) then
-    Exclude(prop.Style, tsStyleItalic);
+    Exclude(metric.Style, tsStyleItalic);
 
-  prop.Ascent           :=  aFace^.size^.metrics.ascender  div FT_SIZE_FACTOR;
-  prop.Descent          := -aFace^.size^.metrics.descender div FT_SIZE_FACTOR;
-  prop.ExternalLeading  := 0;
-  prop.BaseLineOffset   := 0;
+  metric.Ascent           :=  aFace^.size^.metrics.ascender  div FT_SIZE_FACTOR;
+  metric.Descent          := -aFace^.size^.metrics.descender div FT_SIZE_FACTOR;
+  metric.ExternalLeading  := 0;
+  metric.BaseLineOffset   := 0;
 
-  prop.UnderlinePos  := aFace^.underline_position  div FT_SIZE_FACTOR;
-  prop.UnderlineSize := aFace^.underline_thickness div FT_SIZE_FACTOR;
+  metric.UnderlinePos  := aFace^.underline_position  div FT_SIZE_FACTOR;
+  metric.UnderlineSize := aFace^.underline_thickness div FT_SIZE_FACTOR;
 
   os2 := PTT_OS2(FT_Get_Sfnt_Table(aFace, FT_SFNT_OS2));
   if Assigned(os2) and (os2^.version <> $FFFF) then begin
-    prop.StrikeoutPos  := os2^.yStrikeoutPosition div FT_SIZE_FACTOR;
-    prop.StrikeoutSize := os2^.yStrikeoutSize     div FT_SIZE_FACTOR;
+    metric.StrikeoutPos  := os2^.yStrikeoutPosition div FT_SIZE_FACTOR;
+    metric.StrikeoutSize := os2^.yStrikeoutSize     div FT_SIZE_FACTOR;
   end;
 
   hz := PTT_HoriHeader(FT_Get_Sfnt_Table(aFace, FT_SFNT_HHEA));
   if Assigned(hz) then begin
-    prop.ExternalLeading := hz^.Line_Gap div FT_SIZE_FACTOR;
-  end;
-
-  result := TtsFontFreeType.Create(TtsFreeTypeFaceHandle.Create(aFace), aRenderer, self, prop);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TtsFontGeneratorFreeType.GetGlyphMetrics(const aFont: TtsFont; const aCharCode: WideChar; out aGlyphOrigin, aGlyphSize: TtsPosition; out aAdvance: Integer): Boolean;
-var
-  font: TtsFontFreeType;
-  err: FT_Error;
-begin
-  result := false;
-
-  aGlyphOrigin.x := 0;
-  aGlyphOrigin.x := 0;
-  aGlyphSize.x   := 0;
-  aGlyphSize.y   := 0;
-  aAdvance       := 0;
-
-  font := ConvertFont(aFont);
-  case font.Properties.AntiAliasing of
-    tsAANormal:
-      err := FT_Load_Char(font.fHandle.fFace, Ord(aCharCode), FT_LOAD_DEFAULT);
-    tsAANone:
-      err := FT_Load_Char(font.fHandle.fFace, Ord(aCharCode), FT_LOAD_MONOCHROME);
-  else
-    raise EtsException.Create('unknown anti aliasing');
-  end;
-  case err of
-    FT_ERR_None:
-      { nop };
-    FT_ERR_Invalid_Character_Code:
-      exit;
-  else
-    raise EtsException.Create('unable to set glyph metrix: error=' + IntToStr(err));
-  end;
-
-  result := true;
-  with font.fHandle.fFace^.glyph^.metrics do begin
-    aAdvance        := horiAdvance  div FT_SIZE_FACTOR;
-    aGlyphOrigin.x  := horiBearingX div FT_SIZE_FACTOR;
-    aGlyphOrigin.y  := horiBearingY div FT_SIZE_FACTOR;
-    aGlyphSize.x    := width        div FT_SIZE_FACTOR;
-    aGlyphSize.y    := height       div FT_SIZE_FACTOR;
+    metric.ExternalLeading := hz^.Line_Gap div FT_SIZE_FACTOR;
   end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsFontGeneratorFreeType.GetCharImage(const aFont: TtsFont; const aCharCode: WideChar; const aCharImage: TtsImage);
-var
-  font: TtsFontFreeType;
-  err: FT_Error;
-  g: FT_GlyphSlot;
-  b: PFT_Bitmap;
 
-  procedure CopyGray;
-  var
-    x, y: Integer;
-    src, dst: PByte;
-    c: TtsColor4f;
-  begin
-    aCharImage.CreateEmpty(font.Renderer.Format, b^.width, b^.rows);
-    c := tsColor4f(1, 1, 1, 1);
-    for y := 0 to b^.rows-1 do begin
-      src := b^.buffer + y * b^.pitch;
-      dst := aCharImage.Scanline[y];
-      for x := 0 to b^.width-1 do begin
-        c.a := src^ / $FF;
-        inc(src, 1);
-        tsFormatMap(aCharImage.Format, dst, c);
-      end;
-    end;
-  end;
-
-  procedure CopyMono;
-  var
-    x, y, i, cnt: Integer;
-    src, dst: PByte;
-    tmp: Byte;
-    c: TtsColor4f;
-  begin
-    aCharImage.CreateEmpty(font.Renderer.Format, b^.width, b^.rows);
-    c := tsColor4f(1, 1, 1, 1);
-    for y := 0 to b^.rows-1 do begin
-      src := b^.buffer + y * b^.pitch;
-      dst := aCharImage.Scanline[y];
-      x := b^.width;
-      while (x > 0) do begin
-        cnt := min(8, x);
-        tmp := src^;
-        inc(src, 1);
-        for i := 1 to cnt do begin
-          if ((tmp and $80) > 0) then
-            c.a := 1.0
-          else
-            c.a := 0.0;
-          tmp := (tmp and not $80) shl 1;
-          tsFormatMap(aCharImage.Format, dst, c);
-        end;
-        dec(x, cnt);
-      end;
-    end;
-  end;
-
-begin
-  font := ConvertFont(aFont);
-  g := font.fHandle.fFace^.glyph;
-
-  if not (font.Properties.AntiAliasing in [tsAANormal, tsAANone]) then
-    raise Exception.Create('unknown anti aliasing');
-  case font.Properties.AntiAliasing of
-    tsAANormal:
-      err := FT_Load_Char(font.fHandle.fFace, Ord(aCharCode), FT_LOAD_DEFAULT or FT_LOAD_RENDER);
-    tsAANone:
-      err := FT_Load_Char(font.fHandle.fFace, Ord(aCharCode), FT_LOAD_MONOCHROME or FT_LOAD_TARGET_MONO or FT_LOAD_RENDER);
-  end;
-  if (err <> 0) then
-    raise EtsException.Create('unable to set glyph metrix: error=' + IntToStr(err));
-  if (g^.format <> FT_GLYPH_FORMAT_BITMAP) then
-    raise EtsException.Create('invalid glyph format');
-
-  b := @g^.bitmap;
-  case b^.pixel_mode of
-    FT_PIXEL_MODE_MONO:
-      CopyMono;
-    FT_PIXEL_MODE_GRAY:
-      CopyGray;
-  else
-    raise EtsException.Create('unknown glyph bitmap format');
-  end;
+  result := TtsFontFreeType.Create(TtsFreeTypeFaceHandle.Create(aFace), self, metric);
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TtsFontGeneratorFreeType.GetFontByFile(const aFilename: String; const aRenderer: TtsRenderer;
-  const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
+function TtsFontCreatorFreeType.GetFontByFile(const aFilename: String; const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
 var
   face: FT_Face;
   err: FT_Error;
@@ -363,20 +348,22 @@ begin
   err := FT_New_Face(fHandle, PAnsiChar(aFilename), 0, @face);
   if (err <> 0) then
     raise EtsException.Create('unable to create free type face from file: ' + aFilename + ' error=' + IntToStr(err));
-  result := CreateFont(face, aRenderer, aSize, aStyle, aAntiAliasing);
+  result := CreateFont(face, aSize, aStyle, aAntiAliasing);
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TtsFontGeneratorFreeType.GetFontByStream(const aStream: TStream; const aRenderer: TtsRenderer;
-  const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
+function TtsFontCreatorFreeType.GetFontByStream(const aStream: TStream; const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
 var
   face: FT_Face;
   err: FT_Error;
   ms: TMemoryStream;
+  p: PBYte;
 begin
   if (aStream is TMemoryStream) then begin
     ms := (aStream as TMemoryStream);
-    err := FT_New_Memory_Face(fHandle, PByte(ms.Memory) + ms.Position, ms.Size - ms.Position, 0, @face);
+    p := ms.Memory;
+    inc(p, ms.Position);
+    err := FT_New_Memory_Face(fHandle, p, ms.Size - ms.Position, 0, @face);
   end else begin
     ms := TMemoryStream.Create;
     try
@@ -388,18 +375,18 @@ begin
   end;
   if (err <> 0) then
     raise EtsException.Create('unable to create free type face from stream: error=' + IntToStr(err));
-  result := CreateFont(face, aRenderer, aSize, aStyle, aAntiAliasing);
+  result := CreateFont(face, aSize, aStyle, aAntiAliasing);
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TtsFontGeneratorFreeType.Create(const aContext: TtsContext);
+constructor TtsFontCreatorFreeType.Create(const aContext: TtsContext);
 begin
   inherited Create(aContext);
   fHandle := InitFreeType;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TtsFontGeneratorFreeType.Destroy;
+destructor TtsFontCreatorFreeType.Destroy;
 begin
   inherited Destroy;  // first call interited
   QuitFreeType;       // QuitFreeType will free callpacks

utsFreeType.pas

@@ -1,13 +1,14 @@
 unit utsFreeType;
 
 {$IFDEF FPC}
-{$mode delphi}{$H+}
+  {$mode delphi}{$H+}
 {$ENDIF}
 
 interface
 
 uses
-  Classes, SysUtils, syncobjs, dynlibs, utsTextSuite;
+  Classes, SysUtils, syncobjs, {$IFDEF FPC}dynlibs,{$ELSE}windows,{$ENDIF}
+  utsUtils;
 
 type
   // Simple Types
@@ -598,6 +599,16 @@ procedure QuitFreeType;
 
 implementation
 
+{$IFNDEF FPC}
+type
+  TLibHandle = HMODULE;
+
+  function GetLastOSError: Cardinal;
+  begin
+    result := GetLastError;
+  end;
+{$ENDIF}
+
 {$IFDEF WINDOWS}
   {$IFDEF WIN32}
     {$DEFINE TS_FT_WIN32}
@@ -631,7 +642,7 @@ function InitFreeType: FT_Library;
 
   function GetProcAddr(const aName: String): Pointer;
   begin
-    result := GetProcAddress(FreeTypeLibHandle, aName);
+    result := GetProcAddress(FreeTypeLibHandle, PAnsiChar(aName));
     if not Assigned(result) then
       raise EtsException.Create('unable to load procedure from library: ' + aName);
   end;

utsGDI.pas

@@ -225,7 +225,7 @@ procedure QuitGDI;
 implementation
 
 uses
-  utsTextSuite;
+  utsUtils;
 
 const
   LIB_GDI32    = 'gdi32.dll';

utsImage.pas

@@ -0,0 +1,437 @@
+unit utsImage;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  utsTypes, utsUtils;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsImage = class;
+  TtsImageFunc = procedure(const aImage: TtsImage; X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer);
+  TtsImage = class(TObject)
+  private
+    fWidth: Integer;
+    fHeight: Integer;
+    fDataSize: Integer;
+    fLineSize: Integer;
+    fFormat: TtsFormat;
+
+    fData: Pointer;
+    fHasScanlines: Boolean;
+    fScanlines: array of Pointer;
+
+    function GetScanline(const aIndex: Integer): Pointer;
+    function GetIsEmpty: Boolean;
+    procedure UpdateScanlines;
+    procedure SetData(
+      const aData: Pointer;
+      const aFormat: TtsFormat = tsFormatEmpty;
+      const aWidth: Integer = 0;
+      const aHeight: Integer = 0;
+      const aLineSize: Integer = 0;
+      const aDataSize: Integer = 0);
+  public
+    property IsEmpty:  Boolean   read GetIsEmpty;
+    property Width:    Integer   read fWidth;
+    property Height:   Integer   read fHeight;
+    property LineSize: Integer   read fLineSize;
+    property DataSize: Integer   read fDataSize;
+    property Format:   TtsFormat read fFormat;
+    property Data:     Pointer   read fData;
+    property Scanline[const aIndex: Integer]: Pointer read GetScanline;
+
+    function GetPixelAt(const x, y: Integer; out aColor: TtsColor4f): Boolean;
+
+    procedure Assign(const aImage: TtsImage);
+    procedure CreateEmpty(const aFormat: TtsFormat; const aWidth, aHeight: Integer);
+    procedure LoadFromFunc(const aFunc: TtsImageFunc; const aArgs: Pointer);
+
+    procedure Resize(const aNewWidth, aNewHeight, X, Y: Integer);
+    procedure FindMinMax(out aRect: TtsRect);
+
+    procedure FillColor(const aColor: TtsColor4f; const aChannelMask: TtsColorChannels; const aModes: TtsImageModes);
+    procedure FillPattern(const aPattern: TtsImage; X, Y: Integer; const aChannelMask: TtsColorChannels; const aModes: TtsImageModes);
+    procedure Blend(const aImage: TtsImage; const X, Y: Integer; const aFunc: TtsBlendColorFunc);
+    procedure Blur(const aHorzKernel, aVertKernel: TtsKernel1D; const aChannelMask: TtsColorChannels);
+
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+implementation
+
+uses
+  Math,
+  utsConstants;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsImage//////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsImage.GetScanline(const aIndex: Integer): Pointer;
+begin
+  if not fHasScanlines then
+    UpdateScanlines;
+
+  if fHasScanlines and (aIndex >= 0) and (aIndex <= High(fScanlines)) then
+    result := fScanlines[aIndex]
+  else
+    result := nil;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsImage.GetIsEmpty: Boolean;
+begin
+  result := not Assigned(fData);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsImage.UpdateScanlines;
+var
+  i: Integer;
+  tmp: PByte;
+begin
+  SetLength(fScanlines, fHeight);
+  for i := 0 to fHeight-1 do begin
+    tmp := fData;
+    inc(tmp, i * fLineSize);
+    fScanlines[i] := tmp;
+  end;
+  fHasScanlines := true;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsImage.SetData(const aData: Pointer; const aFormat: TtsFormat;
+  const aWidth: Integer; const aHeight: Integer;
+  const aLineSize: Integer; const aDataSize: Integer);
+begin
+  fHasScanlines := false;
+  if Assigned(fData) then
+    FreeMemory(fData);
+
+  fData := aData;
+  if Assigned(fData) then begin
+    fWidth    := aWidth;
+    fHeight   := aHeight;
+    fFormat   := aFormat;
+    fLineSize := aLineSize;
+    fDataSize := aDataSize;
+  end else begin
+    fWidth    := 0;
+    fHeight   := 0;
+    fLineSize := 0;
+    fDataSize := 0;
+    fFormat   := tsFormatEmpty;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsImage.GetPixelAt(const x, y: Integer; out aColor: TtsColor4f): Boolean;
+var
+  p: PByte;
+begin
+  result := (x >= 0) and (x < Width) and (y >= 0) and (y < Height);
+  if result then begin
+    p := Scanline[y];
+    inc(p, x * tsFormatSize(Format));
+    tsFormatUnmap(Format, p, aColor);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsImage.Assign(const aImage: TtsImage);
+var
+  ImgData: Pointer;
+begin
+  GetMem(ImgData, aImage.DataSize);
+  if Assigned(ImgData) then
+    Move(aImage.Data^, ImgData^, aImage.DataSize);
+  SetData(ImgData, aImage.Format, aImage.Width, aImage.Height, aImage.LineSize, aImage.DataSize);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsImage.CreateEmpty(const aFormat: TtsFormat; const aWidth, aHeight: Integer);
+var
+  ImgData: PByte;
+  lSize, dSize: Integer;
+begin
+  lSize   := aWidth * tsFormatSize(aFormat);
+  lSize   := lSize + ((4 - (lSize mod 4)) mod 4);
+  dSize   := aHeight * lSize;
+  ImgData := AllocMem(dSize);
+  FillChar(ImgData^, dSize, #0);
+  SetData(ImgData, aFormat, aWidth, aHeight, lSize, dSize);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsImage.LoadFromFunc(const aFunc: TtsImageFunc; const aArgs: Pointer);
+var
+  X, Y: Integer;
+  c: TtsColor4f;
+  p, tmp: PByte;
+begin
+  for Y := 0 to Height - 1 do begin
+    p := ScanLine[Y];
+    for X := 0 to Width - 1 do begin
+      tmp := p;
+      tsFormatUnmap(fFormat, tmp, c);
+      aFunc(Self, X, Y, c, aArgs);
+      tsFormatMap(fFormat, p, c);
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsImage.Resize(const aNewWidth, aNewHeight, X, Y: Integer);
+var
+  ImgData: PByte;
+  pSize, lSize, dSize: Integer;
+
+  src, dst: PByte;
+  YStart, YEnd, YPos, XStart, XEnd: Integer;
+begin
+  if (aNewHeight = 0) or (aNewWidth = 0) then begin
+    SetData(nil);
+    exit;
+  end;
+
+  pSize     := tsFormatSize(Format);
+  lSize     := pSize * aNewWidth;
+  lSize     := lSize + ((4 - (lSize mod 4)) mod 4);
+  dSize     := lSize * aNewHeight;
+
+  GetMem(ImgData, dSize);
+  try
+    FillChar(ImgData^, dSize, 0);
+
+    // positions
+    YStart := Max(0, Y);
+    YEnd   := Min(aNewHeight, Y + Height);
+    XStart := Max(0, X);
+    XEnd   := Min(aNewWidth, X + Width);
+
+    // copy data
+    for YPos := YStart to YEnd -1 do begin
+      dst := ImgData;
+      Inc(dst, lSize * YPos + pSize * XStart);
+
+      src := fData;
+      Inc(src, fLineSize * (YPos - Y) + pSize * (XStart - X));
+
+      Move(src^, dst^, (XEnd - XStart) * pSize);
+    end;
+
+    // assign
+    SetData(ImgData, Format, aNewWidth, aNewHeight, lSize, dSize);
+  except
+    FreeMem(ImgData);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsImage.FindMinMax(out aRect: TtsRect);
+var
+  X, Y: Integer;
+  c: TtsColor4f;
+  p: PByte;
+begin
+  aRect.Top := -1;
+  aRect.Left := -1;
+  aRect.Right := -1;
+  aRect.Bottom := -1;
+
+  // Search for MinMax
+  for Y := 0 to Height-1 do begin
+    p := ScanLine[Y];
+    for X := 0 to Width-1 do begin
+      tsFormatUnmap(Format, p, c);
+      if c.a > 0 then begin
+        if (X < aRect.Left) or (aRect.Left = -1) then
+          aRect.Left := X;
+
+        if (X+1 > aRect.Right) or (aRect.Right = -1) then
+          aRect.Right := X+1;
+
+        if (Y < aRect.Top) or (aRect.Top = -1) then
+          aRect.Top := Y;
+
+        if (Y+1 > aRect.Bottom) or (aRect.Bottom = -1) then
+          aRect.Bottom := Y+1;
+      end;
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsImage.FillColor(const aColor: TtsColor4f; const aChannelMask: TtsColorChannels;
+  const aModes: TtsImageModes);
+var
+  x, y: Integer;
+  rp, wp: PByte;
+  c: TtsColor4f;
+  ch: TtsColorChannel;
+  i: Integer;
+begin
+  for y := 0 to Height-1 do begin
+    rp := Scanline[y];
+    wp := rp;
+    for x := 0 to Width-1 do begin
+      tsFormatUnmap(Format, rp, c);
+      for i := 0 to 3 do begin
+        ch := TtsColorChannel(i);
+        if (ch in aChannelMask) then
+          c.arr[i] := TS_IMAGE_MODE_FUNCTIONS[aModes[ch]](aColor.arr[i], c.arr[i]);
+      end;
+      tsFormatMap(Format, wp, c);
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsImage.FillPattern(const aPattern: TtsImage; X, Y: Integer;
+  const aChannelMask: TtsColorChannels; const aModes: TtsImageModes);
+var
+  _x, _y, posX, i: Integer;
+  src, dst, tmp: PByte;
+  cSrc, cDst: TtsColor4f;
+  ch: TtsColorChannel;
+begin
+  if x < 0 then
+    x := Random(aPattern.Width);
+  if y < 0 then
+    y := Random(aPattern.Height);
+
+  for _y := 0 to Height-1 do begin
+    src := aPattern.Scanline[(y + _y) mod aPattern.Height];
+    dst := Scanline[_y];
+
+    inc(src, x);
+    posX := x;
+
+    for _x := 0 to Width-1 do begin
+      if (posX >= aPattern.Width) then begin
+        src  := aPattern.Scanline[(y + _y) mod aPattern.Height];
+        posX := 0;
+      end;
+
+      tmp := dst;
+      tsFormatUnmap(aPattern.Format, src, cSrc);
+      tsFormatUnmap(Format, tmp, cDst);
+      for i := 0 to 3 do begin
+        ch := TtsColorChannel(i);
+        if (ch in aChannelMask) then
+          cDst.arr[i] := TS_IMAGE_MODE_FUNCTIONS[aModes[ch]](cSrc.arr[i], cDst.arr[i]);
+      end;
+      tsFormatMap(Format, dst, cDst);
+      inc(posX);
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsImage.Blend(const aImage: TtsImage; const X, Y: Integer; const aFunc: TtsBlendColorFunc);
+var
+  _x, _y, x1, x2, y1, y2: Integer;
+  src, dst, tmp: PByte;
+  srcColor, dstColor: TtsColor4f;
+  srcPixelSize, dstPixelSize: Integer;
+begin
+  x1 := Max(X, 0);
+  x2 := Min(X + aImage.Width , Width);
+  y1 := Max(Y, 0);
+  y2 := Min(Y + aImage.Height, Height);
+  srcPixelSize := tsFormatSize(aImage.Format);
+  dstPixelSize := tsFormatSize(Format);
+  for _y := y1 to y2-1 do begin
+    src := aImage.Scanline[_y - min(y1, y)];
+    dst := Scanline[_y];
+    inc(src, (x1 - x) * srcPixelSize);
+    inc(dst,  x1      * dstPixelSize);
+    tmp := dst;
+    for _x := x1 to x2-1 do begin
+      tsFormatUnmap(aImage.Format, src, srcColor);
+      tsFormatUnmap(       Format, dst, dstColor);
+      tsFormatMap(aImage.Format, tmp, aFunc(srcColor, dstColor));
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsImage.Blur(const aHorzKernel, aVertKernel: TtsKernel1D; const aChannelMask: TtsColorChannels);
+var
+  tmpImage: TtsImage;
+
+  procedure DoBlur(const aSrc, aDst: TtsImage; const aKernel: TtsKernel1D; const ShiftX, ShiftY: Integer);
+  var
+    x, y, i, j: Integer;
+    src, dst: PByte;
+    v: Single;
+    c, tmp: TtsColor4f;
+  begin
+    for y := 0 to Height-1 do begin
+      src := aSrc.Scanline[y];
+      dst := aDst.Scanline[y];
+      for x := 0 to Width-1 do begin
+
+        // read color and clear channels
+        v := 0;
+        tsFormatUnmap(aSrc.Format, src, c);
+        for i := 0 to 3 do
+          if (TtsColorChannel(i) in aChannelMask) then
+            c.arr[i] := 0;
+
+        // do blur
+        for i := 0 to aKernel.ItemCount-1 do with aKernel.Items[i] do begin
+          if aSrc.GetPixelAt(x + Offset * ShiftX, y + Offset * ShiftY, tmp) then begin
+            for j := 0 to 3 do begin
+              if (TtsColorChannel(j) in aChannelMask) then
+                c.arr[j] := c.arr[j] + tmp.arr[j] * Value;
+            end;
+            v := v + Value;
+          end;
+        end;
+
+        // calc final color and write
+        for i := 0 to 3 do
+          if (TtsColorChannel(i) in aChannelMask) then
+            c.arr[i] := c.arr[i] / v;
+        tsFormatMap(aDst.Format, dst, c);
+      end;
+    end;
+  end;
+
+begin
+  tmpImage := TtsImage.Create;
+  try
+    tmpImage.CreateEmpty(Format, Width, Height);
+    tmpImage.FillColor(tsColor4f(1, 1, 1, 0), TS_COLOR_CHANNELS_RGBA, TS_IMAGE_MODES_REPLACE_ALL);
+
+    DoBlur(self, tmpImage, aHorzKernel, 1, 0);
+    DoBlur(tmpImage, self, aVertKernel, 0, 1);
+  finally
+    FreeAndNil(tmpImage);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsImage.Create;
+begin
+  inherited Create;
+  SetData(nil);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsImage.Destroy;
+begin
+  SetData(nil);
+  inherited Destroy;
+end;
+
+
+end.
+

utsOpenGLUtils.pas

@@ -1,25 +1,27 @@
 unit utsOpenGLUtils;
 
 {$IFDEF FPC}
-{$mode delphi}{$H+}
+  {$mode objfpc}{$H+}
 {$ENDIF}
 
 interface
 
 uses
   Classes, SysUtils,
-  utsTextSuite, utsTypes;
+  utsTypes, utsRenderer, utsImage, utsContext, utsUtils, utsChar;
 
 type
-  TtsCharRenderRefOpenGL = class(TtsCharRenderRef)
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsOpenGLRenderRef = class(TObject)
   public
-    TextureID: Integer;         // ID of OpenGL texture where the char is stored in
+    TextureID: Integer;
     Size: TtsPosition;
     TexMat: TtsMatrix4f;
     VertMat: TtsMatrix4f;
     constructor Create;
   end;
 
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
   PtsTextureUsageItem = ^TtsTextureUsageItem;
   TtsTextureUsageItem = packed record
     children: array[0..3] of PtsTextureUsageItem;
@@ -29,9 +31,10 @@ type
   TtsTextureTreeItem = packed record
     value: SmallInt;
     children: array[0..1] of PtsTextureTreeItem;
-    ref: TtsCharRenderRefOpenGL;
+    ref: TtsOpenGLRenderRef;
   end;
 
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
   PtsFontTexture = ^TtsFontTexture;
   TtsFontTexture = packed record
     ID: Integer;                    // OpenGL texture ID
@@ -42,6 +45,7 @@ type
     Count: Integer;                 // number of chars stored in this texture
   end;
 
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
   TtsBaseOpenGL = class(TtsRenderer)
   private
     fTextureSize: Integer;
@@ -61,17 +65,16 @@ type
     function  CreateNewTexture: PtsFontTexture; virtual;
     procedure FreeTexture(var aTexture: PtsFontTexture); virtual;
 
-    procedure UploadTexData(const aCharRef: TtsCharRenderRefOpenGL; const aCharImage: TtsImage; const X, Y: Integer); virtual;
+    procedure UploadTexData(const aCharRef: TtsOpenGLRenderRef; const aCharImage: TtsImage; const X, Y: Integer); virtual;
+  public
+    function CreateRenderRef(const aChar: TtsChar; const aImage: TtsImage): TtsRenderRef; override;
+    procedure FreeRenderRef(const aRenderRef: TtsRenderRef); override;
   protected
-    function  CreateRenderRef(const aChar: TtsChar; const aCharImage: TtsImage): TtsCharRenderRef; override;
-    procedure FreeRenderRef(const aCharRef: TtsCharRenderRef); override;
-
     procedure BeginRender; 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 SetDrawPos(const aValue: TtsPosition); override;
+    function GetDrawPos: TtsPosition; override;
+    procedure MoveDrawPos(const aOffset: TtsPosition); override;
+    procedure SetColor(const aValue: TtsColor4f); override;
   public
     property TextureSize: Integer read fTextureSize write fTextureSize;
 
@@ -84,9 +87,9 @@ type
 implementation
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TtsCharRenderRefOpenGL////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsOpenGLRenderRef////////////////////////////////////////////////////////////////////////////////////////////////////
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TtsCharRenderRefOpenGL.Create;
+constructor TtsOpenGLRenderRef.Create;
 begin
   inherited Create;
   TextureID := 0;
@@ -149,13 +152,14 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsBaseOpenGL.UploadTexData(const aCharRef: TtsCharRenderRefOpenGL; const aCharImage: TtsImage; const X, Y: Integer);
+procedure TtsBaseOpenGL.UploadTexData(const aCharRef: TtsOpenGLRenderRef; const aCharImage: TtsImage; const X,
+  Y: Integer);
 begin
   // DUMMY
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TtsBaseOpenGL.CreateRenderRef(const aChar: TtsChar; const aCharImage: TtsImage): TtsCharRenderRef;
+function TtsBaseOpenGL.CreateRenderRef(const aChar: TtsChar; const aImage: TtsImage): TtsRenderRef;
 var
   GlyphWidth, GlyphHeight: Integer;
 
@@ -199,7 +203,7 @@ var
     end;
   end;
 
-  function AddToTexture(const aTexture: PtsFontTexture): TtsCharRenderRefOpenGL;
+  function AddToTexture(const aTexture: PtsFontTexture): TtsOpenGLRenderRef;
   var
     x, y, wChar, hChar, l, t: Integer;
     item: PtsTextureTreeItem;
@@ -208,15 +212,15 @@ var
     if not Assigned(item) then
       raise EtsRendererOpenGL.Create('unable to add glyph to texture');
 
-    item^.ref := TtsCharRenderRefOpenGL.Create;
+    item^.ref := TtsOpenGLRenderRef.Create;
     result    := item^.ref;
 
-    wChar := aChar.GlyphRect.Right  - aChar.GlyphRect.Left;
-    hChar := aChar.GlyphRect.Bottom - aChar.GlyphRect.Top;
-    l     := aChar.GlyphRect.Left + x;
-    t     := aChar.GlyphRect.Top  + y;
+    wChar := aChar.GlyphMetric.GlyphRect.Right  - aChar.GlyphMetric.GlyphRect.Left;
+    hChar := aChar.GlyphMetric.GlyphRect.Bottom - aChar.GlyphMetric.GlyphRect.Top;
+    l     := aChar.GlyphMetric.GlyphRect.Left + x;
+    t     := aChar.GlyphMetric.GlyphRect.Top  + y;
     result.TextureID := aTexture^.ID;
-    result.Size      := tsPosition(aCharImage.Width, aCharImage.Height);
+    result.Size      := tsPosition(aImage.Width, aImage.Height);
     result.TexMat := tsMatrix4f(
       tsVector4f(wChar  / aTexture^.Size,       0.0, 0.0, 0.0),
       tsVector4f(0.0,        hChar / aTexture^.Size, 0.0, 0.0),
@@ -226,20 +230,20 @@ var
       tsVector4f(wChar, 0.0, 0.0, 0.0),
       tsVector4f(0.0, hChar, 0.0, 0.0),
       tsVector4f(0.0, 0.0, 1.0, 0.0),
-      tsVector4f(aChar.GlyphOrigin.x, -aChar.GlyphOrigin.y, 0.0, 1.0));
+      tsVector4f(aChar.GlyphMetric.GlyphOrigin.x, -aChar.GlyphMetric.GlyphOrigin.y, 0.0, 1.0));
 
-    UploadTexData(result, aCharImage, x, y);
+    UploadTexData(result, aImage, x, y);
   end;
 
 var
   tex: PtsFontTexture;
 begin
   result := nil;
-  if aCharImage.IsEmpty then
+  if aImage.IsEmpty then
     exit;
 
-  GlyphWidth  := aCharImage.Width  + 1;
-  GlyphHeight := aCharImage.Height + 1;
+  GlyphWidth  := aImage.Width  + 1;
+  GlyphHeight := aImage.Height + 1;
 
   // try to add to existing texture
   tex := fFirstTexture;
@@ -250,7 +254,7 @@ begin
 
   // create new texture
   if not Assigned(result) then begin
-    if (aCharImage.Width > TextureSize) or (aCharImage.Height > TextureSize) then
+    if (aImage.Width > TextureSize) or (aImage.Height > TextureSize) then
       raise EtsRendererOpenGL.Create('char is to large to fit into a texture: (0x' + IntToHex(Ord(aChar.CharCode), 4) + ')');
     tex    := CreateNewTexture;
     result := AddToTexture(tex);
@@ -261,9 +265,9 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsBaseOpenGL.FreeRenderRef(const aCharRef: TtsCharRenderRef);
+procedure TtsBaseOpenGL.FreeRenderRef(const aRenderRef: TtsRenderRef);
 var
-  ref: TtsCharRenderRefOpenGL;
+  ref: TtsOpenGLRenderRef;
   tex: PtsFontTexture;
 
   function IsEmtpy(const aItem: PtsTextureTreeItem): Boolean;
@@ -310,10 +314,11 @@ var
   end;
 
 begin
+  ref := nil;
   try
-    if not Assigned(aCharRef) or not (aCharRef is TtsCharRenderRefOpenGL) then
+    if not Assigned(aRenderRef) then
       exit;
-    ref := (aCharRef as TtsCharRenderRefOpenGL);
+    ref := TtsOpenGLRenderRef(aRenderRef);
     tex := fFirstTexture;
     while Assigned(tex) do begin
       if (tex^.ID = ref.TextureID) then begin
@@ -329,24 +334,22 @@ begin
         tex := tex^.Next;
     end;
   finally
-    if Assigned(aCharRef) then
-      aCharRef.Free;
+    if Assigned(ref) then
+      ref.Free;
   end;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 procedure TtsBaseOpenGL.BeginRender;
 begin
-  inherited BeginRender;
   fRenderPos.x := 0;
   fRenderPos.y := 0;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsBaseOpenGL.SetDrawPos(const X, Y: Integer);
+procedure TtsBaseOpenGL.SetDrawPos(const aValue: TtsPosition);
 begin
-  fRenderPos.x := X;
-  fRenderPos.y := Y;
+  fRenderPos := aValue;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -356,16 +359,16 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsBaseOpenGL.MoveDrawPos(const X, Y: Integer);
+procedure TtsBaseOpenGL.MoveDrawPos(const aOffset: TtsPosition);
 begin
-  fRenderPos.x := fRenderPos.x + X;
-  fRenderPos.y := fRenderPos.y + Y;
+  fRenderPos.x := fRenderPos.x + aOffset.x;
+  fRenderPos.y := fRenderPos.y + aOffset.y;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsBaseOpenGL.SetColor(const aColor: TtsColor4f);
+procedure TtsBaseOpenGL.SetColor(const aValue: TtsColor4f);
 begin
-  fColor := aColor;
+  fColor := aValue;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -379,6 +382,7 @@ begin
   fRenderPos    := tsPosition(0, 0);
 end;
 
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 destructor TtsBaseOpenGL.Destroy;
 begin
   FreeTextures(fFirstTexture);

utsPostProcess.pas

@@ -1,277 +0,0 @@
-unit utsPostProcess;
-
-{$IFDEF FPC}
-{$mode delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
-  Classes, SysUtils, utsTextSuite, utsTypes;
-
-type
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TtsPostProcessFillColor = class(TtsPostProcessStep)
-  private
-    fColor: TtsColor4f;
-    fModes: TtsImageModes;
-    fChannels: TtsColorChannels;
-  protected
-    procedure Execute(const aChar: TtsChar; const aCharImage: TtsImage); override;
-  public
-    constructor Create(const aColor: TtsColor4f;
-      const aModes: TtsImageModes; const aChannels: TtsColorChannels);
-  end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TtsPostProcessFillPattern = class(TtsPostProcessStep)
-  private
-    fPattern: TtsImage;
-    fOwnsPattern: Boolean;
-    fX, fY: Integer;
-    fModes: TtsImageModes;
-    fChannels: TtsColorChannels;
-  protected
-    procedure Execute(const aChar: TtsChar; const aCharImage: TtsImage); override;
-  public
-    constructor Create(const aPattern: TtsImage; const aOwnsPattern: Boolean; const X, Y: Integer;
-      const aModes: TtsImageModes; const aChannels: TtsColorChannels);
-    destructor Destroy; override;
-  end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TtsPostProcessBorder = class(TtsPostProcessStep)
-  private
-    fKernel: TtsKernel2D;
-    fColor: TtsColor4f;
-    fKeepCharSize: Boolean;
-  public
-    procedure Execute(const aChar: TtsChar; const aCharImage: TtsImage); override;
-  public
-    constructor Create(const aWidth, aStrength: Single; const aColor: TtsColor4f;
-      const aKeepCharSize: Boolean = false);
-    destructor Destroy; override;
-  end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-  TtsPostProcessShadow = class(TtsPostProcessStep)
-  private
-    fKernel: TtsKernel1D;
-    fColor: TtsColor4f;
-    fX, fY: Integer;
-  protected
-    procedure Execute(const aChar: TtsChar; const aCharImage: TtsImage); override;
-  public
-    constructor Create(const aRadius, aStrength: Single; const X, Y: Integer; const aColor: TtsColor4f);
-    destructor Destroy; override;
-  end;
-
-implementation
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TtsPostProcessFillColor///////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsPostProcessFillColor.Execute(const aChar: TtsChar; const aCharImage: TtsImage);
-begin
-  if Assigned(aCharImage) then
-    aCharImage.FillColor(fColor, fChannels, fModes);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TtsPostProcessFillColor.Create(const aColor: TtsColor4f; const aModes: TtsImageModes; const aChannels: TtsColorChannels);
-begin
-  inherited Create;
-  fColor    := aColor;
-  fModes    := aModes;
-  fChannels := aChannels;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TtsPostProcessFillPattern/////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsPostProcessFillPattern.Execute(const aChar: TtsChar; const aCharImage: TtsImage);
-begin
-  if Assigned(aCharImage) then
-    aCharImage.FillPattern(fPattern, fX, fY, fChannels, fModes);
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TtsPostProcessFillPattern.Create(const aPattern: TtsImage; const aOwnsPattern: Boolean; const X,
-  Y: Integer; const aModes: TtsImageModes; const aChannels: TtsColorChannels);
-begin
-  inherited Create;
-  fPattern     := aPattern;
-  fOwnsPattern := aOwnsPattern;
-  fX           := X;
-  fY           := Y;
-  fModes       := aModes;
-  fChannels    := aChannels;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TtsPostProcessFillPattern.Destroy;
-begin
-  if fOwnsPattern then
-    FreeAndNil(fPattern);
-  inherited Destroy;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TtsPostProcessBorder//////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsPostProcessBorder.Execute(const aChar: TtsChar; const aCharImage: TtsImage);
-var
-  orig: TtsImage;
-  x, y: Integer;
-  dst: PByte;
-
-  function BorderLookup: TtsColor4f;
-  var
-    i: Integer;
-    c: TtsColor4f;
-    s: Single;
-    chan: TtsColorChannel;
-    mask: TtsColorChannels;
-    tmpX, tmpY: Integer;
-  begin
-    mask   := TS_CHANNELS_RGBA;
-    result := tsColor4f(0, 0, 0, 0);
-    for i := 0 to fKernel.ItemCount-1 do begin
-      tmpX := x + fKernel.Items[i].OffsetX;
-      tmpY := y + fKernel.Items[i].OffsetY;
-      if (tmpX >= 0) and (tmpX < orig.Width) and
-         (tmpY >= 0) and (tmpY < orig.Height) and
-         orig.GetPixelAt(tmpX, tmpY, c) then
-      begin
-        {$IFDEF FPC}
-        for chan in mask do begin
-        {$ELSE}
-        for chan := low(TtsColorChannel) to high(TtsColorChannel) do if (chan in mask) then begin
-        {$ENDIF}
-          s := c.arr[Integer(chan)] * fColor.arr[Integer(chan)] * fKernel.Items[i].Value;
-          if (s > result.arr[Integer(chan)]) then begin
-            result.arr[Integer(chan)] := s;
-            if (s >= 1.0) then begin
-              Exclude(mask, chan);
-              if (mask = []) then
-                exit;
-            end;
-          end;
-        end;
-      end;
-    end;
-  end;
-
-begin
-  if not Assigned(aCharImage) then
-    exit;
-
-  aCharImage.Resize(
-    aCharImage.Width  + 2 * fKernel.SizeX,
-    aCharImage.Height + 2 * fKernel.SizeY,
-    fKernel.SizeX, fKernel.SizeY);
-
-  orig := TtsImage.Create;
-  try
-    orig.Assign(aCharImage);
-    aCharImage.FillColor(fColor, TS_CHANNELS_RGBA, TS_MODES_REPLACE_ALL);
-
-    for y := 0 to orig.Height-1 do begin
-      dst := aCharImage.Scanline[y];
-      for x := 0 to orig.Width-1 do
-        tsFormatMap(aCharImage.Format, dst, BorderLookup);
-    end;
-
-    aCharImage.Blend(orig, 0, 0, @tsBlendFundAdditiveAlpha);
-  finally
-    FreeAndNil(orig);
-  end;
-
-  aChar.GlyphRect := tsRect(
-    aChar.GlyphRect.Left,
-    aChar.GlyphRect.Top,
-    aChar.GlyphRect.Right  + 2 * fKernel.SizeX,
-    aChar.GlyphRect.Bottom + 2 * fKernel.SizeY);
-
-  if fKeepCharSize then begin
-    aChar.GlyphOrigin := tsPosition(
-      aChar.GlyphOrigin.x - fKernel.SizeX,
-      aChar.GlyphOrigin.y + fKernel.SizeY);
-  end else begin
-    aChar.Advance := aChar.Advance + 2 * fKernel.SizeX;
-    aChar.GlyphOrigin := tsPosition(
-      aChar.GlyphOrigin.x,
-      aChar.GlyphOrigin.y + fKernel.SizeY);
-  end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TtsPostProcessBorder.Create(const aWidth, aStrength: Single; const aColor: TtsColor4f; const aKeepCharSize: Boolean);
-begin
-  inherited Create;
-  fKernel       := TtsKernel2D.Create(aWidth, aStrength);
-  fColor        := aColor;
-  fKeepCharSize := aKeepCharSize;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TtsPostProcessBorder.Destroy;
-begin
-  FreeAndNil(fKernel);
-  inherited Destroy;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TtsPostProcessShadow//////////////////////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsPostProcessShadow.Execute(const aChar: TtsChar; const aCharImage: TtsImage);
-var
-  orig: TtsImage;
-  tmpX, tmpY: Integer;
-begin
-  orig := TtsImage.Create;
-  try
-    orig.Assign(aCharImage);
-    aCharImage.Resize(
-      aCharImage.Width  + 2 * fKernel.Size,
-      aCharImage.Height + 2 * fKernel.Size,
-      fKernel.Size, fKernel.Size);
-    aCharImage.FillColor(fColor, TS_CHANNELS_RGBA, TS_MODES_MODULATE_ALPHA);
-    aCharImage.Blur(fKernel, fKernel, [tsChannelAlpha]);
-
-    tmpX := fKernel.Size - fX;
-    tmpY := fKernel.Size - fY;
-    aCharImage.Blend(orig, tmpX, tmpY, @tsBlendFundAlpha);
-
-    aChar.GlyphRect := tsRect(
-      aChar.GlyphRect.Left,
-      aChar.GlyphRect.Top,
-      aChar.GlyphRect.Right  + 2 * fKernel.Size,
-      aChar.GlyphRect.Bottom + 2 * fKernel.Size);
-    aChar.GlyphOrigin := tsPosition(
-      aChar.GlyphOrigin.x - tmpX,
-      aChar.GlyphOrigin.y + tmpX);
-  finally
-    FreeAndNil(orig);
-  end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TtsPostProcessShadow.Create(const aRadius, aStrength: Single; const X, Y: Integer; const aColor: TtsColor4f);
-begin
-  inherited Create;
-  fKernel := TtsKernel1D.Create(aRadius, aStrength);
-  fX      := X;
-  fY      := Y;
-  fColor  := aColor;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TtsPostProcessShadow.Destroy;
-begin
-  FreeAndNil(fKernel);
-  inherited Destroy;
-end;
-
-end.
-

utsPostProcessor.pas

@@ -0,0 +1,602 @@
+unit utsPostProcessor;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs,
+  utsUtils, utsChar, utsImage, utsContext, utsTypes;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsCharRange = record
+    Start: WideChar;
+    Stop:  WideChar;
+  end;
+  PtsCharRange = ^TtsCharRange;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsCharRangeUsage = (
+    tsUsageInclude,
+    tsUsageExclude);
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsPostProcessor = class(TtsRefManager)
+  private
+    fContext: TtsContext;
+    fIncludeCharRanges: TList;
+    fExcludeCharRanges: TList;
+
+    procedure ClearList(const aList: TList);
+  public
+    property Context: TtsContext read fContext;
+
+    function IsInRange(const aCharCode: WideChar): Boolean;
+
+    procedure AddRange(const aUsage: TtsCharRangeUsage; const aStart, aStop: WideChar);
+    procedure AddChars(const aUsage: TtsCharRangeUsage; aChars: PWideChar);
+    procedure ClearRanges;
+
+    function Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean; virtual;
+
+    constructor Create(const aContext: TtsContext);
+    destructor Destroy; override;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsPostProcessorList = class(TtsPostProcessor)
+  private
+    fItems: TObjectList;
+
+    function GetCount: Integer;
+    function GetOwnsObjects: Boolean;
+    procedure SetOwnsObjects(const aValue: Boolean);
+  public
+    property Count:       Integer read GetCount;
+    property OwnsObjects: Boolean read GetOwnsObjects write SetOwnsObjects;
+
+    procedure Add(const aPostProcessor: TtsPostProcessor);
+    procedure Delete(const aIndex: Integer);
+    procedure Clear;
+
+    function Remove(const aPostProcessor: TtsPostProcessor): Integer;
+    function IndexOf(const aPostProcessor: TtsPostProcessor): Integer;
+
+    function Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean; override;
+
+    constructor Create(const aContext: TtsContext; const aOwnsObjects: Boolean);
+    destructor Destroy; override;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsPostProcessorFillColor = class(TtsPostProcessor)
+  private
+    fColor: TtsColor4f;
+    fModes: TtsImageModes;
+    fChannels: TtsColorChannels;
+  public
+    property Color:     TtsColor4f       read fColor    write fColor;
+    property Modes:     TtsImageModes    read fModes    write fModes;
+    property Channels:  TtsColorChannels read fChannels write fChannels;
+
+    function Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean; override;
+
+    constructor Create(
+      const aContext: TtsContext;
+      const aColor: TtsColor4f;
+      const aModes: TtsImageModes;
+      const aChannels: TtsColorChannels);
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsPostProcessorFillPattern = class(TtsPostProcessor)
+  private
+    fPattern: TtsImage;
+    fOwnsPattern: Boolean;
+    fPosition: TtsPosition;
+    fModes: TtsImageModes;
+    fChannels: TtsColorChannels;
+    procedure SetPattern(aValue: TtsImage);
+  public
+    property Pattern:     TtsImage         read fPattern     write SetPattern;
+    property OwnsPattern: Boolean          read fOwnsPattern write fOwnsPattern;
+    property Position:    TtsPosition      read fPosition    write fPosition;
+    property Modes:       TtsImageModes    read fModes       write fModes;
+    property Channels:    TtsColorChannels read fChannels    write fChannels;
+
+    function Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean; override;
+
+    constructor Create(
+      const aContext: TtsContext;
+      const aPattern: TtsImage;
+      const aOwnsPattern: Boolean;
+      const aPosition: TtsPosition;
+      const aModes: TtsImageModes;
+      const aChannels: TtsColorChannels);
+    destructor Destroy; override;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsPostProcessorBorder = class(TtsPostProcessor)
+  private
+    fKernel: TtsKernel2D;
+    fKeepSize: Boolean;
+    fColor: TtsColor4f;
+    fStrength: Single;
+    fWidth: Single;
+    procedure SetStrength(const aValue: Single);
+    procedure SetWidth(const aValue: Single);
+  public
+    property Width:    Single     read fWidth    write SetWidth;
+    property Strength: Single     read fStrength write SetStrength;
+    property Color:    TtsColor4f read fColor    write fColor;
+    property KeepSize: Boolean    read fKeepSize write fKeepSize;
+
+    function Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean; override;
+
+    constructor Create(
+      const aContext: TtsContext;
+      const aWidth, aStrength: Single;
+      const aColor: TtsColor4f;
+      const aKeepSize: Boolean);
+    destructor Destroy; override;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsPostProcessorShadow = class(TtsPostProcessor)
+  private
+    fKernel: TtsKernel1D;
+    fColor: TtsColor4f;
+    fOffset: TtsPosition;
+    fRadius: Single;
+    fStrength: Single;
+    procedure SetRadius(const aValue: Single);
+    procedure SetStrength(const aValue: Single);
+  public
+    property Radius:   Single      read fRadius   write SetRadius;
+    property Strength: Single      read fStrength write SetStrength;
+    property Offset:   TtsPosition read fOffset   write fOffset;
+    property Color:    TtsColor4f  read fColor    write fColor;
+
+    function Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean; override;
+
+    constructor Create(
+      const aContext: TtsContext;
+      const aRadius, aStrength: Single;
+      const aOffset: TtsPosition;
+      const aColor: TtsColor4f);
+    destructor Destroy; override;
+  end;
+
+implementation
+
+uses
+  utsConstants;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsPostProcessor//////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessor.ClearList(const aList: TList);
+var
+  i: Integer;
+  p: PtsCharRange;
+begin
+  for i := 0 to aList.Count-1 do begin
+    p := aList[i];
+    Dispose(p);
+  end;
+  aList.Clear;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsPostProcessor.IsInRange(const aCharCode: WideChar): Boolean;
+var
+  i: Integer;
+  p: PtsCharRange;
+begin
+  result := (fIncludeCharRanges.Count = 0);
+
+  if not result then for i := 0 to fIncludeCharRanges.Count-1 do begin
+    p := fIncludeCharRanges[i];
+    if (aCharCode >= p^.Start) and (aCharCode <= p^.Stop) then begin
+      result := true;
+      break;
+    end;
+  end;
+
+  if result then for i := 0 to fExcludeCharRanges.Count-1 do begin
+    p := fExcludeCharRanges[i];
+    if (aCharCode >= p^.Start) and (aCharCode <= p^.Stop) then begin
+      result := false;
+      break;
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessor.AddRange(const aUsage: TtsCharRangeUsage; const aStart, aStop: WideChar);
+var
+  p: PtsCharRange;
+begin
+  new(p);
+  p^.Start := aStart;
+  p^.Stop  := aStop;
+  case aUsage of
+    tsUsageInclude: fIncludeCharRanges.Add(p);
+    tsUsageExclude: fExcludeCharRanges.Add(p);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessor.AddChars(const aUsage: TtsCharRangeUsage; aChars: PWideChar);
+begin
+  if not Assigned(aChars) then
+    exit;
+  while (aChars^ <> #0) do begin
+    AddRange(aUsage, aChars^, aChars^);
+    inc(aChars);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessor.ClearRanges;
+begin
+  ClearList(fIncludeCharRanges);
+  ClearList(fExcludeCharRanges);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsPostProcessor.Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean;
+begin
+  result := IsInRange(aChar.CharCode);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsPostProcessor.Create(const aContext: TtsContext);
+begin
+  inherited Create(aContext);
+  fIncludeCharRanges := TList.Create;
+  fExcludeCharRanges := TList.Create;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsPostProcessor.Destroy;
+begin
+  ClearRanges;
+  FreeAndNil(fIncludeCharRanges);
+  FreeAndNil(fExcludeCharRanges);
+  inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsPostProcessorList//////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsPostProcessorList.GetCount: Integer;
+begin
+  result := fItems.Count;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsPostProcessorList.GetOwnsObjects: Boolean;
+begin
+  result := fItems.OwnsObjects;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessorList.SetOwnsObjects(const aValue: Boolean);
+begin
+  fItems.OwnsObjects := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessorList.Add(const aPostProcessor: TtsPostProcessor);
+begin
+  fItems.Add(aPostProcessor);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessorList.Delete(const aIndex: Integer);
+begin
+  fItems.Delete(aIndex);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessorList.Clear;
+begin
+  fItems.Clear;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsPostProcessorList.Remove(const aPostProcessor: TtsPostProcessor): Integer;
+begin
+  result := fItems.IndexOf(aPostProcessor);
+  if (result >= 0) then
+    fItems.Delete(result);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsPostProcessorList.IndexOf(const aPostProcessor: TtsPostProcessor): Integer;
+begin
+  result := fItems.IndexOf(aPostProcessor);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsPostProcessorList.Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean;
+var
+  i: Integer;
+begin
+  result := inherited Execute(aChar, aImage);
+  if result then
+    for i := 0 to fItems.Count-1 do
+      (fItems[i] as TtsPostProcessor).Execute(aChar, aImage);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsPostProcessorList.Create(const aContext: TtsContext; const aOwnsObjects: Boolean);
+begin
+  inherited Create(aContext);
+  fItems := TObjectList.Create(aOwnsObjects);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsPostProcessorList.Destroy;
+begin
+  FreeAndNil(fItems);
+  inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsPostProcessorFillColor/////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsPostProcessorFillColor.Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean;
+begin
+  result := inherited Execute(aChar, aImage);
+  if result and Assigned(aImage) then
+    aImage.FillColor(fColor, fChannels, fModes);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsPostProcessorFillColor.Create(const aContext: TtsContext; const aColor: TtsColor4f;
+  const aModes: TtsImageModes; const aChannels: TtsColorChannels);
+begin
+  inherited Create(aContext);
+  fColor    := aColor;
+  fModes    := aModes;
+  fChannels := aChannels;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsPostProcessorFillPattern///////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessorFillPattern.SetPattern(aValue: TtsImage);
+begin
+  if (fPattern = aValue) then
+    exit;
+  if fOwnsPattern then
+    FreeAndNil(fPattern);
+  fPattern := aValue;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsPostProcessorFillPattern.Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean;
+begin
+  result := inherited Execute(aChar, aImage);
+  if result and Assigned(aImage) then
+    aImage.FillPattern(fPattern, fPosition.x, fPosition.y, fChannels, fModes);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsPostProcessorFillPattern.Create(const aContext: TtsContext; const aPattern: TtsImage;
+  const aOwnsPattern: Boolean; const aPosition: TtsPosition; const aModes: TtsImageModes; const aChannels: TtsColorChannels);
+begin
+  inherited Create(aContext);
+  fPattern     := aPattern;
+  fOwnsPattern := aOwnsPattern;
+  fPosition    := aPosition;
+  fModes       := aModes;
+  fChannels    := aChannels;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsPostProcessorFillPattern.Destroy;
+begin
+  if fOwnsPattern then
+    FreeAndNil(fPattern);
+  inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsPostProcessorBorder////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessorBorder.SetStrength(const aValue: Single);
+begin
+  fStrength := aValue;
+  FreeAndNil(fKernel);
+  fKernel := TtsKernel2D.Create(fWidth, fStrength);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessorBorder.SetWidth(const aValue: Single);
+begin
+  fWidth := aValue;
+  FreeAndNil(fKernel);
+  fKernel := TtsKernel2D.Create(fWidth, fStrength);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsPostProcessorBorder.Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean;
+var
+  orig: TtsImage;
+  x, y: Integer;
+  dst: PByte;
+  m: TtsGlyphMetric;
+
+  function BorderLookup: TtsColor4f;
+  var
+    i: Integer;
+    c: TtsColor4f;
+    s: Single;
+    chan: TtsColorChannel;
+    mask: TtsColorChannels;
+    tmpX, tmpY: Integer;
+  begin
+    mask   := TS_COLOR_CHANNELS_RGBA;
+    result := tsColor4f(0, 0, 0, 0);
+    for i := 0 to fKernel.ItemCount-1 do begin
+      tmpX := x + fKernel.Items[i].OffsetX;
+      tmpY := y + fKernel.Items[i].OffsetY;
+      if (tmpX >= 0) and (tmpX < orig.Width) and
+         (tmpY >= 0) and (tmpY < orig.Height) and
+         orig.GetPixelAt(tmpX, tmpY, c) then
+      begin
+        {$IFDEF FPC}
+        for chan in mask do begin
+        {$ELSE}
+        for chan := low(TtsColorChannel) to high(TtsColorChannel) do if (chan in mask) then begin
+        {$ENDIF}
+          s := c.arr[Integer(chan)] * fColor.arr[Integer(chan)] * fKernel.Items[i].Value;
+          if (s > result.arr[Integer(chan)]) then begin
+            result.arr[Integer(chan)] := s;
+            if (s >= 1.0) then begin
+              Exclude(mask, chan);
+              if (mask = []) then
+                exit;
+            end;
+          end;
+        end;
+      end;
+    end;
+  end;
+
+begin
+  result := inherited Execute(aChar, aImage);
+  if not result or not Assigned(aImage) then
+    exit;
+
+  aImage.Resize(
+      aImage.Width  + 2 * fKernel.SizeX,
+      aImage.Height + 2 * fKernel.SizeY,
+      fKernel.SizeX, fKernel.SizeY);
+  orig := TtsImage.Create;
+  try
+    orig.Assign(aImage);
+    aImage.FillColor(fColor, TS_COLOR_CHANNELS_RGBA, TS_IMAGE_MODES_REPLACE_ALL);
+    for y := 0 to orig.Height-1 do begin
+      dst := aImage.Scanline[y];
+      for x := 0 to orig.Width-1 do
+        tsFormatMap(aImage.Format, dst, BorderLookup);
+    end;
+    aImage.Blend(orig, 0, 0, @tsBlendColorAdditiveAlpha);
+  finally
+    FreeAndNil(orig);
+  end;
+
+  m := aChar.GlyphMetric;
+  m.GlyphRect.Right  := m.GlyphRect.Right  + 2 * fKernel.SizeX;
+  m.GlyphRect.Bottom := m.GlyphRect.Bottom + 2 * fKernel.SizeY;
+  if fKeepSize then begin
+    m.GlyphOrigin.x := m.GlyphOrigin.x - fKernel.SizeX;
+    m.GlyphOrigin.y := m.GlyphOrigin.y + fKernel.SizeY;
+  end else begin
+    m.Advance       := m.Advance       + 2 * fKernel.SizeX;
+    m.GlyphOrigin.y := m.GlyphOrigin.y +     fKernel.SizeY;
+  end;
+  aChar.GlyphMetric := m;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsPostProcessorBorder.Create(const aContext: TtsContext;
+  const aWidth, aStrength: Single; const aColor: TtsColor4f; const aKeepSize: Boolean);
+begin
+  inherited Create(aContext);
+  fWidth    := aWidth;
+  fStrength := aStrength;
+  fColor    := aColor;
+  fKeepSize := aKeepSize;
+  fKernel   := TtsKernel2D.Create(fWidth, fStrength);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsPostProcessorBorder.Destroy;
+begin
+  FreeAndNil(fKernel);
+  inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsPostProcessorShadow////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessorShadow.SetRadius(const aValue: Single);
+begin
+  fRadius := aValue;
+  FreeAndNil(fKernel);
+  fKernel := TtsKernel1D.Create(fRadius, fStrength);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsPostProcessorShadow.SetStrength(const aValue: Single);
+begin
+  fStrength := aValue;
+  FreeAndNil(fKernel);
+  fKernel := TtsKernel1D.Create(fRadius, fStrength);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsPostProcessorShadow.Execute(const aChar: TtsChar; const aImage: TtsImage): Boolean;
+var
+  orig: TtsImage;
+  tmpX, tmpY: Integer;
+  m: TtsGlyphMetric;
+begin
+  result := inherited Execute(aChar, aImage);
+  if not result or not Assigned(aImage) then
+    exit;
+  orig := TtsImage.Create;
+  try
+    orig.Assign(aImage);
+    aImage.Resize(
+      aImage.Width  + 2 * fKernel.Size,
+      aImage.Height + 2 * fKernel.Size,
+      fKernel.Size, fKernel.Size);
+    aImage.FillColor(fColor, TS_COLOR_CHANNELS_RGBA, TS_IMAGE_MODES_MODULATE_ALPHA);
+    aImage.Blur(fKernel, fKernel, [tsChannelAlpha]);
+
+    tmpX := fKernel.Size - fOffset.x;
+    tmpY := fKernel.Size - fOffset.y;
+    aImage.Blend(orig, tmpX, tmpY, @tsBlendColorAlpha);
+
+    m := aChar.GlyphMetric;
+    m.GlyphRect.Right  := m.GlyphRect.Right + 2 * fKernel.Size;
+    m.GlyphRect.Bottom := m.GlyphRect.Bottom + 2 * fKernel.Size;
+    m.GlyphOrigin.x    := m.GlyphOrigin.x - tmpX;
+    m.GlyphOrigin.y    := m.GlyphOrigin.y + tmpX;
+    aChar.GlyphMetric  := m;
+  finally
+    FreeAndNil(orig);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsPostProcessorShadow.Create(const aContext: TtsContext; const aRadius, aStrength: Single;
+  const aOffset: TtsPosition; const aColor: TtsColor4f);
+begin
+  inherited Create(aContext);
+  fRadius   := aRadius;
+  fStrength := aStrength;
+  fOffset   := aOffset;
+  fColor    := aColor;
+  fKernel   := TtsKernel1D.Create(fRadius, fStrength);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsPostProcessorShadow.Destroy;
+begin
+  FreeAndNil(fKernel);
+  inherited Destroy;
+end;
+
+end.
+

utsRenderer.pas

@@ -0,0 +1,74 @@
+unit utsRenderer;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  utsTypes, utsFont, utsCharCache, utsTextBlock;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsRenderer = class(TtsBlockRenderer)
+  public
+    function GetTextWidthA(const aFont: TtsFont; const aText: PAnsiChar): Integer;
+    function GetTextWidthW(const aFont: TtsFont; const aText: PWideChar): Integer;
+
+    function BeginBlock(const aTop, aLeft, aWidth, aHeight: Integer; const aFlags: TtsBlockFlags): TtsTextBlock;
+  public
+    class procedure EndBlock(var aBlock: TtsTextBlock);
+    class procedure AbortBlock(var aBlock: TtsTextBlock);
+  end;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsRenderer///////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsRenderer.GetTextWidthA(const aFont: TtsFont; const aText: PAnsiChar): Integer;
+var
+  c: TtsChars;
+begin
+  result := 0;
+  c      := CharCache.Chars[aFont];
+  if Assigned(c) then
+    result := c.GetTextWidthA(aText);
+end;
+
+function TtsRenderer.GetTextWidthW(const aFont: TtsFont; const aText: PWideChar): Integer;
+var
+  c: TtsChars;
+begin
+  result := 0;
+  c      := CharCache.Chars[aFont];
+  if Assigned(c) then
+    result := c.GetTextWidthW(aText);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsRenderer.BeginBlock(const aTop, aLeft, aWidth, aHeight: Integer; const aFlags: TtsBlockFlags): TtsTextBlock;
+begin
+  result := TtsTextBlock.Create(self, aTop, aLeft, aWidth, aHeight, aFlags);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class procedure TtsRenderer.EndBlock(var aBlock: TtsTextBlock);
+begin
+  try
+    aBlock.Render;
+  finally
+    FreeAndNil(aBlock);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+class procedure TtsRenderer.AbortBlock(var aBlock: TtsTextBlock);
+begin
+  FreeAndNil(aBlock);
+end;
+
+end.
+

utsRendererOpenGL.pas

@@ -1,33 +1,33 @@
 unit utsRendererOpenGL;
 
 {$IFDEF FPC}
-{$mode delphi}{$H+}
+  {$mode objfpc}{$H+}
 {$ENDIF}
 
 interface
 
 uses
-  Classes, SysUtils,
-  utsTextSuite, utsTypes, utsOpenGLUtils, dglOpenGL;
+  Classes, SysUtils, dglOpenGL,
+  utsOpenGLUtils, utsTypes, utsContext, utsImage;
 
 type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
   TtsRendererOpenGL = class(TtsBaseOpenGL)
   private
     fVBO: GLuint;
     fIsRendering: Boolean;
   protected
-    function  CreateNewTexture: PtsFontTexture; override;
+    function CreateNewTexture: PtsFontTexture; override;
     procedure FreeTexture(var aTexture: PtsFontTexture); override;
-    procedure UploadTexData(const aCharRef: TtsCharRenderRefOpenGL;
-      const aCharImage: TtsImage; const X, Y: Integer); override;
+    procedure UploadTexData(const aCharRef: TtsOpenGLRenderRef; const aCharImage: TtsImage; const X, Y: Integer); override;
 
     procedure BeginRender; override;
     procedure EndRender; override;
 
-    procedure SetDrawPos(const X, Y: Integer); override;
-    procedure MoveDrawPos(const X, Y: Integer); override;
-    procedure SetColor(const aColor: TtsColor4f); override;
-    procedure Render(const aCharRef: TtsCharRenderRef; const aForcedWidth: Integer); override;
+    procedure SetDrawPos(const aValue: TtsPosition); override;
+    procedure MoveDrawPos(const aOffset: TtsPosition); override;
+    procedure SetColor(const aValue: TtsColor4f); override;
+    procedure Render(const aRenderRef: TtsRenderRef; const aForcedWidth: Integer = 0); override;
   public
     constructor Create(const aContext: TtsContext; const aFormat: TtsFormat);
     destructor Destroy; override;
@@ -35,6 +35,9 @@ type
 
 implementation
 
+uses
+  utsUtils;
+
 type
   TVertex = packed record
     pos: array[0..1] of GLfloat;
@@ -119,7 +122,8 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGL.UploadTexData(const aCharRef: TtsCharRenderRefOpenGL; const aCharImage: TtsImage; const X, Y: Integer);
+procedure TtsRendererOpenGL.UploadTexData(const aCharRef: TtsOpenGLRenderRef; const aCharImage: TtsImage; const X,
+  Y: Integer);
 begin
   glBindTexture(GL_TEXTURE_2D, aCharRef.TextureID);
   glPixelStorei(GL_UNPACK_ALIGNMENT, 4);
@@ -156,40 +160,39 @@ begin
     glPopMatrix;
     fIsRendering := false;
   end;
-  inherited EndRender;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGL.SetDrawPos(const X, Y: Integer);
+procedure TtsRendererOpenGL.SetDrawPos(const aValue: TtsPosition);
 begin
-  inherited SetDrawPos(X, Y);
+  inherited SetDrawPos(aValue);
   glPopMatrix;
   glPushMatrix;
-  glTranslatef(X, Y, 0);
+  glTranslatef(aValue.x, aValue.y, 0);
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGL.MoveDrawPos(const X, Y: Integer);
+procedure TtsRendererOpenGL.MoveDrawPos(const aOffset: TtsPosition);
 begin
-  inherited MoveDrawPos(X, Y);
-  glTranslatef(X, Y, 0);
+  inherited MoveDrawPos(aOffset);
+  glTranslatef(aOffset.x, aOffset.y, 0);
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGL.SetColor(const aColor: TtsColor4f);
+procedure TtsRendererOpenGL.SetColor(const aValue: TtsColor4f);
 begin
-  inherited SetColor(aColor);
+  inherited SetColor(aValue);
   glColor4fv(@Color.arr[0]);
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGL.Render(const aCharRef: TtsCharRenderRef; const aForcedWidth: Integer);
+procedure TtsRendererOpenGL.Render(const aRenderRef: TtsRenderRef; const aForcedWidth: Integer);
 var
-  ref: TtsCharRenderRefOpenGL;
+  ref: TtsOpenGLRenderRef;
   m: TtsMatrix4f;
 begin
-  if Assigned(aCharRef) and (aCharRef is TtsCharRenderRefOpenGL) then begin
-    ref := (aCharRef as TtsCharRenderRefOpenGL);
+  if Assigned(aRenderRef) then begin
+    ref := TtsOpenGLRenderRef(aRenderRef);
 
     glEnable(GL_TEXTURE_2D);
     glBindTexture(GL_TEXTURE_2D, ref.TextureID);
@@ -228,6 +231,7 @@ begin
   glBindBuffer(GL_ARRAY_BUFFER, 0);
 end;
 
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 destructor TtsRendererOpenGL.Destroy;
 begin
   glDeleteBuffers(1, @fVBO);

utsRendererOpenGLES.pas

@@ -1,15 +1,14 @@
 unit utsRendererOpenGLES;
 
 {$IFDEF FPC}
-{$mode delphi}{$H+}
+  {$mode objfpc}{$H+}
 {$ENDIF}
-{.$DEFINE DEBUG}
 
 interface
 
 uses
-  Classes, SysUtils,
-  utsTextSuite, utsTypes, utsOpenGLUtils, dglOpenGLES;
+  Classes, SysUtils, dglOpenGLES,
+  utsOpenGLUtils, utsTypes, utsContext, utsImage;
 
 type
   TtsRendererOpenGLES = class(TtsBaseOpenGL)
@@ -36,15 +35,14 @@ type
   protected
     function  CreateNewTexture: PtsFontTexture; override;
     procedure FreeTexture(var aTexture: PtsFontTexture); override;
-    procedure UploadTexData(const aCharRef: TtsCharRenderRefOpenGL;
-      const aCharImage: TtsImage; const X, Y: Integer); override;
+    procedure UploadTexData(const aCharRef: TtsOpenGLRenderRef; const aCharImage: TtsImage; const X, Y: Integer); override;
 
     procedure BeginRender; override;
 
-    procedure SetDrawPos(const X, Y: Integer); override;
-    procedure MoveDrawPos(const X, Y: Integer); override;
-    procedure SetColor(const aColor: TtsColor4f); override;
-    procedure Render(const aCharRef: TtsCharRenderRef; const aForcedWidth: Integer); override;
+    procedure SetDrawPos(const aValue: TtsPosition); override;
+    procedure MoveDrawPos(const aOffset: TtsPosition); override;
+    procedure SetColor(const aValue: TtsColor4f); override;
+    procedure Render(const aRenderRef: TtsRenderRef; const aForcedWidth: Integer = 0); override;
   public
     property ShaderProgram:    GLuint      read fShaderProgram   write SetShaderProgram;
     property ProjectionMatrix: TtsMatrix4f read fProjMatrix      write SetProjectionMatrix;
@@ -56,6 +54,9 @@ type
 
 implementation
 
+uses
+  utsUtils, utsConstants;
+
 type
   TVertex = packed record
     pos: array[0..1] of GLfloat;
@@ -316,7 +317,8 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGLES.UploadTexData(const aCharRef: TtsCharRenderRefOpenGL; const aCharImage: TtsImage; const X, Y: Integer);
+procedure TtsRendererOpenGLES.UploadTexData(const aCharRef: TtsOpenGLRenderRef; const aCharImage: TtsImage; const X,
+  Y: Integer);
 begin
   glBindTexture(GL_TEXTURE_2D, aCharRef.TextureID);
   glPixelStorei(GL_UNPACK_ALIGNMENT, 4);
@@ -335,34 +337,34 @@ begin
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGLES.SetDrawPos(const X, Y: Integer);
+procedure TtsRendererOpenGLES.SetDrawPos(const aValue: TtsPosition);
 begin
-  inherited SetDrawPos(X, Y);
+  inherited SetDrawPos(aValue);
   UpdateUniformCharOffset;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGLES.MoveDrawPos(const X, Y: Integer);
+procedure TtsRendererOpenGLES.MoveDrawPos(const aOffset: TtsPosition);
 begin
-  inherited MoveDrawPos(X, Y);
+  inherited MoveDrawPos(aOffset);
   UpdateUniformCharOffset;
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGLES.SetColor(const aColor: TtsColor4f);
+procedure TtsRendererOpenGLES.SetColor(const aValue: TtsColor4f);
 begin
-  inherited SetColor(aColor);
+  inherited SetColor(aValue);
   glColor4f(Color.r, Color.g, Color.b, Color.a);
 end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGLES.Render(const aCharRef: TtsCharRenderRef; const aForcedWidth: Integer);
+procedure TtsRendererOpenGLES.Render(const aRenderRef: TtsRenderRef; const aForcedWidth: Integer);
 var
-  ref: TtsCharRenderRefOpenGL;
+  ref: TtsOpenGLRenderRef;
   m: TtsMatrix4f;
 begin
-  if Assigned(aCharRef) and (aCharRef is TtsCharRenderRefOpenGL) then begin
-    ref := (aCharRef as TtsCharRenderRefOpenGL);
+  if Assigned(aRenderRef) then begin
+    ref := TtsOpenGLRenderRef(aRenderRef);
 
     glBindTexture(GL_TEXTURE_2D, ref.TextureID);
     glBindBuffer(GL_ARRAY_BUFFER, fVBO);
@@ -424,3 +426,4 @@ begin
 end;
 
 end.
+

utsTextBlock.pas

@@ -0,0 +1,825 @@
+unit utsTextBlock;
+
+{$IFDEF FPC}
+  {$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils,
+  utsUtils, utsTypes, utsFont, utsCharCache, utsContext;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsLineItemType = (
+    tsItemTypeUnknown,
+    tsItemTypeFont,
+    tsItemTypeColor,
+    tsItemTypeText,
+    tsItemTypeSpace,
+    tsItemTypeLineBreak,
+    tsItemTypeTab,
+    tsItemTypeSpacing);
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsLineFlag = (
+    tsLastItemIsSpace,  // is set if the last item was a space item
+    tsMetaValid,        // is set if the line meta data is valid
+    tsAutoLineBreak     // is set if the linebreak was set automatically
+  );
+  TtsLineFlags = set of TtsLineFlag;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  PtsLineItem = ^TtsLineItem;
+  TtsLineItem = packed record
+    Next: PtsLineItem;
+    Prev: PtsLineItem;
+    ItemType: TtsLineItemType;
+    case TtsLineItemType of
+      tsItemTypeFont: (
+        Font: TtsFont
+      );
+      tsItemTypeColor: (
+        Color: TtsColor4f;
+      );
+      tsItemTypeText, tsItemTypeSpace: (
+        Text: PWideChar;      // text of this item
+        TextWidth: Integer;   // width of text (in pixel)
+      );
+      tsItemTypeSpacing: (
+        Spacing: Integer;
+      );
+      tsItemTypeTab: (
+        TabWidth: Integer; // with of tab (in pixel)
+      );
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  PtsBlockLine = ^TtsBlockLine;
+  TtsBlockLine = packed record
+    Next: PtsBlockLine;
+    First: PtsLineItem;
+    Last: PtsLineItem;
+    Flags: TtsLineFlags;
+
+    meta: packed record
+      Width: Integer;       // absolut width of this line
+      Height: Integer;      // absolute height of this line
+      Spacing: Integer;     // spacing between lines
+      Ascent: Integer;      // text ascent
+      SpaceCount: Integer;  // number of words in this line
+    end;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsBlockRenderer = class(TtsRenderRefGenerator)
+  private
+    fCharCache: TtsCharCache;
+  protected
+    property CharCache: TtsCharCache read fCharCache;
+
+    procedure BeginRender; virtual; abstract;
+    procedure EndRender; virtual; abstract;
+
+    function  GetDrawPos: TtsPosition; virtual; abstract;
+    procedure SetDrawPos(const aValue: TtsPosition); virtual; abstract;
+    procedure MoveDrawPos(const aOffset: TtsPosition); virtual; abstract;
+    procedure SetColor(const aValue: TtsColor4f); virtual; abstract;
+    procedure Render(const aRenderRef: TtsRenderRef; const aForcedWidth: Integer = 0); virtual; abstract;
+
+  public
+    constructor Create(const aContext: TtsContext; const aFormat: TtsFormat);
+    destructor Destroy; override;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsTextBlock = class(TtsRefManager)
+  private
+    fRenderer: TtsBlockRenderer;
+
+    fTop: Integer;
+    fLeft: Integer;
+    fWidth: Integer;
+    fHeight: Integer;
+    fFlags: TtsBlockFlags;
+    fVertAlign: TtsVertAlignment;
+    fHorzAlign: TtsHorzAlignment;
+    fClipping: TtsClipping;
+
+    fCurrentChars: TtsChars;
+    fCurrentColor: TtsColor4f;
+    fCurrentFont: TtsFont;
+    fFirstLine: PtsBlockLine;
+    fLastLine: PtsBlockLine;
+
+    function GetRect: TtsRect;
+
+    function PushLineItem(const aItem: PtsLineItem): Boolean;
+    procedure PushSpacing(const aWidth: Integer);
+    procedure PushNewLine;
+
+    procedure FreeLineItem(var aItem: PtsLineItem);
+    procedure FreeLineItems(var aItem: PtsLineItem);
+    procedure FreeLines(var aItem: PtsBlockLine);
+
+    function SplitText(aText: PWideChar): PtsLineItem;
+    function SplitIntoLines(aItem: PtsLineItem): Boolean;
+    procedure TrimSpaces(const aLine: PtsBlockLine);
+    procedure UpdateLineMeta(const aLine: PtsBlockLine);
+  public
+    procedure ChangeFont(const aFont: TtsFont);
+    procedure ChangeColor(const aColor: TtsColor4f);
+  public
+    property Rect:     TtsRect       read GetRect;
+    property Width:    Integer       read fWidth;
+    property Height:   Integer       read fHeight;
+    property Flags:    TtsBlockFlags read fFlags;
+
+    property Top:          Integer          read fTop          write fTop;
+    property Left:         Integer          read fLeft         write fLeft;
+    property VertAlign:    TtsVertAlignment read fVertAlign    write fVertAlign;
+    property HorzAlign:    TtsHorzAlignment read fHorzAlign    write fHorzAlign;
+    property Clipping:     TtsClipping      read fClipping     write fClipping;
+    property CurrentColor: TtsColor4f       read fCurrentColor write ChangeColor;
+    property CurrentFont:  TtsFont          read fCurrentFont  write ChangeFont;
+
+    function GetActualBlockHeight: Integer;
+
+    procedure TextOutA(const aText: PAnsiChar);
+    procedure TextOutW(const aText: PWideChar);
+
+    function GetTextWidthA(const aText: PAnsiChar): Integer;
+    function GetTextWidthW(const aText: PWideChar): Integer;
+
+    procedure Render;
+
+    constructor Create(const aRenderer: TtsBlockRenderer; const aTop, aLeft, aWidth, aHeight: Integer; const aFlags: TtsBlockFlags);
+    destructor Destroy; override;
+  end;
+
+implementation
+
+uses
+  math,
+  utsChar;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsBlockRenderer//////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsBlockRenderer.Create(const aContext: TtsContext; const aFormat: TtsFormat);
+begin
+  inherited Create(aContext, aFormat);
+  fCharCache := TtsCharCache.Create(self);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsBlockRenderer.Destroy;
+begin
+  FreeAndNil(fCharCache);
+  inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsTextBlock//////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsTextBlock.GetRect: TtsRect;
+begin
+  result.Left   := fLeft;
+  result.Top    := fTop;
+  result.Right  := fLeft + fWidth;
+  result.Bottom := fTop  + fHeight;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsTextBlock.PushLineItem(const aItem: PtsLineItem): Boolean;
+begin
+  result := false;
+  if not Assigned(fLastLine) then
+    PushNewLine;
+
+  if not Assigned(fLastLine^.First) and
+     (aItem^.ItemType in [tsItemTypeSpace, tsItemTypeSpacing]) then
+         exit; // di not add line space or line spacing if line is empty
+
+  if Assigned(fLastLine^.Last) then begin
+    aItem^.Prev           := fLastLine^.Last;
+    aItem^.Next           := nil;
+    fLastLine^.Last^.Next := aItem;
+    fLastLine^.Last       := aItem;
+  end;
+
+  if not Assigned(fLastLine^.First) then begin
+    fLastLine^.First := aItem;
+    fLastLine^.Last  := aItem;
+  end;
+
+  case aItem^.ItemType of
+    tsItemTypeSpace, tsItemTypeText:
+      fLastLine^.meta.Width := fLastLine^.meta.Width + aItem^.TextWidth;
+    tsItemTypeSpacing:
+      fLastLine^.meta.Width := fLastLine^.meta.Width + aItem^.Spacing;
+    tsItemTypeTab:
+      fLastLine^.meta.Width := fLastLine^.meta.Width + aItem^.TabWidth;
+  end;
+  result := true;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.PushSpacing(const aWidth: Integer);
+var
+  p: PtsLineItem;
+begin
+  if (aWidth <= 0) then
+    exit;
+  new(p);
+  FillChar(p^, SizeOf(p^), #0);
+  p^.ItemType := tsItemTypeSpacing;
+  p^.Spacing  := aWidth;
+  PushLineItem(p);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.PushNewLine;
+var
+  p: PtsBlockLine;
+begin
+  TrimSpaces(fLastLine);
+
+  new(p);
+  FillChar(p^, SizeOf(p^), #0);
+  UpdateLineMeta(p);
+
+  if Assigned(fLastLine) then begin
+    fLastLine^.Next := p;
+    fLastLine       := p;
+  end;
+
+  if not Assigned(fFirstLine) then begin
+    fFirstLine := p;
+    fLastLine  := p;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.FreeLineItem(var aItem: PtsLineItem);
+begin
+  if Assigned(aItem^.Prev) then
+    aItem^.Prev^.Next := aItem^.Next;
+  if Assigned(aItem^.Next) then
+    aItem^.Next^.Prev := aItem^.Prev;
+  case aItem^.ItemType of
+    tsItemTypeText, tsItemTypeSpace:
+      tsStrDispose(aItem^.Text);
+  end;
+  Dispose(aItem);
+  aItem := nil;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.FreeLineItems(var aItem: PtsLineItem);
+var
+  p: PtsLineItem;
+begin
+  while Assigned(aItem) do begin
+    p := aItem;
+    aItem := aItem^.Next;
+    FreeLineItem(p);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.FreeLines(var aItem: PtsBlockLine);
+var
+  p: PtsBlockLine;
+begin
+  while Assigned(aItem) do begin
+    p := aItem;
+    aItem := aItem^.Next;
+    FreeLineItems(p^.First);
+    p^.Last := nil;
+    Dispose(p);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsTextBlock.SplitText(aText: PWideChar): PtsLineItem;
+var
+  TextBegin: PWideChar;
+  TextLength: Integer;
+  State: TtsLineItemType;
+  LastItem: PtsLineItem;
+
+  procedure AddItem(const aItem: PtsLineItem);
+  begin
+    if Assigned(result) then begin
+      LastItem^.Next := aItem;
+      aItem^.Prev    := LastItem;
+      aItem^.Next    := nil;
+      LastItem       := aItem;
+    end;
+
+    if not Assigned(result) then begin
+      result   := aItem;
+      LastItem := aItem;
+    end;
+  end;
+
+  procedure ExtractWord;
+  var
+    p: PtsLineItem;
+    Text: PWideChar;
+  begin
+    if (State = tsItemTypeUnknown) then
+      exit;
+
+    new(p);
+    FillChar(p^, SizeOf(p^), #0);
+    p^.ItemType := State;
+
+    case State of
+      tsItemTypeText, tsItemTypeSpace: begin
+        p^.Text := tsStrAlloc(TextLength);
+        Text    := p^.Text;
+        while (TextBegin <> aText) do begin
+          Text^ := TextBegin^;
+          inc(Text,      1);
+          inc(TextBegin, 1);
+        end;
+        AddItem(p);
+      end;
+
+      tsItemTypeLineBreak, tsItemTypeTab: begin
+        AddItem(p);
+      end;
+
+    else
+      Dispose(p);
+    end;
+    TextBegin  := aText;
+    TextLength := 0;
+  end;
+
+begin
+  result     := nil;
+  LastItem   := nil;
+  TextBegin  := aText;
+  TextLength := 0;
+  State      := tsItemTypeUnknown;
+
+  if not Assigned(aText) then
+    exit;
+
+  while (aText^ <> #0) do begin
+    case aText^ of
+
+      // line breaks
+      #$000D, #$000A: begin
+        if (State <> tsItemTypeLineBreak) then begin
+          ExtractWord;
+          State := tsItemTypeLineBreak;
+        end else if (TextBegin^ <> #13) or (aText^ <> #10) or (TextBegin + 1 < aText) then
+          ExtractWord;
+      end;
+
+      // spaces
+      #$0020: begin
+        if (State <> tsItemTypeSpace) then
+          ExtractWord;
+        State := tsItemTypeSpace;
+      end;
+
+      // tabulator
+      #$0009: begin
+        ExtractWord;
+        State := tsItemTypeTab;
+      end;
+
+    else
+      if (State <> tsItemTypeText) then
+        ExtractWord;
+      State := tsItemTypeText;
+    end;
+
+    inc(aText,      1);
+    inc(TextLength, 1);
+  end;
+
+  if (TextBegin <> aText) then
+    ExtractWord;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsTextBlock.SplitIntoLines(aItem: PtsLineItem): Boolean;
+var
+  p: PtsLineItem;
+  tab: Integer;
+begin
+  result := false;
+  if not Assigned(fCurrentFont) then
+    exit;
+
+  result := true;
+  while Assigned(aItem) do begin
+    p := aItem;
+    aItem := aItem^.Next;
+    p^.Next := nil;
+    p^.Prev := nil;
+
+    if not Assigned(fLastLine) then
+      PushNewLine;
+
+    case p^.ItemType of
+      tsItemTypeText, tsItemTypeSpace: begin
+        // increment word counter
+        if (p^.ItemType = tsItemTypeSpace) then begin
+          if not (tsLastItemIsSpace in fLastLine^.Flags) then
+            inc(fLastLine^.meta.SpaceCount, 1);
+          Include(fLastLine^.Flags, tsLastItemIsSpace);
+        end else
+          Exclude(fLastLine^.Flags, tsLastItemIsSpace);
+
+        // update and check line width
+        p^.TextWidth := GetTextWidthW(p^.Text);
+        if (tsBlockFlagWordWrap in fFlags) and
+           (fLastLine^.meta.Width + p^.TextWidth > fWidth) then
+        begin
+          if (fLastLine^.meta.Width = 0) then begin
+            if not PushLineItem(p) then // if is first word, than add anyway
+              FreeLineItem(p);
+            p := nil;
+          end;
+          include(fLastLine^.Flags, tsAutoLineBreak);
+          PushNewLine;
+        end;
+
+        // add item
+        if Assigned(p) then begin
+          if not PushLineItem(p) then
+            FreeLineItem(p);
+          PushSpacing(fCurrentFont.CharSpacing);
+        end;
+      end;
+
+      tsItemTypeLineBreak: begin
+        if not PushLineItem(p) then
+          FreeLineItem(p);
+        PushNewLine;
+      end;
+
+      tsItemTypeTab: begin
+        tab := fCurrentFont.TabWidth * fCurrentFont.Metric.Size;
+        p^.TabWidth := (1 + fLastLine^.meta.Width div tab) * tab - fLastLine^.meta.Width;
+        if not PushLineItem(p) then
+          FreeLineItem(p);
+      end;
+
+    else
+      raise EtsException.Create('unexpected line item');
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.TrimSpaces(const aLine: PtsBlockLine);
+
+  procedure Trim(var aItem: PtsLineItem; const aMoveNext: Boolean);
+  var
+    tmp, p: PtsLineItem;
+    IsFirst: Boolean;
+  begin
+    IsFirst := true;
+    p       := aItem;
+    while Assigned(p) do begin
+      tmp := p;
+      if aMoveNext then
+        p := p^.Next
+      else
+        p := p^.Prev;
+
+      case  tmp^.ItemType of
+        tsItemTypeText: begin    //done
+          break;
+        end;
+
+        tsItemTypeSpace,
+        tsItemTypeSpacing: begin
+          // update line meta
+          if (tmp^.ItemType = tsItemTypeSpace) then begin
+            aLine^.meta.Width := aLine^.meta.Width - tmp^.TextWidth;
+            dec(aLine^.meta.SpaceCount, 1);
+          end else
+            aLine^.meta.Width := aLine^.meta.Width - tmp^.Spacing;
+
+          FreeLineItem(tmp);
+          if IsFirst then
+            aItem := p;
+        end;
+
+      else
+        IsFirst := false;
+      end;
+    end;
+  end;
+
+begin
+  if not Assigned(aLine) then
+    exit;
+  Trim(aLine^.First, true);
+  Trim(aLine^.Last,  false);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.UpdateLineMeta(const aLine: PtsBlockLine);
+var
+  metric: TtsTextMetric;
+begin
+  if not Assigned(fCurrentFont) or
+     not Assigned(aLine) then
+        exit;
+
+  fCurrentFont.GetTextMetric(metric);
+  if (tsMetaValid in aLine^.Flags) then begin
+    aLine^.meta.Height := max(
+      aLine^.meta.Height,
+      metric.LineHeight);
+    aLine^.meta.Spacing := max(
+      aLine^.meta.Spacing,
+      metric.LineSpacing);
+    aLine^.meta.Ascent := max(
+      aLine^.meta.Ascent,
+      metric.Ascent);
+  end else begin
+    Include(aLine^.Flags, tsMetaValid);
+    aLine^.meta.Height  := metric.LineHeight;
+    aLine^.meta.Spacing := metric.LineSpacing;
+    aLine^.meta.Ascent  := metric.Ascent;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.ChangeFont(const aFont: TtsFont);
+var
+  p: PtsLineItem;
+begin
+  if not Assigned(aFont) then
+    exit;
+  New(p);
+  FillChar(p^, SizeOf(p^), #0);
+  fCurrentFont  := aFont;
+  fCurrentChars := fRenderer.fCharCache.Chars[fCurrentFont];
+  p^.ItemType   := tsItemTypeFont;
+  p^.Font       := fCurrentFont;
+  PushLineItem(p);
+  UpdateLineMeta(fLastLine);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.ChangeColor(const aColor: TtsColor4f);
+var
+  p: PtsLineItem;
+begin
+  New(p);
+  FillChar(p^, SizeOf(p^), #0);
+  fCurrentColor := aColor;
+  p^.ItemType   := tsItemTypeColor;
+  p^.Color      := fCurrentColor;
+  PushLineItem(p);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsTextBlock.GetActualBlockHeight: Integer;
+var
+  line: PtsBlockLine;
+begin
+  result := 0;
+  line   := fFirstLine;
+  while Assigned(line) do begin
+    result := result + line^.meta.Height;
+    line := line^.Next;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.TextOutA(const aText: PAnsiChar);
+var
+  tmp: PWideChar;
+begin
+  tmp := fRenderer.Context.AnsiToWide(aText);
+  try
+    TextOutW(tmp);
+  finally
+    tsStrDispose(tmp);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.TextOutW(const aText: PWideChar);
+var
+  p: PtsLineItem;
+begin
+  p := SplitText(aText);
+  if not SplitIntoLines(p) then
+    FreeLineItems(p);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsTextBlock.GetTextWidthA(const aText: PAnsiChar): Integer;
+begin
+  result := 0;
+  if Assigned(fCurrentChars) then
+    result := fCurrentChars.GetTextWidthA(aText);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsTextBlock.GetTextWidthW(const aText: PWideChar): Integer;
+begin
+  result := 0;
+  if Assigned(fCurrentChars) then
+    result := fCurrentChars.GetTextWidthW(aText);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.Render;
+var
+  c: PWideChar;
+  pos: TtsPosition;
+  x, y, tmp, tab: Integer;
+  ExtraSpaceTotal, ExtraSpaceActual: Single;
+  r: TtsRect;
+  line: PtsBlockLine;
+  item: PtsLineItem;
+  font: TtsFont;
+  chars: TtsChars;
+  char: TtsChar;
+  metric: TtsTextMetric;
+  draw: Boolean;
+
+  procedure DrawItem;
+  begin
+    case item^.ItemType of
+      tsItemTypeFont: begin
+        font := item^.Font;
+        font.GetTextMetric(metric);
+        chars := fRenderer.fCharCache.Chars[font];
+      end;
+
+      tsItemTypeColor: begin
+        fRenderer.SetColor(item^.Color);
+      end;
+
+      tsItemTypeText: begin
+        if draw and Assigned(font) then begin
+          c := item^.Text;
+          while (c^ <> #0) do begin
+            if Assigned(chars) then begin
+              char := chars.AddChar(c^);
+              if Assigned(char) then begin
+                fRenderer.MoveDrawPos(tsPosition(0, -metric.BaseLineOffset));
+                fRenderer.Render(char.RenderRef);
+                fRenderer.MoveDrawPos(tsPosition(char.GlyphMetric.Advance + font.CharSpacing, metric.BaseLineOffset));
+              end;
+            end;
+            inc(c);
+          end;
+        end;
+      end;
+
+      tsItemTypeSpace: begin
+        if draw and Assigned(font) then begin
+          ExtraSpaceActual := ExtraSpaceActual + ExtraSpaceTotal;
+          c := item^.Text;
+          while (c^ <> #0) do begin
+            if Assigned(chars) then begin
+              char := chars.AddChar(c^);
+              if Assigned(char) then begin
+                if (font.Metric.Style * [tsStyleUnderline, tsStyleStrikeout] <> []) then begin
+                  fRenderer.MoveDrawPos(tsPosition(0, -metric.BaseLineOffset));
+                  fRenderer.Render(char.RenderRef);
+                  fRenderer.MoveDrawPos(tsPosition(char.GlyphMetric.Advance + font.CharSpacing, metric.BaseLineOffset));
+                end else begin
+                  fRenderer.MoveDrawPos(tsPosition(char.GlyphMetric.Advance + font.CharSpacing, 0));
+                end;
+              end;
+            end;
+            inc(c);
+          end;
+
+          tmp := Trunc(ExtraSpaceActual);
+          ExtraSpaceActual := ExtraSpaceActual - tmp;
+          if (font.Metric.Style * [tsStyleUnderline, tsStyleStrikeout] <> []) then begin
+            if Assigned(chars) then begin
+              char := chars.AddChar(#0);
+              if Assigned(char) then
+                fRenderer.Render(char.RenderRef, tmp);
+              // TODO draw lines; maybe with a temporary created fake char or something like an empty char?
+            end;
+          end;
+          fRenderer.MoveDrawPos(tsPosition(tmp, 0));
+        end;
+      end;
+
+      tsItemTypeLineBreak: begin
+        // because this should be the last item in a line, we have nothing to do here
+      end;
+
+      tsItemTypeTab: begin
+        // get current x pos and round it to TabWidth
+        pos := fRenderer.GetDrawPos;
+        tab := font.TabWidth * font.Metric.Size;
+        if (tab = 0) then
+          tab := 1;
+        pos.x := Left + (1 + (pos.x - Left) div tab) * tab;
+        fRenderer.SetDrawPos(pos);
+      end;
+
+      tsItemTypeSpacing: begin
+        fRenderer.MoveDrawPos(tsPosition(item^.Spacing, 0));
+      end;
+    end;
+  end;
+
+  procedure DrawLine;
+  begin
+    // check vertical clipping
+    case Clipping of
+      tsClipCharBorder, tsClipWordBorder:
+        draw := (y + line^.meta.Height > r.Top) and (y < r.Bottom);
+      tsClipCharComplete, tsClipWordComplete:
+        draw := (y > r.Top) and (y + line^.meta.Height < r.Bottom);
+    else
+      draw := true;
+    end;
+
+    // check horizontal alignment
+    x := r.Left;
+    ExtraSpaceTotal  := 0;
+    ExtraSpaceActual := 0;
+    case HorzAlign of
+      tsHorzAlignCenter:
+        x := r.Left + (Width div 2) - (line^.meta.Width div 2);
+      tsHorzAlignRight:
+        x := r.Right - line^.meta.Width;
+      tsHorzAlignJustify:
+        if (tsAutoLineBreak in line^.Flags) and (line^.meta.SpaceCount > 0) then
+          ExtraSpaceTotal := (Width - line^.meta.Width) / line^.meta.SpaceCount;
+    end;
+
+    if draw then
+      fRenderer.SetDrawPos(tsPosition(x, y + line^.meta.Ascent));
+    inc(y, line^.meta.Height + line^.meta.Spacing);
+    item := line^.First;
+    while Assigned(item) do begin
+      DrawItem;
+      item := item^.Next;
+    end;
+  end;
+
+begin
+  fRenderer.BeginRender;
+  try
+    // init variables
+    y    := Top;
+    r    := Rect;
+    font := nil;
+    line := fFirstLine;
+
+    // check vertical alignment
+    case VertAlign of
+      tsVertAlignCenter:
+        y := y + (Height div 2 - GetActualBlockHeight div 2);
+      tsVertAlignBottom:
+        y := y + (Height - GetActualBlockHeight);
+    end;
+
+    while Assigned(line) do begin
+      DrawLine;
+      line := line^.Next;
+    end;
+  finally
+    fRenderer.EndRender;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsTextBlock.Create(const aRenderer: TtsBlockRenderer; const aTop, aLeft, aWidth, aHeight: Integer; const aFlags: TtsBlockFlags);
+begin
+  inherited Create(aRenderer);
+  fRenderer := aRenderer;
+  fTop      := aTop;
+  fLeft     := aLeft;
+  fWidth    := aWidth;
+  fHeight   := aHeight;
+  fFlags    := aFlags;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsTextBlock.Destroy;
+begin
+  FreeLines(fFirstLine);
+  fLastLine := nil;
+  inherited Destroy;
+end;
+
+end.
+

utsTtfUtils.pas

@@ -1,326 +0,0 @@
-unit utsTtfUtils;
-
-{$IFDEF FPC}
-{$mode delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
-  Classes, SysUtils;
-
-const
-  NAME_ID_COPYRIGHT  = 0;
-  NAME_ID_FACE_NAME  = 1;
-  NAME_ID_STYLE_NAME = 2;
-  NAME_ID_FULL_NAME  = 4;
-
-function MakeTTTableName(const ch1, ch2, ch3, ch4: Char): Cardinal;
-function GetTTString(pBuffer: Pointer; BufferSize: Integer; NameID, LanguageID: Cardinal; out Text: String): Boolean;
-
-function GetTTFontFullNameFromStream(Stream: TStream; LanguageID: Cardinal): String;
-function GetTTFontFullNameFromFile(const aFilename: String; const aLanguageID: Cardinal): String;
-
-implementation
-
-uses
-  utsUtils;
-
-type
-  TT_OFFSET_TABLE = packed record
-  	uMajorVersion: Word;
-  	uMinorVersion: Word;
-	  uNumOfTables: Word;
-  	uSearchRange: Word;
-  	uEntrySelector: Word;
-	  uRangeShift: Word;
-  end;
-
-
-  TT_TABLE_DIRECTORY = packed record
-  	TableName: Cardinal;     // table name
-  	uCheckSum: Cardinal;  // Check sum
-	  uOffset: Cardinal;    // Offset from beginning of file
-	  uLength: Cardinal;    // length of the table in bytes
-  end;
-
-
-  TT_NAME_TABLE_HEADER = packed record
-  	uFSelector: Word;     //format selector. Always 0
-	  uNRCount: Word;       //Name Records count
-	  uStorageOffset: Word; //Offset for strings storage, from start of the table
-  end;
-
-  TT_NAME_RECORD = packed record
-  	uPlatformID: Word;
-	  uEncodingID: Word;
-	  uLanguageID: Word;
-	  uNameID: Word;
-	  uStringLength: Word;
-	  uStringOffset: Word;  //from start of storage area
-  end;
-
-const
-  PLATFORM_ID_APPLE_UNICODE = 0;
-  PLATFORM_ID_MACINTOSH     = 1;
-  PLATFORM_ID_MICROSOFT     = 3;
-
-function SWAPWORD(x: Word): Word;
-begin
-  Result := x and $FF;
-  Result := Result shl 8;
-  Result := Result or (x shr 8);
-end;
-
-function SWAPLONG(x: Cardinal): Cardinal;
-begin
-  Result := (x and $FF) shl 24;
-  x := x shr 8;
-
-  Result := Result or ((x and $FF) shl 16);
-  x := x shr 8;
-
-  Result := Result or ((x and $FF) shl 8);
-  x := x shr 8;
-
-  Result := Result or x;
-end;
-
-function GetTTTableData(Stream: TStream; TableName: Cardinal; pBuff: Pointer; var Size: Integer): Boolean;
-var
-  Pos: Int64;
-  OffsetTable: TT_OFFSET_TABLE;
-  TableDir: TT_TABLE_DIRECTORY;
-  Idx: Integer;
-begin
-  Result := False;
-
-  Pos := Stream.Position;
-
-  // Reading table header
-  Stream.Read(OffsetTable{%H-}, sizeof(TT_OFFSET_TABLE));
-  OffsetTable.uNumOfTables := SWAPWORD(OffsetTable.uNumOfTables);
-  OffsetTable.uMajorVersion := SWAPWORD(OffsetTable.uMajorVersion);
-  OffsetTable.uMinorVersion := SWAPWORD(OffsetTable.uMinorVersion);
-
-  //check is this is a true type font and the version is 1.0
-  if (OffsetTable.uMajorVersion <> 1) or (OffsetTable.uMinorVersion <> 0) then
-    Exit;
-
-  // seaching table with name
-  for Idx := 0 to OffsetTable.uNumOfTables -1 do begin
-    Stream.Read(TableDir{%H-}, sizeof(TT_TABLE_DIRECTORY));
-
-    if (TableName = TableDir.TableName) then begin
-      TableDir.uOffset := SWAPLONG(TableDir.uOffset);
-      TableDir.uLength := SWAPLONG(TableDir.uLength);
-
-      // copying tabledata
-      if (pBuff <> nil) and (Size >= Integer(TableDir.uLength)) then begin
-        Stream.Seek(TableDir.uOffset, soBeginning);
-        Size := Stream.Read(pBuff^, TableDir.uLength);
-
-        Result := (Size = Integer(TableDir.uLength));
-      end else
-
-      begin
-        // restoring streamposition
-        Stream.Position := Pos;
-
-        Size := TableDir.uLength;
-        Result := True;
-      end;
-
-      break;
-    end;
-  end;
-end;
-
-function MakeTTTableName(const ch1, ch2, ch3, ch4: Char): Cardinal;
-begin
-  Result := ord(ch4) shl 24 or ord(ch3) shl 16 or ord(ch2) shl 8 or ord(ch1);
-end;
-
-function GetTTString(pBuffer: Pointer; BufferSize: Integer; NameID, LanguageID: Cardinal; out Text: String): Boolean;
-var
-  pActBuffer: pByte;
-  ttNTHeader: TT_NAME_TABLE_HEADER;
-  ttRecord: TT_NAME_RECORD;
-  Idx: Integer;
-  Prio: Integer;
-
-  procedure ExtractName;
-  var
-    pTempBuffer: pByte;
-    pTemp: pWideChar;
-    uStringLengthH2: Word;
-
-    procedure SwapText(pText: pWideChar; Length: Word);
-    begin
-      while Length > 0 do begin
-        pWord(pText)^ := SWAPWORD(pWord(pText)^);
-        Inc(pText);
-        Dec(Length);
-      end;
-    end;
-
-  begin
-    Result := True;
-
-    ttRecord.uStringLength := SWAPWORD(ttRecord.uStringLength);
-    ttRecord.uStringOffset := SWAPWORD(ttRecord.uStringOffset);
-
-    uStringLengthH2 := ttRecord.uStringLength shr 1;
-
-    pTempBuffer := pBuffer;
-    Inc(pTempBuffer, ttNTHeader.uStorageOffset + ttRecord.uStringOffset);
-
-    // Unicode
-    if ((ttRecord.uPlatformID = PLATFORM_ID_MICROSOFT) and (ttRecord.uEncodingID in [0, 1])) or
-       ((ttRecord.uPlatformID = PLATFORM_ID_APPLE_UNICODE) and (ttRecord.uEncodingID > 0)) then begin
-      pTemp := tsStrAlloc(uStringLengthH2);
-      try
-        // uStringLengthH2 * 2 because possible buffer overrun
-        Move(pTempBuffer^, pTemp^, uStringLengthH2 * 2);
-
-        SwapText(pTemp, uStringLengthH2);
-
-        WideCharLenToStrVar(pTemp, uStringLengthH2, Text);
-      finally
-        tsStrDispose(pTemp);
-      end;
-    end else
-
-    // none unicode
-    begin
-      SetLength(Text, ttRecord.uStringLength);
-      Move(pTempBuffer^, Text[1], ttRecord.uStringLength);
-    end;
-  end;
-
-begin
-  Result := False;
-
-  pActBuffer := pBuffer;
-
-  Move(pActBuffer^, ttNTHeader{%H-}, sizeof(TT_NAME_TABLE_HEADER));
-  inc(pActBuffer, sizeof(TT_NAME_TABLE_HEADER));
-
-  ttNTHeader.uNRCount := SWAPWORD(ttNTHeader.uNRCount);
-  ttNTHeader.uStorageOffset := SWAPWORD(ttNTHeader.uStorageOffset);
-
-  Prio := -1;
-
-  for Idx := 0 to ttNTHeader.uNRCount -1 do begin
-    Move(pActBuffer^, ttRecord, sizeof(TT_NAME_RECORD));
-    Inc(pActBuffer, sizeof(TT_NAME_RECORD));
-
-    ttRecord.uNameID := SWAPWORD(ttRecord.uNameID);
-
-    if ttRecord.uNameID = NameID then begin
-      ttRecord.uPlatformID := SWAPWORD(ttRecord.uPlatformID);
-      ttRecord.uEncodingID := SWAPWORD(ttRecord.uEncodingID);
-      ttRecord.uLanguageID := SWAPWORD(ttRecord.uLanguageID);
-
-      // highest priority
-      if (ttRecord.uPlatformID = PLATFORM_ID_MICROSOFT) then begin
-        // system language
-        if (ttRecord.uLanguageID = languageID) then begin
-          if Prio <= 7 then begin
-            ExtractName;
-
-            Prio := 7;
-          end;
-        end else
-
-        // english
-        if (ttRecord.uLanguageID = 1033) then begin
-          if Prio <= 6 then begin
-            ExtractName;
-
-            Prio := 6;
-          end;
-        end else
-
-        // all else
-        if Prio <= 5 then begin
-          ExtractName;
-
-          Prio := 5;
-        end;
-      end else
-
-      // apple unicode
-      if (ttRecord.uPlatformID = PLATFORM_ID_APPLE_UNICODE) then begin
-        ExtractName;
-
-        Prio := 4;
-      end else
-
-      // macintosh
-      if (ttRecord.uPlatformID = PLATFORM_ID_MACINTOSH) then begin
-        // english
-        if (ttRecord.uLanguageID = 0) then begin
-          if Prio <= 3 then begin
-            ExtractName;
-
-            Prio := 3;
-          end;
-        end else
-
-        // all other
-        begin
-          ExtractName;
-
-          Prio := 2;
-        end;
-      end else
-
-      begin
-        if Prio <= 1 then begin
-          ExtractName;
-
-          Prio := 1;
-        end;
-      end;
-    end;
-  end;
-end;
-
-function GetTTFontFullNameFromStream(Stream: TStream; LanguageID: Cardinal): String;
-var
-  TableName: Cardinal;
-  Buffer: Pointer;
-  BufferSize: Integer;
-begin
-  TableName := MakeTTTableName('n', 'a', 'm', 'e');
-
-  BufferSize := 0;
-  if GetTTTableData(Stream, TableName, nil, BufferSize) then begin
-    GetMem(Buffer, BufferSize);
-    try
-      if GetTTTableData(Stream, TableName, Buffer, BufferSize) then begin
-        if not GetTTString(Buffer, BufferSize, NAME_ID_FULL_NAME, LanguageID, Result) then
-          if not GetTTString(Buffer, BufferSize, NAME_ID_FACE_NAME, LanguageID, Result) then
-            Result := '';
-      end;
-    finally
-      FreeMem(Buffer);
-    end;
-  end;
-end;
-
-function GetTTFontFullNameFromFile(const aFilename: String; const aLanguageID: Cardinal): String;
-var
-  fs: TFileStream;
-begin
-  fs := TFileStream.Create(aFilename, fmOpenRead or fmShareDenyWrite);
-  try
-    result := GetTTFontFullNameFromStream(fs, aLanguageID);
-  finally
-    fs.Free;
-  end;
-end;
-
-end.
-

utsTypes.pas

@@ -1,15 +1,15 @@
 unit utsTypes;
 
 {$IFDEF FPC}
-{$mode delphi}{$H+}
+  {$mode objfpc}{$H+}
 {$ENDIF}
 
 interface
 
-uses
-  Classes, SysUtils;
-
 type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Enumerations//////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
   {$Z4}
   TtsCodePage = (
     tsUTF8,
@@ -58,12 +58,12 @@ type
     tsISO_1257,
     tsISO_1258);
 
-  TtsFontStyle = (
-    tsStyleBold,
-    tsStyleItalic,
-    tsStyleUnderline,
-    tsStyleStrikeout);
-  TtsFontStyles = set of TtsFontStyle;
+  TtsFormat = (
+    tsFormatEmpty,
+    tsFormatRGBA8,
+    tsFormatLumAlpha8,
+    tsFormatAlpha8,
+    tsFormatLum8);
 
   TtsVertAlignment = (
     tsVertAlignTop,
@@ -76,17 +76,33 @@ type
     tsHorzAlignRight,
     tsHorzAlignJustify);
 
-  TtsFormat = (
-    tsFormatEmpty,
-    tsFormatRGBA8,
-    tsFormatLumAlpha8,
-    tsFormatAlpha8,
-    tsFormatLum8);
+  TtsClipping = (
+    tsClipNone,           // no clipping
+    tsClipWordBorder,     // draw all words that have at least one pixel inside the box
+    tsClipCharBorder,     // draw all chars that have at least one pixel inside the box
+    tsClipWordComplete,   // draw all words that are completly inside the box
+    tsClipCharComplete    // draw all chars that are completly inside the box
+  );
 
   TtsAntiAliasing = (
     tsAANone,
     tsAANormal);
 
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Flags/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsBlockFlag = (
+    tsBlockFlagWordWrap
+  );
+  TtsBlockFlags = set of TtsBlockFlag;
+
+  TtsFontStyle = (
+    tsStyleBold,
+    tsStyleItalic,
+    tsStyleUnderline,
+    tsStyleStrikeout);
+  TtsFontStyles = set of TtsFontStyle;
+
   TtsColorChannel = (
     tsChannelRed,
     tsChannelGreen,
@@ -99,72 +115,42 @@ type
     tsModeReplace,
     tsModeModulate);
   TtsImageModes = array[TtsColorChannel] of TtsImageMode;
-  TtsImageModeFunc = function(const aSource, aDest: Single): Single;
 
-  TtsFontProperties = packed record
-    Fontname: String;
-    Copyright: String;
-    FaceName: String;
-    StyleName: String;
-    FullName: String;
-
-    Size: Integer;
-    Style: TtsFontStyles;
-    AntiAliasing: TtsAntiAliasing;
-    DefaultChar: WideChar;
-
-    Ascent: Integer;
-    Descent: Integer;
-    ExternalLeading: Integer;
-    BaseLineOffset: Integer;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Structures////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsRenderRef = Pointer;
+  PtsCodePageValues = ^TtsCodePageValues;
+  TtsCodePageValues = array [AnsiChar] of word;
 
-    UnderlinePos: Integer;
-    UnderlineSize: Integer;
-    StrikeoutPos: Integer;
-    StrikeoutSize: Integer;
+  PtsColor4f = ^TtsColor4f;
+  TtsColor4f = packed record
+  case Boolean of
+    true:  (r, g, b, a: Single);
+    false: (arr: array[0..3] of Single);
   end;
 
+  PtsPosition = ^TtsPosition;
   TtsPosition = packed record
     x, y: Integer;
   end;
-  PtsPosition = ^TtsPosition;
-
-  TtsPositionF = packed record
-    x, y: Single;
-  end;
-  PtsPositionF = ^TtsPositionF;
 
-  TtsRect = packed record
-    case Byte of
-      0: (TopLeft: TtsPosition; BottomRight: TtsPosition);
-      1: (Left, Top, Right, Bottom: Integer);
-  end;
   PtsRect = ^TtsRect;
-
-  TtsRectF = packed record
-    case Byte of
-      0: (TopLeft: TtsPositionF; BottomRight: TtsPositionF);
-      1: (Left, Top, Right, Bottom: Single);
-  end;
-  PtsRectF = ^TtsRectF;
-
-  TtsColor4f = packed record
-    case Boolean of
-      true:  (r, g, b, a: Single);
-      false: (arr: array[0..3] of Single);
-  end;
-  PtsColor4f = ^TtsColor4f;
-
-  TtsColor4ub = packed record
-    case Boolean of
-      true:  (r, g, b, a: Byte);
-      false: (arr: array[0..3] of Byte);
+  TtsRect = packed record
+  case Byte of
+    0: (TopLeft: TtsPosition; BottomRight: TtsPosition);
+    1: (Left, Top, Right, Bottom: Integer);
   end;
-  PtsColor4ub = ^TtsColor4ub;
 
   TtsVector4f = array[0..3] of Single;
   TtsMatrix4f = array[0..3] of TtsVector4f;
 
+  TtsGlyphMetric = packed record
+    GlyphOrigin: TtsPosition;
+    GlyphRect: TtsRect;
+    Advance: Integer;
+  end;
+
   TtsTextMetric = packed record
     Ascent: Integer;
     Descent: Integer;
@@ -175,239 +161,36 @@ type
     LineSpacing: Integer;
   end;
 
-  TtsBlendFunc = function(const aSrc, aDst: TtsColor4f): TtsColor4f;
-
-const
-  TS_CHANNELS_RGB:  TtsColorChannels = [tsChannelRed, tsChannelGreen, tsChannelBlue];
-  TS_CHANNELS_RGBA: TtsColorChannels = [tsChannelRed, tsChannelGreen, tsChannelBlue, tsChannelAlpha];
-
-  TS_MODES_REPLACE_ALL:    TtsImageModes = (tsModeReplace,  tsModeReplace,  tsModeReplace,  tsModeReplace);
-  TS_MODES_MODULATE_ALL:   TtsImageModes = (tsModeModulate, tsModeModulate, tsModeModulate, tsModeModulate);
-  TS_MODES_MODULATE_ALPHA: TtsImageModes = (tsModeReplace,  tsModeReplace,  tsModeReplace,  tsModeModulate);
-
-  TS_MATRIX_IDENTITY: TtsMatrix4f = ((1, 0, 0, 0), (0, 1, 0, 0), (0, 0, 1, 0), (0, 0, 0, 1));
-
-function tsColor4f(r, g, b, a: Single): TtsColor4f;
-function tsModes(r, g, b, a: TtsImageMode): TtsImageModes;
-function tsRect(const l, t, r, b: Integer): TtsRect;
-function tsPosition(const x, y: Integer): TtsPosition;
-function tsPositionF(const x, y: Single): TtsPositionF;
-function tsVector4f(X, Y, Z, W: Single): TtsVector4f;
-function tsMatrix4f(X, Y, Z, P: TtsVector4f): TtsMatrix4f;
-
-function  tsFormatSize(const aFormat: TtsFormat): Integer;
-procedure tsFormatMap(const aFormat: TtsFormat; var aData: PByte; const aColor: TtsColor4f);
-procedure tsFormatUnmap(const aFormat: TtsFormat; var aData: PByte; out aColor: TtsColor4f);
-
-function tsImageModeFuncIgnore(const aSource, aDest: Single): Single;
-function tsImageModeFuncReplace(const aSource, aDest: Single): Single;
-function tsImageModeFuncModulate(const aSource, aDest: Single): Single;
-
-function tsBlendFundAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
-function tsBlendFundAdditive(const aSrc, aDst: TtsColor4f): TtsColor4f;
-function tsBlendFundAdditiveAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
-
-implementation
-
-uses
-  Math;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsColor4f(r, g, b, a: Single): TtsColor4f;
-begin
-  result.r := r;
-  result.g := g;
-  result.b := b;
-  result.a := a;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsModes(r, g, b, a: TtsImageMode): TtsImageModes;
-begin
-  result[tsChannelRed]   := r;
-  result[tsChannelGreen] := g;
-  result[tsChannelBlue]  := b;
-  result[tsChannelAlpha] := a;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsRect(const l, t, r, b: Integer): TtsRect;
-begin
-  result.Left   := l;
-  result.Top    := t;
-  result.Right  := r;
-  result.Bottom := b;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsPosition(const x, y: Integer): TtsPosition;
-begin
-  result.x := x;
-  result.y := y;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsPositionF(const x, y: Single): TtsPositionF;
-begin
-  result.x := x;
-  result.y := y;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsVector4f(X, Y, Z, W: Single): TtsVector4f;
-begin
-  result[0] := X;
-  result[1] := Y;
-  result[2] := Z;
-  result[3] := W;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsMatrix4f(X, Y, Z, P: TtsVector4f): TtsMatrix4f;
-begin
-  result[0] := X;
-  result[1] := Y;
-  result[2] := Z;
-  result[3] := P;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsFormatSize(const aFormat: TtsFormat): Integer;
-begin
-  case aFormat of
-    tsFormatRGBA8:      result := 4;
-    tsFormatLumAlpha8:  result := 2;
-    tsFormatAlpha8:     result := 1;
-    tsFormatLum8:       result := 1;
-  else
-    result := 0;
-  end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure tsFormatMap(const aFormat: TtsFormat; var aData: PByte; const aColor: TtsColor4f);
-var
-  i: Integer;
-  s: Single;
-begin
-  case aFormat of
-    tsFormatRGBA8: begin
-      for i := 0 to 3 do begin
-        aData^ := Trunc($FF * min(aColor.arr[i], 1.0));
-        inc(aData);
-      end;
-    end;
-
-    tsFormatLumAlpha8: begin
-      s := 0.30 * min(aColor.r, 1.0) +
-           0.59 * min(aColor.g, 1.0) +
-           0.11 * min(aColor.b, 1.0);
-      aData^ := Trunc($FF * s);
-      inc(aData);
-      aData^ := Trunc($FF * min(aColor.a, 1.0));
-      inc(aData);
-    end;
-
-    tsFormatAlpha8: begin
-      aData^ := Trunc($FF * min(aColor.a, 1.0));
-      inc(aData);
-    end;
-
-    tsFormatLum8: begin
-      s := 0.30 * min(aColor.r, 1.0) +
-           0.59 * min(aColor.g, 1.0) +
-           0.11 * min(aColor.b, 1.0);
-      aData^ := Trunc($FF * s);
-      inc(aData);
-    end;
-  end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure tsFormatUnmap(const aFormat: TtsFormat; var aData: PByte; out aColor: TtsColor4f);
-var
-  i: Integer;
-begin
-  case aFormat of
-    tsFormatRGBA8: begin
-      for i := 0 to 3 do begin
-        aColor.arr[i] := aData^ / $FF;
-        inc(aData);
-      end;
-    end;
+  TtsFontMetric = packed record
+    Fontname: String;
+    Copyright: String;
+    FaceName: String;
+    StyleName: String;
+    FullName: String;
 
-    tsFormatLumAlpha8: begin
-      aColor.r := aData^ / $FF;
-      aColor.g := aData^ / $FF;
-      aColor.b := aData^ / $FF;
-      inc(aData);
-      aColor.a := aData^ / $FF;
-      inc(aData);
-    end;
+    Size: Integer;
+    Style: TtsFontStyles;
+    AntiAliasing: TtsAntiAliasing;
+    DefaultChar: WideChar;
 
-    tsFormatAlpha8: begin
-      aColor.r := 1.0;
-      aColor.g := 1.0;
-      aColor.b := 1.0;
-      aColor.a := aData^ / $FF;
-      inc(aData);
-    end;
+    Ascent: Integer;
+    Descent: Integer;
+    ExternalLeading: Integer;
+    BaseLineOffset: Integer;
 
-    tsFormatLum8: begin
-      aColor.r := aData^ / $FF;
-      aColor.g := aData^ / $FF;
-      aColor.b := aData^ / $FF;
-      aColor.a := 1.0;
-      inc(aData);
-    end;
+    UnderlinePos: Integer;
+    UnderlineSize: Integer;
+    StrikeoutPos: Integer;
+    StrikeoutSize: Integer;
   end;
-end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsImageModeFuncIgnore(const aSource, aDest: Single): Single;
-begin
-  result := aDest;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsImageModeFuncReplace(const aSource, aDest: Single): Single;
-begin
-  result := aSource;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsImageModeFuncModulate(const aSource, aDest: Single): Single;
-begin
-  result := aSource * aDest;
-end;
-
-////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsBlendFundAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
-var
-  i: Integer;
-begin
-  for i := 0 to 2 do
-    result.arr[i] := aSrc.arr[i] * aSrc.a + aDst.arr[i] * (1 - aSrc.a);
-  result.a := aSrc.a + aDst.a * (1 - aSrc.a);
-end;
-
+//Callbacks/////////////////////////////////////////////////////////////////////////////////////////////////////////////
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function tsBlendFundAdditive(const aSrc, aDst: TtsColor4f): TtsColor4f;
-var
-  i: Integer;
-begin
-  for i := 0 to 3 do
-    result.arr[i] := aSrc.arr[i] + aDst.arr[i];
-end;
+  TtsBlendValueFunc = function(const aSrc, aDst: Single): Single;
+  TtsBlendColorFunc = function(const aSrc, aDst: TtsColor4f): TtsColor4f;
 
-function tsBlendFundAdditiveAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
-var
-  i: Integer;
-begin
-  for i := 0 to 2 do
-    result.arr[i] := aSrc.arr[i] * aSrc.a + aDst.arr[i];
-  result.a := aDst.a;
-end;
+implementation
 
 end.
 

utsUtils.pas

@@ -1,30 +1,386 @@
 unit utsUtils;
 
 {$IFDEF FPC}
-{$mode delphi}{$H+}
+  {$mode objfpc}{$H+}
 {$ENDIF}
 
 interface
 
 uses
-  Classes, SysUtils, utsTypes;
+  Classes, SysUtils, Contnrs,
+  utsTypes;
 
-function  tsStrAlloc(aSize: Cardinal): PWideChar;
-function  tsStrNew(const aText: PWideChar): PWideChar;
-procedure tsStrDispose(const aText: PWideChar);
-function  tsStrLength(aText: PWideChar): Cardinal;
-function  tsStrCopy(aDst, aSrc: PWideChar): PWideChar;
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsRefManager = class(TObject)
+  private
+    fMasterRef: TtsRefManager;
+    fSlaveRefs: TObjectList;
+  protected
+    procedure AddSlave(const aSlave: TtsRefManager); virtual;
+    procedure DelSlave(const aSlave: TtsRefManager); virtual;
+  public
+    constructor Create(const aMaster: TtsRefManager);
+    destructor Destroy; override;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsMultiMasterRefManager = class(TtsRefManager)
+  private
+    fMasterRefs: TObjectList;
+  public
+    procedure AddMaster(const aMaster: TtsRefManager); virtual;
+    procedure DelMaster(const aMaster: TtsRefManager); virtual;
+
+    constructor Create(const aMaster: TtsRefManager);
+    destructor Destroy; override;
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsKernel1DItem = packed record
+    Offset: Integer;
+    Value: Single;
+  end;
+
+  TtsKernel1D = class
+  public
+    Size: Integer;
+    Items: array of TtsKernel1DItem;
+    ItemCount: Integer;
+    constructor Create(const aRadius, aStrength: Single);
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  TtsKernel2DItem = packed record
+    OffsetX: Integer;
+    OffsetY: Integer;
+    Value: Double;
+    DataOffset: Integer;
+  end;
+
+  TtsKernel2D = class
+  public
+    SizeX: Integer;
+    SizeY: Integer;
+
+    MidSizeX: Integer;
+    MidSizeY: Integer;
+
+    ValueSum: Double;
+
+    Items: array of TtsKernel2DItem;
+    ItemCount: Integer;
+
+    constructor Create(const aRadius, aStrength: Single);
+  end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  EtsException = class(Exception);
+  EtsRenderer = class(EtsException);
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  function tsColor4f(r, g, b, a: Single): TtsColor4f;
+  function tsPosition(const x, y: Integer): TtsPosition;
+  function tsRect(const l, t, r, b: Integer): TtsRect; overload;
+  function tsRect(const aTopLeft, aBottomRight: TtsPosition): TtsRect; overload;
+  function tsVector4f(X, Y, Z, W: Single): TtsVector4f;
+  function tsMatrix4f(X, Y, Z, P: TtsVector4f): TtsMatrix4f;
+
+  function  tsFormatSize(const aFormat: TtsFormat): Integer;
+  procedure tsFormatMap(const aFormat: TtsFormat; var aData: PByte; const aColor: TtsColor4f);
+  procedure tsFormatUnmap(const aFormat: TtsFormat; var aData: PByte; out aColor: TtsColor4f);
+
+  function tsBlendValueIgnore(const aSrc, aDst: Single): Single;
+  function tsBlendValueReplace(const aSrc, aDst: Single): Single;
+  function tsBlendValueModulate(const aSrc, aDst: Single): Single;
 
-function  tsAnsiToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar; const aCodePage: TtsCodePage; const aDefaultChar: WideChar): Integer;
-function  tsISO_8859_1ToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar): Integer;
-function  tsUTF8ToWide(aDst: PWideChar; const aSize: Integer; const aSrc: PAnsiChar; const aDefaultChar: WideChar): Integer;
-function  tsUTFBE16ToWide(aDst: PWideChar; const aDstSize: Integer; aSrc: PByte; aSrcSize: Integer; const aDefaultChar: WideChar): Integer;
-function  tsAnsiSBCDToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar; const aCodePage: TtsCodePage; const aDefaultChar: WideChar): Integer;
+  function tsBlendColorAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
+  function tsBlendColorAdditive(const aSrc, aDst: TtsColor4f): TtsColor4f;
+  function tsBlendColorAdditiveAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
+
+  function  tsStrAlloc(aSize: Cardinal): PWideChar;
+  function  tsStrNew(const aText: PWideChar): PWideChar;
+  procedure tsStrDispose(const aText: PWideChar);
+  function  tsStrLength(aText: PWideChar): Cardinal;
+  function  tsStrCopy(aDst, aSrc: PWideChar): PWideChar;
+
+  function  tsAnsiToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar; const aCodePage: TtsCodePage; const aDefaultChar: WideChar): Integer;
+  function  tsISO_8859_1ToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar): Integer;
+  function  tsUTF8ToWide(aDst: PWideChar; const aSize: Integer; const aSrc: PAnsiChar; const aDefaultChar: WideChar): Integer;
+  function  tsUTFBE16ToWide(aDst: PWideChar; const aDstSize: Integer; aSrc: PByte; aSrcSize: Integer; const aDefaultChar: WideChar): Integer;
+  function  tsAnsiSBCDToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar; const aCodePage: TtsCodePage; const aDefaultChar: WideChar): Integer;
 
 implementation
 
 uses
-  utsCodePages;
+  math,
+  utsConstants;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsRefManager/////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRefManager.AddSlave(const aSlave: TtsRefManager);
+begin
+  if Assigned(fSlaveRefs) then
+    fSlaveRefs.Add(aSlave);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRefManager.DelSlave(const aSlave: TtsRefManager);
+begin
+  if Assigned(fSlaveRefs) then
+    fSlaveRefs.Remove(aSlave);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsRefManager.Create(const aMaster: TtsRefManager);
+begin
+  inherited Create;
+  fMasterRef := aMaster;
+  fSlaveRefs := TObjectList.Create(false);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsRefManager.Destroy;
+var
+  m: TtsRefManager;
+begin
+  fSlaveRefs.OwnsObjects := true;
+  FreeAndNil(fSlaveRefs);
+  m := fMasterRef;
+  fMasterRef := nil;
+  if Assigned(m) then
+    m.DelSlave(self);
+  inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsMultiMasterRefManager//////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsMultiMasterRefManager.AddMaster(const aMaster: TtsRefManager);
+begin
+  if Assigned(fMasterRefs) then begin
+    fMasterRefs.Add(aMaster);
+    aMaster.AddSlave(self);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsMultiMasterRefManager.DelMaster(const aMaster: TtsRefManager);
+begin
+  if Assigned(fMasterRefs) then begin
+    if (fMasterRefs.Remove(aMaster) >= 0) then
+      aMaster.DelSlave(self);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsMultiMasterRefManager.Create(const aMaster: TtsRefManager);
+begin
+  inherited Create(aMaster);
+  fMasterRefs := TObjectList.Create(false);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsMultiMasterRefManager.Destroy;
+var
+  i: Integer;
+begin
+  for i := fMasterRefs.Count-1 downto 0 do
+    DelMaster(fMasterRefs[i] as TtsRefManager);
+  inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//Helper Methods////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsColor4f(r, g, b, a: Single): TtsColor4f;
+begin
+  result.r := r;
+  result.g := g;
+  result.b := b;
+  result.a := a;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsPosition(const x, y: Integer): TtsPosition;
+begin
+  result.x := x;
+  result.y := y;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsRect(const l, t, r, b: Integer): TtsRect;
+begin
+  result.Left   := l;
+  result.Top    := t;
+  result.Right  := r;
+  result.Bottom := b;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsRect(const aTopLeft, aBottomRight: TtsPosition): TtsRect;
+begin
+  result.TopLeft     := aTopLeft;
+  result.BottomRight := aBottomRight;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsVector4f(X, Y, Z, W: Single): TtsVector4f;
+begin
+  result[0] := X;
+  result[1] := Y;
+  result[2] := Z;
+  result[3] := W;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsMatrix4f(X, Y, Z, P: TtsVector4f): TtsMatrix4f;
+begin
+  result[0] := X;
+  result[1] := Y;
+  result[2] := Z;
+  result[3] := P;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsFormatSize(const aFormat: TtsFormat): Integer;
+begin
+  case aFormat of
+    tsFormatRGBA8:      result := 4;
+    tsFormatLumAlpha8:  result := 2;
+    tsFormatAlpha8:     result := 1;
+    tsFormatLum8:       result := 1;
+  else
+    result := 0;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure tsFormatMap(const aFormat: TtsFormat; var aData: PByte; const aColor: TtsColor4f);
+var
+  i: Integer;
+  s: Single;
+begin
+  case aFormat of
+    tsFormatRGBA8: begin
+      for i := 0 to 3 do begin
+        aData^ := Trunc($FF * min(aColor.arr[i], 1.0));
+        inc(aData);
+      end;
+    end;
+
+    tsFormatLumAlpha8: begin
+      s := 0.30 * min(aColor.r, 1.0) +
+           0.59 * min(aColor.g, 1.0) +
+           0.11 * min(aColor.b, 1.0);
+      aData^ := Trunc($FF * s);
+      inc(aData);
+      aData^ := Trunc($FF * min(aColor.a, 1.0));
+      inc(aData);
+    end;
+
+    tsFormatAlpha8: begin
+      aData^ := Trunc($FF * min(aColor.a, 1.0));
+      inc(aData);
+    end;
+
+    tsFormatLum8: begin
+      s := 0.30 * min(aColor.r, 1.0) +
+           0.59 * min(aColor.g, 1.0) +
+           0.11 * min(aColor.b, 1.0);
+      aData^ := Trunc($FF * s);
+      inc(aData);
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure tsFormatUnmap(const aFormat: TtsFormat; var aData: PByte; out aColor: TtsColor4f);
+var
+  i: Integer;
+begin
+  case aFormat of
+    tsFormatRGBA8: begin
+      for i := 0 to 3 do begin
+        aColor.arr[i] := aData^ / $FF;
+        inc(aData);
+      end;
+    end;
+
+    tsFormatLumAlpha8: begin
+      aColor.r := aData^ / $FF;
+      aColor.g := aData^ / $FF;
+      aColor.b := aData^ / $FF;
+      inc(aData);
+      aColor.a := aData^ / $FF;
+      inc(aData);
+    end;
+
+    tsFormatAlpha8: begin
+      aColor.r := 1.0;
+      aColor.g := 1.0;
+      aColor.b := 1.0;
+      aColor.a := aData^ / $FF;
+      inc(aData);
+    end;
+
+    tsFormatLum8: begin
+      aColor.r := aData^ / $FF;
+      aColor.g := aData^ / $FF;
+      aColor.b := aData^ / $FF;
+      aColor.a := 1.0;
+      inc(aData);
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsBlendValueIgnore(const aSrc, aDst: Single): Single;
+begin
+  result := aDst;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsBlendValueReplace(const aSrc, aDst: Single): Single;
+begin
+  result := aSrc;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsBlendValueModulate(const aSrc, aDst: Single): Single;
+begin
+  result := aSrc * aDst;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsBlendColorAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
+var
+  i: Integer;
+begin
+  for i := 0 to 2 do
+    result.arr[i] := aSrc.arr[i] * aSrc.a + aDst.arr[i] * (1 - aSrc.a);
+  result.a := aSrc.a + aDst.a * (1 - aSrc.a);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsBlendColorAdditive(const aSrc, aDst: TtsColor4f): TtsColor4f;
+var
+  i: Integer;
+begin
+  for i := 0 to 3 do
+    result.arr[i] := aSrc.arr[i] + aDst.arr[i];
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function tsBlendColorAdditiveAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
+var
+  i: Integer;
+begin
+  for i := 0 to 2 do
+    result.arr[i] := aSrc.arr[i] * aSrc.a + aDst.arr[i];
+  result.a := aDst.a;
+end;
 
 ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 function tsStrAlloc(aSize: Cardinal): PWideChar;
@@ -205,7 +561,7 @@ var
   cp: PtsCodePageValues;
 begin
   result := 0;
-  cp := ANSI_TO_WIDE_CODE_PAGE_LUT[aCodePage];
+  cp := TS_CODE_PAGE_LUT[aCodePage];
   if not Assigned(aDst) or
      not Assigned(aSrc) or
      not Assigned(cp) or
@@ -226,5 +582,164 @@ begin
   end;
 end;
 
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsKernel1D///////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsKernel1D.Create(const aRadius, aStrength: Single);
+var
+  TempRadius, SQRRadius, TempStrength, TempValue: Double;
+  Idx: Integer;
+
+  function CalcValue(const aIndex: Integer): Single;
+  var
+    Temp: Double;
+  begin
+    Temp   := Max(0, Abs(aIndex) - TempStrength);
+    Temp   := Sqr(Temp * TempRadius) / SQRRadius;
+    result := Exp(-Temp);
+  end;
+
+begin
+  inherited Create;
+
+  // calculate new radius and strength
+  TempStrength := Min(aRadius - 1, aRadius * aStrength);
+  TempRadius   := aRadius - TempStrength;
+  SQRRadius    := sqr(TempRadius) * sqr(TempRadius);
+
+  // caluculating size of the kernel
+  Size := Round(TempRadius);
+  while CalcValue(Size) > 0.001 do
+    Inc(Size);
+  Size      := Size -1;
+  ItemCount := Size * 2 +1;
+  SetLength(Items, ItemCount);
+
+  // calculate Value (yes thats right. there is no -1)
+  for Idx := 0 to Size do begin
+    TempValue := CalcValue(Idx);
+
+    with Items[Size + Idx] do begin
+      Offset := Idx;
+      Value := TempValue;
+    end;
+
+    with Items[Size - Idx] do begin
+      Offset := -Idx;
+      Value := TempValue;
+    end;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsKernel2D///////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsKernel2D.Create(const aRadius, aStrength: Single);
+var
+  tmpStrenght: Double;
+  tmpRadius: Double;
+  tmpValue: Double;
+  sqrRadius: Double;
+  x, y, w, h: Integer;
+
+  function CalcValue(const aIndex: Double): Double;
+  begin
+    result := max(0, Abs(aIndex) - tmpStrenght);
+    result := Sqr(result * tmpRadius) / sqrRadius;
+    result := Exp(-result);
+  end;
+
+  procedure CalcSize(var aSize, aMidSize: Integer);
+  begin
+    aSize    := 0;
+    aMidSize := 0;
+    while CalcValue(aSize) > 0.5 do begin
+      inc(aSize,    1);
+      inc(aMidSize, 1);
+    end;
+    while CalcValue(aSize) > 0.001 do
+      Inc(aSize, 1);
+  end;
+
+  procedure SetItem(const x, y: Integer);
+  begin
+    with Items[(SizeY + y) * w + (SizeX + x)] do begin
+      OffsetX := x;
+      OffsetY := y;
+      Value   := tmpValue;
+    end;
+  end;
+
+  procedure QuickSort(l, r: Integer);
+  var
+    _l, _r: Integer;
+    p, t: TtsKernel2DItem;
+  begin
+    repeat
+      _l := l;
+      _r := r;
+      p := Items[(l + r) shr 1];
+
+      repeat
+        while (Items[_l].Value > p.Value) do
+          inc(_l, 1);
+
+        while (Items[_r].Value < p.Value) do
+          dec(_r, 1);
+
+        if (_l <= _r) then begin
+          t         := Items[_l];
+          Items[_l] := Items[_r];
+          Items[_r] := t;
+          inc(_l, 1);
+          dec(_r, 1);
+        end;
+      until (_l > _r);
+
+      if (l < _r) then
+        QuickSort(l, _r);
+
+      l := _l;
+    until (_l >= r);
+  end;
+
+begin
+  inherited Create;
+
+  tmpStrenght := Min(aRadius - 1.0, aRadius * aStrength);
+  tmpRadius   := aRadius - tmpStrenght;
+  sqrRadius   := sqr(tmpRadius) * sqr(tmpRadius);
+
+  CalcSize(SizeX, MidSizeX);
+  CalcSize(SizeY, MidSizeY);
+
+  ValueSum  := 0.0;
+  w         := 2 * SizeX + 1;
+  h         := 2 * SizeY + 1;
+  ItemCount := w * h;
+  SetLength(Items, ItemCount);
+
+  for y := 0 to SizeY do begin
+    for x := 0 to SizeX do begin
+      tmpValue := CalcValue(sqrt(Sqr(x) + Sqr(y)));
+
+      SetItem( x,  y);
+      SetItem( x, -y);
+      SetItem(-x, -y);
+      SetItem(-x,  y);
+
+      ValueSum := ValueSum + tmpValue;
+      if (x > 0) and (y > 0) then
+        ValueSum := ValueSum + tmpValue;
+    end;
+  end;
+
+  QuickSort(0, ItemCount-1);
+
+  while (Items[ItemCount-1].Value < 0.001) do
+    dec(ItemCount, 1);
+  SetLength(Items, ItemCount);
+end;
+
 end.