diff --git a/.gitmodules b/.gitmodules
index c86d273..e69de29 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -1,3 +0,0 @@
-[submodule "OpenGLCore"]
- path = OpenGLCore
- url = ../lazopenglcore.git
diff --git a/OpenGLCore b/OpenGLCore
deleted file mode 160000
index f6ca47e..0000000
--- a/OpenGLCore
+++ /dev/null
@@ -1 +0,0 @@
-Subproject commit f6ca47eeb2c217505d9c1babe79d46b6668d3881
diff --git a/doc/glyph metric.png b/doc/glyph metric.png
new file mode 100644
index 0000000..b345c78
Binary files /dev/null and b/doc/glyph metric.png differ
diff --git a/examples/PostProcess/PostProcess.lpi b/examples/PostProcess/PostProcess.lpi
new file mode 100644
index 0000000..433ffee
--- /dev/null
+++ b/examples/PostProcess/PostProcess.lpi
@@ -0,0 +1,83 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/PostProcess/PostProcess.lpr b/examples/PostProcess/PostProcess.lpr
new file mode 100644
index 0000000..a37c734
--- /dev/null
+++ b/examples/PostProcess/PostProcess.lpr
@@ -0,0 +1,21 @@
+program PostProcess;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, uMainForm
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
+
diff --git a/examples/PostProcess/uMainForm.lfm b/examples/PostProcess/uMainForm.lfm
new file mode 100644
index 0000000..015038a
--- /dev/null
+++ b/examples/PostProcess/uMainForm.lfm
@@ -0,0 +1,12 @@
+object MainForm: TMainForm
+ Left = 473
+ Height = 600
+ Top = 244
+ Width = 800
+ Caption = 'MainForm'
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnPaint = FormPaint
+ Position = poScreenCenter
+ LCLVersion = '1.3'
+end
diff --git a/examples/PostProcess/uMainForm.pas b/examples/PostProcess/uMainForm.pas
new file mode 100644
index 0000000..8706bb4
--- /dev/null
+++ b/examples/PostProcess/uMainForm.pas
@@ -0,0 +1,145 @@
+unit uMainForm;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
+ uglcContext,
+ utsTextSuite, utsRendererOpenGL, utsFontCreatorGDI, utsTypes, utsPostProcess;
+
+type
+ TMainForm = class(TForm)
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormPaint(Sender: TObject);
+ private
+ fContext: TglcContext;
+ ftsContext: TtsContext;
+ ftsRenderer: TtsRendererOpenGL;
+ ftsCreator1: TtsFontGeneratorGDI;
+ ftsCreator2: TtsFontGeneratorGDI;
+ ftsFont1: TtsFont;
+ ftsFont2: TtsFont;
+ procedure Render;
+ public
+ { public declarations }
+ end;
+
+var
+ MainForm: TMainForm;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ dglOpenGL;
+
+const
+ TEST_TEXT = 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum.';
+
+procedure TMainForm.FormCreate(Sender: TObject);
+var
+ pf: TglcContextPixelFormatSettings;
+ pp: TtsPostProcessStep;
+ img: TtsImage;
+
+const
+ PATTER_DATA: array[0..15] of Byte = (
+ $FF, $BF, $7F, $BF,
+ $BF, $FF, $BF, $7F,
+ $7F, $BF, $FF, $BF,
+ $BF, $7F, $BF, $FF);
+
+begin
+ pf := TglcContext.MakePF();
+ fContext := TglcContext.GetPlatformClass.Create(self, pf);
+ fContext.BuildContext;
+
+ ftsContext := TtsContext.Create;
+ ftsRenderer := TtsRendererOpenGL.Create(ftsContext, tsFormatRGBA8);
+
+ ftsCreator1 := TtsFontGeneratorGDI.Create(ftsContext);
+ ftsFont1 := ftsCreator1.GetFontByFile(ExtractFilePath(Application.ExeName) + '../Prototype.ttf', ftsRenderer, 40, [], tsAANormal);
+
+ pp := TtsPostProcessFillColor.Create(tsColor4f(0, 0, 0, 1), TS_MODES_REPLACE_ALL, TS_CHANNELS_RGB);
+ pp.AddUsageChars(tsUsageExclude, 'Lorem');
+ ftsCreator1.AddPostProcessStep(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);
+
+ 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);
+end;
+
+procedure TMainForm.FormDestroy(Sender: TObject);
+begin
+ FreeAndNil(ftsFont2);
+ FreeAndNil(ftsCreator2);
+ FreeAndNil(ftsFont1);
+ FreeAndNil(ftsCreator1);
+ FreeAndNil(ftsRenderer);
+ FreeAndNil(ftsContext);
+ FreeAndNil(fContext);
+end;
+
+procedure TMainForm.FormPaint(Sender: TObject);
+begin
+ if Assigned(fContext) then begin
+ Render;
+ fContext.SwapBuffers;
+ end;
+end;
+
+procedure TMainForm.Render;
+var
+ block: TtsTextBlock;
+begin
+ glClearColor(1, 1, 1, 1);
+ glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+
+ glViewport(0, 0, ClientWidth, ClientHeight);
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity;
+ glOrtho(0, ClientWidth, ClientHeight, 0, -10, 10);
+ glMatrixMode(GL_MODELVIEW);
+ glLoadIdentity;
+
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+ block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [tsBlockFlagWordWrap]);
+ try
+ block.HorzAlign := tsHorzAlignJustify;
+ block.ChangeFont(ftsFont1);
+ block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
+ block.TextOutW(TEST_TEXT + sLineBreak);
+
+ block.ChangeFont(ftsFont2);
+ block.TextOutW(TEST_TEXT);
+ finally
+ ftsRenderer.EndBlock(block);
+ end;
+end;
+
+end.
+
diff --git a/examples/Prototype.ttf b/examples/Prototype.ttf
new file mode 100644
index 0000000..c70bf00
Binary files /dev/null and b/examples/Prototype.ttf differ
diff --git a/examples/SimpleFreeType/SimpleFreeType.lpi b/examples/SimpleFreeType/SimpleFreeType.lpi
new file mode 100644
index 0000000..a878c49
--- /dev/null
+++ b/examples/SimpleFreeType/SimpleFreeType.lpi
@@ -0,0 +1,83 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/SimpleFreeType/SimpleFreeType.lpr b/examples/SimpleFreeType/SimpleFreeType.lpr
new file mode 100644
index 0000000..5650e98
--- /dev/null
+++ b/examples/SimpleFreeType/SimpleFreeType.lpr
@@ -0,0 +1,21 @@
+program SimpleFreeType;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, uMainForm
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
+
diff --git a/examples/SimpleFreeType/freetype6-x64.dll b/examples/SimpleFreeType/freetype6-x64.dll
new file mode 100644
index 0000000..4c88d70
Binary files /dev/null and b/examples/SimpleFreeType/freetype6-x64.dll differ
diff --git a/examples/SimpleFreeType/freetype6-x86.dll b/examples/SimpleFreeType/freetype6-x86.dll
new file mode 100644
index 0000000..e35edc6
Binary files /dev/null and b/examples/SimpleFreeType/freetype6-x86.dll differ
diff --git a/examples/SimpleFreeType/uMainForm.lfm b/examples/SimpleFreeType/uMainForm.lfm
new file mode 100644
index 0000000..e640949
--- /dev/null
+++ b/examples/SimpleFreeType/uMainForm.lfm
@@ -0,0 +1,12 @@
+object MainForm: TMainForm
+ Left = 670
+ Height = 320
+ Top = 319
+ Width = 480
+ Caption = 'MainForm'
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnPaint = FormPaint
+ Position = poScreenCenter
+ LCLVersion = '1.3'
+end
diff --git a/examples/SimpleFreeType/uMainForm.pas b/examples/SimpleFreeType/uMainForm.pas
new file mode 100644
index 0000000..c31f68e
--- /dev/null
+++ b/examples/SimpleFreeType/uMainForm.pas
@@ -0,0 +1,101 @@
+unit uMainForm;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
+ uglcContext,
+ utsTextSuite, utsRendererOpenGL, utsFontCreatorFreeType, utsTypes;
+
+type
+ TMainForm = class(TForm)
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormPaint(Sender: TObject);
+ private
+ fContext: TglcContext;
+ ftsContext: TtsContext;
+ ftsRenderer: TtsRendererOpenGL;
+ ftsCreator: TtsFontGeneratorFreeType;
+ ftsFont: TtsFont;
+ procedure Render;
+ public
+ { public declarations }
+ end;
+
+var
+ MainForm: TMainForm;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ dglOpenGL;
+
+const
+ TEST_TEXT = 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.';
+
+procedure TMainForm.FormCreate(Sender: TObject);
+var
+ pf: TglcContextPixelFormatSettings;
+begin
+ pf := TglcContext.MakePF();
+ fContext := TglcContext.GetPlatformClass.Create(self, pf);
+ 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);
+end;
+
+procedure TMainForm.FormDestroy(Sender: TObject);
+begin
+ FreeAndNil(ftsFont);
+ FreeAndNil(ftsCreator);
+ FreeAndNil(ftsRenderer);
+ FreeAndNil(ftsContext);
+ FreeAndNil(fContext);
+end;
+
+procedure TMainForm.FormPaint(Sender: TObject);
+begin
+ if Assigned(fContext) then begin
+ Render;
+ fContext.SwapBuffers;
+ end;
+end;
+
+procedure TMainForm.Render;
+var
+ block: TtsTextBlock;
+begin
+ glClearColor(0, 0, 0, 0);
+ glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+
+ glViewport(0, 0, ClientWidth, ClientHeight);
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity;
+ glOrtho(0, ClientWidth, ClientHeight, 0, -10, 10);
+ glMatrixMode(GL_MODELVIEW);
+ glLoadIdentity;
+
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+ block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [tsBlockFlagWordWrap]);
+ try
+ block.HorzAlign := tsHorzAlignJustify;
+ block.ChangeFont(ftsFont);
+ block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
+ block.TextOutW(TEST_TEXT);
+ finally
+ ftsRenderer.EndBlock(block);
+ end;
+end;
+
+end.
+
diff --git a/examples/SimpleGDI/SimpleGDI.lpi b/examples/SimpleGDI/SimpleGDI.lpi
new file mode 100644
index 0000000..dabee79
--- /dev/null
+++ b/examples/SimpleGDI/SimpleGDI.lpi
@@ -0,0 +1,83 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/examples/SimpleGDI/SimpleGDI.lpr b/examples/SimpleGDI/SimpleGDI.lpr
new file mode 100644
index 0000000..dfdcf02
--- /dev/null
+++ b/examples/SimpleGDI/SimpleGDI.lpr
@@ -0,0 +1,21 @@
+program SimpleGDI;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, uMainForm
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ Application.Initialize;
+ Application.CreateForm(TMainForm, MainForm);
+ Application.Run;
+end.
+
diff --git a/examples/SimpleGDI/uMainForm.lfm b/examples/SimpleGDI/uMainForm.lfm
new file mode 100644
index 0000000..e640949
--- /dev/null
+++ b/examples/SimpleGDI/uMainForm.lfm
@@ -0,0 +1,12 @@
+object MainForm: TMainForm
+ Left = 670
+ Height = 320
+ Top = 319
+ Width = 480
+ Caption = 'MainForm'
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnPaint = FormPaint
+ Position = poScreenCenter
+ LCLVersion = '1.3'
+end
diff --git a/examples/SimpleGDI/uMainForm.pas b/examples/SimpleGDI/uMainForm.pas
new file mode 100644
index 0000000..f27ee20
--- /dev/null
+++ b/examples/SimpleGDI/uMainForm.pas
@@ -0,0 +1,101 @@
+unit uMainForm;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
+ uglcContext,
+ utsTextSuite, utsRendererOpenGL, utsFontCreatorGDI, utsTypes;
+
+type
+ TMainForm = class(TForm)
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormPaint(Sender: TObject);
+ private
+ fContext: TglcContext;
+ ftsContext: TtsContext;
+ ftsRenderer: TtsRendererOpenGL;
+ ftsCreator: TtsFontGeneratorGDI;
+ ftsFont: TtsFont;
+ procedure Render;
+ public
+ { public declarations }
+ end;
+
+var
+ MainForm: TMainForm;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ dglOpenGL;
+
+const
+ TEST_TEXT = 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.';
+
+procedure TMainForm.FormCreate(Sender: TObject);
+var
+ pf: TglcContextPixelFormatSettings;
+begin
+ pf := TglcContext.MakePF();
+ fContext := TglcContext.GetPlatformClass.Create(self, pf);
+ 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);
+end;
+
+procedure TMainForm.FormDestroy(Sender: TObject);
+begin
+ FreeAndNil(ftsFont);
+ FreeAndNil(ftsCreator);
+ FreeAndNil(ftsRenderer);
+ FreeAndNil(ftsContext);
+ FreeAndNil(fContext);
+end;
+
+procedure TMainForm.FormPaint(Sender: TObject);
+begin
+ if Assigned(fContext) then begin
+ Render;
+ fContext.SwapBuffers;
+ end;
+end;
+
+procedure TMainForm.Render;
+var
+ block: TtsTextBlock;
+begin
+ glClearColor(0, 0, 0, 0);
+ glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+
+ glViewport(0, 0, ClientWidth, ClientHeight);
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity;
+ glOrtho(0, ClientWidth, ClientHeight, 0, -10, 10);
+ glMatrixMode(GL_MODELVIEW);
+ glLoadIdentity;
+
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+ block := ftsRenderer.BeginBlock(10, 10, ClientWidth-20, ClientHeight-20, [tsBlockFlagWordWrap]);
+ try
+ block.HorzAlign := tsHorzAlignJustify;
+ block.ChangeFont(ftsFont);
+ block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
+ block.TextOutW(TEST_TEXT);
+ finally
+ ftsRenderer.EndBlock(block);
+ end;
+end;
+
+end.
+
diff --git a/examples/simple/TextSuiteTest.ico b/examples/simple/TextSuiteTest.ico
deleted file mode 100644
index 0341321..0000000
Binary files a/examples/simple/TextSuiteTest.ico and /dev/null differ
diff --git a/examples/simple/TextSuiteTest.lpi b/examples/simple/TextSuiteTest.lpi
deleted file mode 100644
index 30a9336..0000000
--- a/examples/simple/TextSuiteTest.lpi
+++ /dev/null
@@ -1,137 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/examples/simple/TextSuiteTest.lpr b/examples/simple/TextSuiteTest.lpr
deleted file mode 100644
index 91b999c..0000000
--- a/examples/simple/TextSuiteTest.lpr
+++ /dev/null
@@ -1,27 +0,0 @@
-program TextSuiteTest;
-
-{$mode objfpc}{$H+}
-
-uses
- {$IFDEF UNIX}{$IFDEF UseCThreads}
- cthreads,
- {$ENDIF}{$ENDIF}
- Interfaces, sysutils, Forms, uMainForm, utsFontCreatorGDI, utsUtils, utsTypes, utsTtfUtils, utsTextSuite,
- utsRendererOpenGL, utsCodePages, utsPostProcess, utsFontCreatorFreeType, utsGDI, utsFreeType, utsOpenGLUtils;
-
-{$R *.res}
-
-var
- HeapTraceLogFile: String;
-begin
- HeapTraceLogFile := ExtractFilePath(Application.ExeName) + 'heaptrace.log';
- if FileExists(HeapTraceLogFile) then
- DeleteFile(HeapTraceLogFile);
- SetHeapTraceOutput(HeapTraceLogFile);
-
- RequireDerivedFormResource := True;
- Application.Initialize;
- Application.CreateForm(TMainForm, MainForm);
- Application.Run;
-end.
-
diff --git a/examples/simple/TextSuiteTest.lps b/examples/simple/TextSuiteTest.lps
deleted file mode 100644
index a96c285..0000000
--- a/examples/simple/TextSuiteTest.lps
+++ /dev/null
@@ -1,646 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/examples/simple/TextSuiteTest.res b/examples/simple/TextSuiteTest.res
deleted file mode 100644
index 7c6cf3e..0000000
Binary files a/examples/simple/TextSuiteTest.res and /dev/null differ
diff --git a/examples/simple/uMainForm.lfm b/examples/simple/uMainForm.lfm
deleted file mode 100644
index d7a022b..0000000
--- a/examples/simple/uMainForm.lfm
+++ /dev/null
@@ -1,15 +0,0 @@
-object MainForm: TMainForm
- Left = 536
- Height = 508
- Top = 255
- Width = 682
- OnCreate = FormCreate
- OnDestroy = FormDestroy
- OnPaint = FormPaint
- LCLVersion = '1.3'
- object ApplicationProperties: TApplicationProperties
- OnIdle = ApplicationPropertiesIdle
- left = 56
- top = 24
- end
-end
diff --git a/examples/simple/uMainForm.pas b/examples/simple/uMainForm.pas
deleted file mode 100644
index 06758c6..0000000
--- a/examples/simple/uMainForm.pas
+++ /dev/null
@@ -1,179 +0,0 @@
-unit uMainForm;
-
-{$mode objfpc}{$H+}
-
-{.$DEFINE USE_OLD_TS}
-
-interface
-
-uses
- Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, uglcContext, uglcTypes,
- utsTextSuite, utsTypes, utsFontCreatorGDI, utsRendererOpenGL, utsPostProcess, utsFontCreatorFreeType;
-
-type
- TMainForm = class(TForm)
- ApplicationProperties: TApplicationProperties;
- procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure FormPaint(Sender: TObject);
- private
- fFrameTime: QWord;
- fFrameCount: Integer;
- fSecTime: QWord;
- fContext: TglcContext;
- {$IFDEF USE_OLD_TS}
- ftsContext: tsContextID;
- ftsFont: tsFontID;
- {$ELSE}
- ftsContext: TtsContext;
- ftsRenderer: TtsRendererOpenGL;
- ftsGenerator: TtsFontGeneratorGDI;
- ftsFreeType: TtsFontGeneratorFreeType;
- ftsFont1: TtsFont;
- ftsFont2: TtsFont;
- ftsFont3: TtsFont;
- {$ENDIF}
- procedure Render;
- public
- { public declarations }
- end;
-
-var
- MainForm: TMainForm;
-
-implementation
-
-{$R *.lfm}
-
-uses
- dglOpenGL;
-
-const
- TEST_STRING = 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet. Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua. At vero eos et accusam et justo duo dolores et ea rebum. Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.';
-
-procedure TMainForm.FormCreate(Sender: TObject);
-var
- pf: TglcContextPixelFormatSettings;
- pp: TtsPostProcessStep;
-begin
- pf := TglcContext.MakePF();
- fContext := TglcContext.GetPlatformClass.Create(self, pf);
- fContext.BuildContext;
- {$IFDEF USE_OLD_TS}
- tsInit(TS_INIT_TEXTSUITE or TS_INIT_OPENGL or TS_INIT_GDI);
- tsContextCreate(@ftsContext);
- tsSetParameteri(TS_RENDERER, TS_RENDERER_OPENGL);
- tsSetParameteri(TS_CREATOR, TS_CREATOR_GDI_FACENAME);
- tsContextBind(ftsContext);
- tsFontCreateCreatorA('Calibri', 25, 0, TS_ANTIALIASING_NORMAL, TS_DEFAULT, @ftsFont);
- tsFontBind(ftsFont);
- {$ELSE}
- ftsContext := TtsContext.Create;
- ftsRenderer := TtsRendererOpenGL.Create(ftsContext, tsFormatRGBA8);
- ftsGenerator := TtsFontGeneratorGDI.Create(ftsContext);
-
- ftsFreeType := TtsFontGeneratorFreeType.Create(ftsContext);
- {
- pp := TtsPostProcessFillColor.Create(tsColor4f(0.0, 0.0, 0.0, 1.0), TS_MODES_MODULATE_ALPHA, TS_CHANNELS_RGBA);
- pp.AddUsageRange(tsUsageInclude, #$0000, #$FFFF);
- ftsGenerator.AddPostProcessStep(pp);
-
- pp := TtsPostProcessShadow.Create(3, 0, 2, 2, tsColor4f(1.0, 0.0, 1.0, 0.05));
- pp.AddUsageRange(tsUsageInclude, #$0000, #$FFFF);
- ftsGenerator.AddPostProcessStep(pp);
- }
- try
- ftsFont1 := ftsGenerator.GetFontByName('Calibri', ftsRenderer, 35, [tsStyleUnderline, tsStyleStrikeout], tsAANormal);
- ftsFont2 := ftsGenerator.GetFontByName('Calibri', ftsRenderer, 20, [], tsAANormal);
- ftsFont3 := ftsFreeType.GetFontByFile('calibri.ttf', ftsRenderer, 35, [tsStyleUnderline, tsStyleStrikeout], tsAANormal);
- except
- on e: EtsException do
- MessageDlg('Error', e.Message, mtError, [mbOK], 0);
- end;
- {$ENDIF}
-end;
-
-procedure TMainForm.FormDestroy(Sender: TObject);
-begin
- {$IFDEF USE_OLD_TS}
- tsFontDestroy(ftsFont);
- tsContextDestroy(ftsContext);
- {$ELSE}
- FreeAndNil(ftsFont1);
- FreeAndNil(ftsFont2);
- FreeAndNil(ftsGenerator);
- FreeAndNil(ftsFreeType);
- FreeAndNil(ftsRenderer);
- FreeAndNil(ftsContext);
- {$ENDIF}
-end;
-
-procedure TMainForm.FormPaint(Sender: TObject);
-begin
- Render;
-end;
-
-procedure TMainForm.Render;
-var
- block: TtsTextBlock;
- t: QWord;
- dif: Integer;
-begin
- t := GetTickCount64;
- if (fFrameTime <> 0) then begin
- dif := t - fFrameTime;
- inc(fFrameCount, 1);
- inc(fSecTime, dif);
- if (fSecTime > 1000) then begin
- Caption := IntToStr(fFrameCount) + ' FPS';
- fFrameCount := 0;
- dec(fSecTime, 1000);
- end;
- end;
- fFrameTime := t;
-
- glViewport(0, 0, ClientWidth, ClientHeight);
- glClearColor(0, 0, 0, 0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
-
- glMatrixMode(GL_PROJECTION);
- glLoadIdentity;
- glOrtho(0, ClientWidth, ClientHeight, 0, -10, 10);
- glMatrixMode(GL_MODELVIEW);
- glLoadIdentity;
-
- glEnable(GL_BLEND);
- glcBlendFunc(TglcBlendMode.bmAlphaBlend);
-
- {$IFDEF USE_OLD_TS}
- tsTextBeginBlock(0, 0, ClientWidth, ClientHeight, TS_ALIGN_BLOCK);
- tsTextOutA(TEST_STRING);
- tsTextEndBlock;
- {$ELSE}
- block := ftsRenderer.BeginBlock(0, 0, ClientWidth, ClientHeight, [tsBlockFlagWordWrap]);
- try
- //block.HorzAlign := tsHorzAlignJustify;
-
- block.ChangeFont(ftsFont1);
- block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
- block.TextOutA(TEST_STRING + sLineBreak + sLineBreak);
-
- block.ChangeFont(ftsFont3);
- block.ChangeColor(tsColor4f(1.0, 1.0, 1.0, 1.0));
- block.TextOutA(TEST_STRING);
- finally
- ftsRenderer.EndBlock(block);
- end;
- {$ENDIF}
- fContext.SwapBuffers;
-end;
-
-procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
-begin
- Render;
- Done := false;
-end;
-
-end.
-
diff --git a/old/TextSuite.pas b/old/TextSuite.pas
deleted file mode 100644
index af944a5..0000000
--- a/old/TextSuite.pas
+++ /dev/null
@@ -1,3650 +0,0 @@
-{
-TextSuite (C) Steffen Xonna (aka Lossy eX)
-http://www.opengl24.de/
------------------------------------------------------------------------
-For copyright informations see file copyright.txt.
-}
-
-{$I TextSuiteOptions.inc}
-
-unit TextSuite;
-
-
-interface
-
-
-type
- tsBool = Cardinal;
- tsByte = Byte;
- tsInt = Integer;
- tsFloat = Single;
- tsEnum = Cardinal;
- tsBitmask = Cardinal;
- tsError = Cardinal;
-
- ptsBool = ^tsBool;
- ptsByte = ^tsByte;
- ptsInt = ^tsInt;
- ptsEnum = ^tsEnum;
-
- tsContextID = Cardinal;
- tsFontID = Cardinal;
- tsImageID = Cardinal;
-
- ptsContextID = ^tsContextID;
- ptsFontID = ^tsFontID;
- ptsImageID = ^tsImageID;
-
- PPointer = ^Pointer;
-
- tsPostProcessProc = procedure(ImageID: tsImageID; CharCode: WideChar; Data: Pointer); cdecl;
-
-
- // these types are more internally.
-
- ptsColor = ^tsColor;
- tsColor = packed record
- Red: Byte;
- Green: Byte;
- Blue: Byte;
- Alpha: Byte;
- end;
-
- ptsRect = ^tsRect;
- tsRect = packed record
- Left: Integer;
- Top: Integer;
- Right: Integer;
- Bottom: Integer;
- end;
-
- ptsPoint = ^tsPoint;
- tsPoint = packed record
- X: Integer;
- Y: Integer;
- end;
-
-
-
-const
-{$ifdef TS_EXTERN_STATIC}
- {$ifdef WINDOWS}
- TS_LIBRARY = 'libTextSuite.dll';
- {$else}
- {$ifdef darwin}
- TS_LIBRARY = 'libTextSuite.dylib';
- {$else}
- TS_LIBRARY = 'libTextSuite.so';
- {$endif}
- {$endif}
-{$endif}
-
- // Booleans
- TS_TRUE = 1;
- TS_FALSE = 0;
-
- TS_DEFAULT = 0;
-
- // Inits
- TS_INIT_TEXTSUITE = $01;
- TS_INIT_SDL_TTF = $02;
- TS_INIT_SDL_IMAGE = $04;
- TS_INIT_GDI = $08;
- TS_INIT_OPENGL = $10;
-// TS_INIT_FREETYPE2 = $20;
-
- // library infos
- TS_INFO_MAYOR_VERSION = $01;
- TS_INFO_MINOR_VERSION = $02;
- TS_INFO_BUILD_NUMBER = $03;
- TS_INFO_VERSION = $04;
- TS_INFO_COPYRIGHT = $05;
-
- TS_GLOBAL_ANTIALIASING = $11;
- TS_GLOBAL_FORMAT = $12;
-
- // debug infos
- TS_DEBUG_DRAW_CHAR_RECTS = $30;
-
- // context
- TS_CONTEXT_BINDING = $40;
-
- // Renderer
- TS_RENDERER = $50;
- TS_RENDERER_NULL = $51;
- TS_RENDERER_OPENGL = $52;
-
- TS_RENDERER_NULL_SAVE_IMAGES = $60;
-
- TS_RENDERER_OPENGL_TEXTURE_SIZE = $70;
- TS_RENDERER_OPENGL_TEXTURE_SIZE_128 = $71;
- TS_RENDERER_OPENGL_TEXTURE_SIZE_256 = $72;
- TS_RENDERER_OPENGL_TEXTURE_SIZE_512 = $73;
- TS_RENDERER_OPENGL_TEXTURE_SIZE_1024 = $74;
-
- // Font
- TS_FONT_BINDING = $100;
- TS_FONT_COPYRIGHT = $101;
- TS_FONT_FACE_NAME = $102;
- TS_FONT_STYLE_NAME = $103;
- TS_FONT_FULL_NAME = $104;
- TS_FONT_SIZE = $105;
- TS_FONT_STYLE = $106;
- TS_FONT_FILE_STYLE = $107;
- TS_FONT_FIXED_WIDTH = $108;
- TS_FONT_ANTIALIASING = $109;
- TS_FONT_FORMAT = $10A;
- TS_FONT_ASCENT = $10B;
- TS_FONT_DESCENT = $113;
- TS_FONT_EXTERNAL_LEADING = $114;
- TS_FONT_LINESKIP = $10C;
- TS_FONT_CHAR_SPACING = $10D;
- TS_FONT_LINE_SPACING = $10E;
- TS_FONT_UNDERLINE_POSITION = $10F;
- TS_FONT_UNDERLINE_SIZE = $110;
- TS_FONT_STRIKEOUT_POSITION = $111;
- TS_FONT_STRIKEOUT_SIZE = $112;
- TS_FONT_BASELINE_OFFSET = $115;
-
- // Char parameters
- TS_CHAR_ADVANCE = $131;
- TS_CHAR_GLYPHORIGIN = $132;
- TS_CHAR_GLYPHORIGIN_X = $133;
- TS_CHAR_GLYPHORIGIN_Y = $134;
- TS_CHAR_GLYPHRECT = $135;
- TS_CHAR_GLYPHRECT_TOP = $136;
- TS_CHAR_GLYPHRECT_LEFT = $137;
- TS_CHAR_GLYPHRECT_RIGHT = $138;
- TS_CHAR_GLYPHRECT_BOTTOM = $139;
-
- // Creator
- TS_CREATOR = $200;
- TS_CREATOR_SDL = $201;
- TS_CREATOR_GDI = $202;
- TS_CREATOR_GDI_FACENAME = $203;
-// TS_CREATOR_FREETYPE2 = $204;
- TS_CREATOR_GDI_STREAM = $205;
-
- TS_CREATOR_CREATE_CHARS = $210;
- TS_CREATOR_ADD_RESIZING_BORDER = $211;
-
- // Font Style
- TS_STYLE_NORMAL = $00;
- TS_STYLE_BOLD = $01;
- TS_STYLE_ITALIC = $02;
- TS_STYLE_UNDERLINE = $04;
- TS_STYLE_STRIKEOUT = $08;
-
- // AntiAliasing
- TS_ANTIALIASING_NONE = $221;
- TS_ANTIALIASING_NORMAL = $222;
-
- // Formats
- TS_FORMAT_EMPTY = $231;
- TS_FORMAT_RGBA8 = $232;
-
- // PostProcessing usage type
- TS_POST_INDEX_ALL = -2;
- TS_POST_INDEX_LAST = -1;
- TS_POST_USAGE_INCLUDE = $291;
- TS_POST_USAGE_EXCLUDE = $292;
-
- // output consts
- // Single line
- TS_SINGLE_LINE = $300;
- TS_SINGLE_LINE_TOP = $301;
- TS_SINGLE_LINE_BASELINE = $302;
-
- // Textalign
- TS_ALIGN = $310;
- TS_ALIGN_LEFT = $311;
- TS_ALIGN_CENTER = $312;
- TS_ALIGN_RIGHT = $313;
- TS_ALIGN_BLOCK = $314;
-
- TS_VALIGN = $320;
- TS_VALIGN_TOP = $321;
- TS_VALIGN_CENTER = $322;
- TS_VALIGN_BOTTOM = $323;
-
- // Textblockflags
- TS_BLOCK_OFFSET_X = $331;
- TS_BLOCK_OFFSET_Y = $332;
-
- TS_BLOCKFLAG_NONE = $00;
- TS_BLOCKFLAG_NO_CLIP = $01;
- TS_BLOCKFLAG_CALC_SIZE = $02;
- TS_BLOCKFLAG_WORD_WRAP = $04;
-// TS_BF_SINGLE_LINE = $08;
-// TS_BF_END_ELLIPSIS = $10;
-
- TS_CLIP = $340;
- TS_CLIP_COMPLETE = $341;
- TS_CLIP_BORDER = $342;
-
-{
- TS_TAB = $350;
- TS_TAB_FIXED = $351;
- TS_TAB_ABSOLUTE = $352;
- TS_TAB_FIXED_WIDTH = $353;
- TS_TAB_ABSOLUTE_POSITIONS = $354;
-}
-
- // Code pages
- TS_EMPTY_CP_ENTRY = $1000;
- TS_EMPTY_CP_ENTRY_IGNORE = $1001;
- TS_EMPTY_CP_ENTRY_USE_DEFAULT = $1002;
-
- TS_CODEPAGE = $1100;
- TS_CODEPAGE_UTF8 = TS_CODEPAGE + 1;
- TS_CODEPAGE_8859_1 = TS_CODEPAGE + 11;
- TS_CODEPAGE_8859_2 = TS_CODEPAGE + 12;
- TS_CODEPAGE_8859_3 = TS_CODEPAGE + 13;
- TS_CODEPAGE_8859_4 = TS_CODEPAGE + 14;
- TS_CODEPAGE_8859_5 = TS_CODEPAGE + 15;
- TS_CODEPAGE_8859_6 = TS_CODEPAGE + 16;
- TS_CODEPAGE_8859_7 = TS_CODEPAGE + 17;
- TS_CODEPAGE_8859_8 = TS_CODEPAGE + 18;
- TS_CODEPAGE_8859_9 = TS_CODEPAGE + 19;
- TS_CODEPAGE_8859_10 = TS_CODEPAGE + 20;
- TS_CODEPAGE_8859_11 = TS_CODEPAGE + 21;
- TS_CODEPAGE_8859_13 = TS_CODEPAGE + 22;
- TS_CODEPAGE_8859_14 = TS_CODEPAGE + 23;
- TS_CODEPAGE_8859_15 = TS_CODEPAGE + 24;
- TS_CODEPAGE_8859_16 = TS_CODEPAGE + 25;
- TS_CODEPAGE_037 = TS_CODEPAGE + 31;
- TS_CODEPAGE_437 = TS_CODEPAGE + 32;
- TS_CODEPAGE_500 = TS_CODEPAGE + 33;
- TS_CODEPAGE_737 = TS_CODEPAGE + 34;
- TS_CODEPAGE_775 = TS_CODEPAGE + 35;
- TS_CODEPAGE_850 = TS_CODEPAGE + 36;
- TS_CODEPAGE_852 = TS_CODEPAGE + 37;
- TS_CODEPAGE_855 = TS_CODEPAGE + 38;
- TS_CODEPAGE_857 = TS_CODEPAGE + 39;
- TS_CODEPAGE_860 = TS_CODEPAGE + 40;
- TS_CODEPAGE_861 = TS_CODEPAGE + 41;
- TS_CODEPAGE_862 = TS_CODEPAGE + 42;
- TS_CODEPAGE_863 = TS_CODEPAGE + 43;
- TS_CODEPAGE_864 = TS_CODEPAGE + 44;
- TS_CODEPAGE_865 = TS_CODEPAGE + 45;
- TS_CODEPAGE_866 = TS_CODEPAGE + 46;
- TS_CODEPAGE_869 = TS_CODEPAGE + 47;
- TS_CODEPAGE_874 = TS_CODEPAGE + 48;
- TS_CODEPAGE_875 = TS_CODEPAGE + 49;
- TS_CODEPAGE_1026 = TS_CODEPAGE + 50;
- TS_CODEPAGE_1250 = TS_CODEPAGE + 51;
- TS_CODEPAGE_1251 = TS_CODEPAGE + 52;
- TS_CODEPAGE_1252 = TS_CODEPAGE + 53;
- TS_CODEPAGE_1253 = TS_CODEPAGE + 54;
- TS_CODEPAGE_1254 = TS_CODEPAGE + 55;
- TS_CODEPAGE_1255 = TS_CODEPAGE + 56;
- TS_CODEPAGE_1256 = TS_CODEPAGE + 57;
- TS_CODEPAGE_1257 = TS_CODEPAGE + 58;
- TS_CODEPAGE_1258 = TS_CODEPAGE + 59;
-
- // channel masks
- TS_CHANNEL_RED = $01;
- TS_CHANNEL_GREEN = $02;
- TS_CHANNEL_BLUE = $04;
- TS_CHANNEL_ALPHA = $08;
- TS_CHANNEL_LUMINANCE = $10;
-
- TS_CHANNELS_RGB = TS_CHANNEL_RED or TS_CHANNEL_GREEN or TS_CHANNEL_BLUE;
- TS_CHANNELS_RGBA = TS_CHANNELS_RGB or TS_CHANNEL_ALPHA;
- TS_CHANNELS_LUMINANCE_ALPHA = TS_CHANNEL_LUMINANCE or TS_CHANNEL_ALPHA;
-
- TS_IMAGE_RED_MODE = $401;
- TS_IMAGE_GREEN_MODE = $402;
- TS_IMAGE_BLUE_MODE = $403;
- TS_IMAGE_ALPHA_MODE = $404;
- TS_IMAGE_LUMINANCE_MODE = $405;
-
- TS_MODE_REPLACE = $411;
- TS_MODE_MODULATE = $412;
-
- // Imagelibrary
- TS_IMAGE_LIBRARY = $420;
- TS_IMAGE_LIBRARY_SDL = $421;
-
-
- // Errorcode
- TS_NO_ERROR = $0000;
- TS_ERROR = $8000;
- TS_NO_ACTIVE_CONTEXT = TS_ERROR + $1;
- TS_NO_ACTIVE_RENDERER = TS_ERROR + $2;
- TS_NO_ACTIVE_FONT = TS_ERROR + $3;
- TS_INVALID_OPERATION = TS_ERROR + $4;
- TS_INVALID_ENUM = TS_ERROR + $5;
- TS_INVALID_VALUE = TS_ERROR + $6;
- TS_OUT_OF_MEMORY = TS_ERROR + $7;
- TS_NOT_INITIALIZED = TS_ERROR + $8;
-
- TS_NO_FUNC = $0000;
- TS_FUNC = $4000;
- TS_FUNC_INIT = TS_FUNC + $01;
- TS_FUNC_QUIT = TS_FUNC + $02;
- TS_FUNC_SET_PARAMETER = TS_FUNC + $03;
- TS_FUNC_GET_PARAMETER = TS_FUNC + $04;
- TS_FUNC_GET_STRING = TS_FUNC + $05;
- TS_FUNC_CONTEXT_CREATE = TS_FUNC + $06;
- TS_FUNC_CONTEXT_DESTROY = TS_FUNC + $07;
- TS_FUNC_CONTEXT_BIND = TS_FUNC + $08;
- TS_FUNC_FONT_CREATE_CREATOR = TS_FUNC + $09;
- TS_FUNC_FONT_DESTROY = TS_FUNC + $0A;
- TS_FUNC_FONT_BIND = TS_FUNC + $0B;
- TS_FUNC_FONT_ADD_CHAR = TS_FUNC + $0C;
- TS_FUNC_FONT_DELETE_CHAR = TS_FUNC + $0D;
- TS_FUNC_FONT_SET_CHAR_PARAMETER = TS_FUNC + $0E;
- TS_FUNC_FONT_GET_CHAR_PARAMETER = TS_FUNC + $0F;
- TS_FUNC_POST_ADD_FILL_COLOR = TS_FUNC + $10;
- TS_FUNC_POST_ADD_FILL_PATTERN = TS_FUNC + $11;
- TS_FUNC_POST_ADD_BORDER = TS_FUNC + $12;
- TS_FUNC_POST_ADD_SHADOW = TS_FUNC + $13;
- TS_FUNC_POST_ADD_CUSTOM = TS_FUNC + $14;
- TS_FUNC_POST_DELETE = TS_FUNC + $15;
- TS_FUNC_POST_ADD_USAGE = TS_FUNC + $16;
- TS_FUNC_POST_CLEAR_USAGE = TS_FUNC + $17;
- TS_FUNC_STRING_ANSI_TO_WIDE = TS_FUNC + $18;
- TS_FUNC_STRING_ALLOC = TS_FUNC + $19;
- TS_FUNC_STRING_DISPOSE = TS_FUNC + $1A;
- TS_FUNC_TEXT_BEGIN_BLOCK = TS_FUNC + $1B;
- TS_FUNC_TEXT_END_BLOCK = TS_FUNC + $1C;
- TS_FUNC_TEXT_COLOR = TS_FUNC + $1D;
- TS_FUNC_TEXT_OUT = TS_FUNC + $1E;
- TS_FUNC_TEXT_GET_WIDTH = TS_FUNC + $1F;
- TS_FUNC_TEXT_GET_HEIGHT = TS_FUNC + $20;
- TS_FUNC_IMAGE_CREATE = TS_FUNC + $21;
- TS_FUNC_IMAGE_DESTROY = TS_FUNC + $22;
- TS_FUNC_IMAGE_LOAD = TS_FUNC + $23;
- TS_FUNC_IMAGE_ASSIGN_FROM = TS_FUNC + $24;
- TS_FUNC_IMAGE_NEW = TS_FUNC + $25;
- TS_FUNC_IMAGE_GET_INFO = TS_FUNC + $26;
- TS_FUNC_IMAGE_SCANLINE = TS_FUNC + $27;
- TS_FUNC_IMAGE_RESIZE = TS_FUNC + $28;
- TS_FUNC_IMAGE_BLEND = TS_FUNC + $29;
- TS_FUNC_IMAGE_BLUR = TS_FUNC + $2A;
- TS_FUNC_IMAGE_FILL_COLOR = TS_FUNC + $2B;
- TS_FUNC_IMAGE_FILL_PATTERN = TS_FUNC + $2C;
-
-
-
- // *** global functions ***
- function tsInit(Names: tsEnum): tsBool; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsInit'; {$endif}
- function tsWasInit(Names: tsEnum): tsBool; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsWasInit'; {$endif}
- procedure tsQuit; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsQuit'; {$endif}
- function tsGetError: tsEnum; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetError'; {$endif}
- function tsGetErrorFunction: tsEnum; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetErrorFunction'; {$endif}
- function tsGetErrorStringA(ErrorCode: tsEnum): pAnsiChar; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetErrorStringA'; {$endif}
-
- procedure tsSetParameteri(ParamName: tsEnum; Param: tsInt); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsSetParameteri'; {$endif}
- procedure tsSetParameteriv(ParamName: tsEnum; pParam: ptsInt); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsSetParameteriv'; {$endif}
- function tsGetParameteri(ParamName: tsEnum): tsInt; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetParameteri'; {$endif}
- procedure tsGetParameteriv(ParamName: tsEnum; pParam: ptsInt); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetParameteriv'; {$endif}
-
- function tsGetStringA(ParamName: tsEnum): pAnsiChar; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsGetStringA'; {$endif}
-
- // *** context functions ***
- procedure tsContextCreate(pContextID: ptsContextID); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsContextCreate'; {$endif}
- procedure tsContextDestroy(ContextID: tsContextID); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsContextDestroy'; {$endif}
- procedure tsContextBind(ContextID: tsContextID); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsContextBind'; {$endif}
-
- // *** font functions ***
-// procedure tsFontCreate(pFontID: ptsFontID); cdecl;
-// {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name ; {$endif}
- procedure tsFontCreateCreatorA(Name: pAnsiChar; Size: tsInt; Style: tsBitmask; AntiAliasing: tsEnum; Format: tsEnum; pFontID: ptsFontID); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontCreateCreatorA'; {$endif}
- procedure tsFontDestroy(FontID: tsFontID); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontDestroy'; {$endif}
- procedure tsFontBind(FontID: tsFontID); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontBind'; {$endif}
-
- procedure tsFontAddCharRange(CharStart: WideChar; CharEnd: WideChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontAddCharRange'; {$endif}
- procedure tsFontAddChars(Chars: pWideChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontAddChars'; {$endif}
- procedure tsFontAddChar(Char: WideChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontAddChar'; {$endif}
-
- procedure tsFontDeleteCharRange(CharStart: WideChar; CharEnd: WideChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontDeleteCharRange'; {$endif}
- procedure tsFontDeleteChars(Chars: pWideChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontDeleteChars'; {$endif}
- procedure tsFontDeleteChar(Char: WideChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontDeleteChar'; {$endif}
-
- procedure tsFontSetCharParameteri(Char: WideChar; ParamName: tsEnum; Param: tsInt); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontSetCharParameteri'; {$endif}
- procedure tsFontSetCharParameteriv(Char: WideChar; ParamName: tsEnum; pParam: ptsInt); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontSetCharParameteri'; {$endif}
- function tsFontGetCharParameteri(Char: WideChar; ParamName: tsEnum): tsInt; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontGetCharParameteri'; {$endif}
- procedure tsFontGetCharParameteriv(Char: WideChar; ParamName: tsEnum; pParam: ptsInt); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsFontGetCharParameteri'; {$endif}
-
- procedure tsPostAddFillColor3ub(Red, Green, Blue: tsByte; ChannelMask: tsBitmask); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddFillColor3ub'; {$endif}
- procedure tsPostAddFillColor3f(Red, Green, Blue: tsFloat; ChannelMask: tsBitmask); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddFillColor3f'; {$endif}
- procedure tsPostAddFillColor4ub(Red, Green, Blue, Alpha: tsByte; ChannelMask: tsBitmask); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddFillColor4ub'; {$endif}
- procedure tsPostAddFillColor4f(Red, Green, Blue, Alpha: tsFloat; ChannelMask: tsBitmask); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddFillColor4f'; {$endif}
-
- procedure tsPostAddFillPattern(PatternImageID: tsImageID; X, Y: tsInt; ChannelMask: tsBitmask); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddFillPattern'; {$endif}
-
- procedure tsPostAddBorder3ub(Width, Strength: tsFloat; Red, Green, Blue: tsByte); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddBorder3ub'; {$endif}
- procedure tsPostAddBorder3f(Width, Strength: tsFloat; Red, Green, Blue: tsFloat); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddBorder3f'; {$endif}
- procedure tsPostAddBorder4ub(Width, Strength: tsFloat; Red, Green, Blue, Alpha: tsByte); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddBorder4ub'; {$endif}
- procedure tsPostAddBorder4f(Width, Strength: tsFloat; Red, Green, Blue, Alpha: tsFloat); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddBorder4f'; {$endif}
-
- procedure tsPostAddShadow3ub(Radius: tsFloat; X, Y: tsInt; Red, Green, Blue: tsByte); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddShadow3ub'; {$endif}
- procedure tsPostAddShadow3f(Radius: tsFloat; X, Y: tsInt; Red, Green, Blue: tsFloat); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddShadow3f'; {$endif}
- procedure tsPostAddShadow4ub(Radius: tsFloat; X, Y: tsInt; Red, Green, Blue, Alpha: tsByte); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddShadow4ub'; {$endif}
- procedure tsPostAddShadow4f(Radius: tsFloat; X, Y: tsInt; Red, Green, Blue, Alpha: tsFloat); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddShadow4f'; {$endif}
-
-// procedure tsPostAddKerning; cdecl;
-// {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddKerning'; {$endif}
- procedure tsPostAddCustom(PostProcessProc: tsPostProcessProc; Data: Pointer); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddCustom'; {$endif}
-
- procedure tsPostDelete(PostIndex: tsInt); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostDelete'; {$endif}
-
- procedure tsPostAddUsageRange(PostIndex: tsInt; UsageType: tsEnum; CharStart, CharEnd: WideChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddUsageRange'; {$endif}
- procedure tsPostAddUsageChars(PostIndex: tsInt; UsageType: tsEnum; Chars: pWideChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostAddUsageChars'; {$endif}
-
- procedure tsPostClearUsage(PostIndex: tsInt); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsPostClearUsage'; {$endif}
-
- // *** string functions ***
- function tsStringAnsiToWide(pText: pAnsiChar): pWideChar; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsStringAnsiToWide'; {$endif}
- function tsStringAlloc(Size: tsInt): pWideChar; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsStringAlloc'; {$endif}
- procedure tsStringDispose(pText: pWideChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsStringDispose'; {$endif}
-
- // *** drawing functions ***
- procedure tsTextBeginBlock(Left, Top, Width, Height: tsInt; Flags: tsBitmask); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextBeginBlock'; {$endif}
- procedure tsTextEndBlock; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextEndBlock'; {$endif}
-
- procedure tsTextColor3ub(Red, Green, Blue: tsByte); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextColor3ub'; {$endif}
- procedure tsTextColor3f(Red, Green, Blue: tsFloat); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextColor3f'; {$endif}
- procedure tsTextColor4ub(Red, Green, Blue, Alpha: tsByte); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextColor4ub'; {$endif}
- procedure tsTextColor4f(Red, Green, Blue, Alpha: tsFloat); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextColor4f'; {$endif}
-
- procedure tsTextOutA(pText: pAnsiChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextOutA'; {$endif}
- procedure tsTextOutW(pText: pWideChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextOutW'; {$endif}
- function tsTextGetWidthA(pText: pAnsiChar): tsInt; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextGetWidthA'; {$endif}
- function tsTextGetWidthW(pText: pWideChar): tsInt; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextGetWidthW'; {$endif}
- function tsTextGetHeightA(pText: pAnsiChar): tsInt; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextGetHeightA'; {$endif}
- function tsTextGetHeightW(pText: pWideChar): tsInt; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsTextGetHeightW'; {$endif}
-
- procedure tsCharOutW(CharCode: WideChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsCharOutW'; {$endif}
-
- // *** Image functions ***
- procedure tsImageCreate(pImageID: ptsImageID); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageCreate'; {$endif}
- procedure tsImageDestroy(ImageID: tsImageID); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageDestroy'; {$endif}
- procedure tsImageLoadA(ImageID: tsImageID; Filename: pAnsiChar); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageLoadA'; {$endif}
- procedure tsImageAssignFrom(ImageID: tsImageID; FromImageID: tsImageID); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageAssignFrom'; {$endif}
- procedure tsImageNew(ImageID: tsImageID; Width: tsInt; Height: tsInt; Format: tsEnum); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageNew'; {$endif}
-
- procedure tsImageGetInfo(ImageID: tsImageID; pisEmpty: ptsBool; pWidth: ptsInt; pHeight: ptsInt; pFormat: ptsEnum; pData: PPointer); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetInfo'; {$endif}
- function tsImageGetIsEmpty(ImageID: tsImageID): tsBool; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetIsEmpty'; {$endif}
- function tsImageGetWidth(ImageID: tsImageID): tsInt; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetWidth'; {$endif}
- function tsImageGetHeight(ImageID: tsImageID): tsInt; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetHeight'; {$endif}
- function tsImageGetFormat(ImageID: tsImageID): tsEnum; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetFormat'; {$endif}
- function tsImageGetData(ImageID: tsImageID): Pointer; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageGetData'; {$endif}
- function tsImageScanline(ImageID: tsImageID; Scanline: tsInt): Pointer; cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageScanline'; {$endif}
-
- procedure tsImageResize(ImageID: tsImageID; Width, Height, X, Y: tsInt); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageResize'; {$endif}
- procedure tsImageBlend(ImageID, OverImageID: tsImageID; X, Y: tsInt; AutoExpand: tsBool); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageBlend'; {$endif}
- procedure tsImageBlur(ImageID: tsImageID; X, Y: tsFloat; ChannelMask: tsBitmask; AutoExpand: tsBool; ExpandSizeX, ExpandSizeY: ptsInt); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageBlur'; {$endif}
-
- procedure tsImageFillColor3ub(ImageID: tsImageID; Red, Green, Blue: tsByte; ChannelMask: tsBitmask); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageFillColor3ub'; {$endif}
- procedure tsImageFillColor3f(ImageID: tsImageID; Red, Green, Blue: tsFloat; ChannelMask: tsBitmask); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageFillColor3f'; {$endif}
- procedure tsImageFillColor4ub(ImageID: tsImageID; Red, Green, Blue, Alpha: tsByte; ChannelMask: tsBitmask); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageFillColor4ub'; {$endif}
- procedure tsImageFillColor4f(ImageID: tsImageID; Red, Green, Blue, Alpha: tsFloat; ChannelMask: tsBitmask); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageFillColor4f'; {$endif}
-
- procedure tsImageFillPattern(ImageID, PatternImageID: tsImageID; X, Y: tsInt; ChannelMask: tsBitmask); cdecl;
- {$ifdef TS_EXTERN_STATIC} external TS_LIBRARY name 'tsImageFillPattern'; {$endif}
-
-
-
-implementation
-
-{ This define ignores implementations of all functions }
-{$ifndef TS_EXTERN_STATIC}
-
-uses
- Classes,
- SysUtils,
- SyncObjs,
- TextSuiteClasses,
- TextSuitePostProcess,
- TextSuiteImports,
- {$ifndef TS_PURE_PASCAL}
- TextSuiteCPUUtils,
- {$endif}
- TextSuiteVersion,
- TextSuiteWideUtils;
-
-
-// string consts
-const
- TS_COPYRIGHT_STR = 'TextSuite (c) 2007-2009 by Steffen Xonna';
-
-
-// error consts
-const
- TS_NO_ERROR_STR = 'no error';
- TS_ERROR_STR = 'unknown error';
- TS_NO_ACTIVE_CONTEXT_STR = 'no active context';
- TS_NO_ACTIVE_RENDERER_STR = 'no active renderer';
- TS_NO_ACTIVE_FONT_STR = 'no active font';
- TS_INVALID_OPERATION_STR = 'invalid operation';
- TS_INVALID_ENUM_STR = 'invalid enum';
- TS_INVALID_VALUE_STR = 'invalid value';
- TS_OUT_OF_MEMORY_STR = 'out of memory';
- TS_NOT_INITIALIZED_STR = 'not initialized';
-
-
-// global variables
-var
- TextSuite_initialized: Boolean;
- TextSuite_initialized_count: Integer;
-
- gCriticalSection: TCriticalSection;
- gContexts: TtsHash;
- gStrings: TtsStringHash;
-
-
-
-// globals for the threads
-threadvar
- gError: tsEnum;
- gErrorFunction: tsEnum;
-
- gContext: TtsContext;
-
-
-
-procedure SetError(Error, ErrorFunction: tsEnum);
-begin
- gError := Error;
- gErrorFunction := ErrorFunction;
-end;
-
-
-procedure ClearContexts;
-var
- List: TList;
- Context: TtsContext;
- Idx: Integer;
-begin
- List := TList.Create;
- try
- gContexts.GetValues(List);
- gContexts.Clear;
- gContext := nil;
-
- for Idx := 0 to List.Count - 1 do begin
- Context := List[Idx];
-
- Context.Free;
- end;
- finally
- List.Free;
- end;
-end;
-
-
-function Init_TextSuite: boolean;
-begin
- if (TextSuite_initialized_count = 0) or (not TextSuite_initialized) then begin
- {$ifndef TS_PURE_PASCAL}
- ReadCPUFlags;
-
- if supportFPU and supportCMOV and supportMMX then begin
- {$endif}
- // global section
- if gCriticalSection = nil then
- gCriticalSection := TCriticalSection.Create;
-
- // Context management
- if gContexts = nil then
- gContexts := TtsHash.Create(113);
-
- // string management
- if gStrings = nil then
- gStrings := TtsStringHash.Create(4219);
-
- TextSuite_initialized :=
- (gCriticalSection <> nil) and
- (gContexts <> nil) and
- (gStrings <> nil);
- {$ifndef TS_PURE_PASCAL}
- end;
- {$endif}
- end;
-
- Inc(TextSuite_initialized_count);
-
- Result := TextSuite_initialized;
-end;
-
-
-procedure Quit_TextSuite;
-begin
- Dec(TextSuite_initialized_count);
-
- if TextSuite_initialized_count = 0 then begin
- // destroy all contexts
- ClearContexts;
-
- // destroy hash
- gStrings.Free;
- gStrings := nil;
-
- gContexts.Free;
- gContexts := nil;
-
- gCriticalSection.Free;
- gCriticalSection := nil;
-
- gContext := nil;
-
- TextSuite_initialized := False;
- end;
-end;
-
-
-
-// *** global functions
-function tsInit(Names: tsEnum): tsBool;
-var
- ResNames: tsEnum;
-begin
- Result := TS_FALSE;
- try
- ResNames := 0;
-
- if (Names and TS_INIT_TEXTSUITE) > 0 then
- if Init_TextSuite then
- ResNames := ResNames or TS_INIT_TEXTSUITE;
-
- if (Names and TS_INIT_SDL_TTF) > 0 then
- if Init_SDL_TTF then
- ResNames := ResNames or TS_INIT_SDL_TTF;
-
- if (Names and TS_INIT_SDL_IMAGE) > 0 then
- if Init_SDL_IMAGE then
- ResNames := ResNames or TS_INIT_SDL_IMAGE;
-
- if (Names and TS_INIT_GDI) > 0 then
- if Init_GDI then
- ResNames := ResNames or TS_INIT_GDI;
-
- if (Names and TS_INIT_OPENGL) > 0 then
- if Init_OpenGL then
- ResNames := ResNames or TS_INIT_OPENGL;
-
- if ResNames = Names then
- Result := TS_TRUE;
-
- if Result = TS_FALSE then
- SetError(TS_NOT_INITIALIZED, TS_FUNC_INIT);
- except
- SetError(TS_ERROR, TS_FUNC_INIT);
- end;
-end;
-
-
-function tsWasInit(Names: tsEnum): tsBool;
-var
- ResNames: tsEnum;
-begin
- ResNames := 0;
-
- if (Names and TS_INIT_TEXTSUITE) > 0 then
- if TextSuite_initialized then
- ResNames := ResNames or TS_INIT_TEXTSUITE;
-
- if (Names and TS_INIT_SDL_TTF) > 0 then
- if SDL_TTF_initialized then
- ResNames := ResNames or TS_INIT_SDL_TTF;
-
- if (Names and TS_INIT_SDL_IMAGE) > 0 then
- if SDL_IMAGE_initialized then
- ResNames := ResNames or TS_INIT_SDL_IMAGE;
-
- if (Names and TS_INIT_GDI) > 0 then
- if GDI_initialized then
- ResNames := ResNames or TS_INIT_GDI;
-
- if (Names and TS_INIT_OPENGL) > 0 then
- if OpenGL_initialized then
- ResNames := ResNames or TS_INIT_OPENGL;
-
- if ResNames = Names then
- Result := TS_TRUE
- else
- Result := TS_FALSE;
-end;
-
-
-procedure tsQuit;
-begin
- try
- // maybe quit library if count is zero
- if TextSuite_initialized then
- Quit_TextSuite;
-
- // if count is zero then quit all other systems
- if TextSuite_initialized_count = 0 then begin
- if SDL_TTF_initialized then
- Quit_SDL_TTF;
-
- if SDL_IMAGE_initialized then
- Quit_SDL_IMAGE;
-
- if GDI_initialized then
- Quit_GDI;
-
- if OpenGL_initialized then
- Quit_OpenGL;
-
- Quit_SDL;
- end;
- except
- SetError(TS_ERROR, TS_FUNC_QUIT);
- end;
-end;
-
-
-function tsGetError: tsEnum;
-begin
- Result := gError;
-
- gError := TS_NO_ERROR;
-end;
-
-
-function tsGetErrorFunction: tsEnum;
-begin
- Result := gErrorFunction;
-
- gErrorFunction := TS_NO_FUNC;
-end;
-
-
-function tsGetErrorStringA(ErrorCode: tsEnum): pAnsiChar;
-begin
- case ErrorCode of
- TS_NO_ERROR:
- Result := pAnsiChar(TS_NO_ERROR_STR);
- TS_ERROR:
- Result := pAnsiChar(TS_ERROR_STR);
- TS_NO_ACTIVE_CONTEXT:
- Result := pAnsiChar(TS_NO_ACTIVE_CONTEXT_STR);
- TS_NO_ACTIVE_RENDERER:
- Result := pAnsiChar(TS_NO_ACTIVE_RENDERER_STR);
- TS_NO_ACTIVE_FONT:
- Result := pAnsiChar(TS_NO_ACTIVE_FONT_STR);
- TS_INVALID_OPERATION:
- Result := pAnsiChar(TS_INVALID_OPERATION_STR);
- TS_INVALID_ENUM:
- Result := pAnsiChar(TS_INVALID_ENUM_STR);
- TS_INVALID_VALUE:
- Result := pAnsiChar(TS_INVALID_VALUE_STR);
- TS_OUT_OF_MEMORY:
- Result := pAnsiChar(TS_OUT_OF_MEMORY_STR);
- TS_NOT_INITIALIZED:
- Result := pAnsiChar(TS_NOT_INITIALIZED_STR);
- else
- if ErrorCode and TS_ERROR = TS_ERROR then
- Result := pAnsiChar(TS_ERROR_STR)
- else
- Result := pAnsiChar(TS_NO_ERROR);
- end;
-end;
-
-
-procedure SetCodePage(CodePage: tsEnum; CodePageFunc: TtsAnsiToWideCharFunc; pCodePage: Pointer);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- Context.gCodePage := CodePage;
- Context.gCodePageFunc := CodePageFunc;
- Context.gCodePagePtr := pCodePage;
-end;
-
-
-procedure tsSetParameteri(ParamName: tsEnum; Param: tsInt);
-begin
- tsSetParameteriv(ParamName, @Param);
-end;
-
-
-procedure tsSetParameteriv(ParamName: tsEnum; pParam: ptsInt);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if pParam <> nil then begin
- case ParamName of
- // font
- TS_FONT_ASCENT:
- if not Context.IsLocked then begin
- if Context.ActiveFont <> nil then begin
- Context.ActiveFont.Ascent := pParam^;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- TS_FONT_DESCENT:
- if not Context.IsLocked then begin
- if Context.ActiveFont <> nil then begin
- Context.ActiveFont.Descent := pParam^;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- TS_FONT_EXTERNAL_LEADING:
- if not Context.IsLocked then begin
- if Context.ActiveFont <> nil then begin
- Context.ActiveFont.ExternalLeading := pParam^;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- TS_FONT_BASELINE_OFFSET:
- if not Context.IsLocked then begin
- if Context.ActiveFont <> nil then begin
- Context.ActiveFont.BaselineOffset := pParam^;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- TS_FONT_CHAR_SPACING:
- if not Context.IsLocked then begin
- if Context.ActiveFont <> nil then begin
- Context.ActiveFont.CharSpacing := pParam^;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- TS_FONT_LINE_SPACING:
- if not Context.IsLocked then begin
- if Context.ActiveFont <> nil then begin
- Context.ActiveFont.LineSpacing := pParam^;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- TS_FONT_UNDERLINE_POSITION:
- if not Context.IsLocked then begin
- if Context.ActiveFont <> nil then begin
- Context.ActiveFont.UnderlinePosition := pParam^;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- TS_FONT_UNDERLINE_SIZE:
- if not Context.IsLocked then begin
- if Context.ActiveFont <> nil then begin
- Context.ActiveFont.UnderlineSize := pParam^;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- TS_FONT_STRIKEOUT_POSITION:
- if not Context.IsLocked then begin
- if Context.ActiveFont <> nil then begin
- Context.ActiveFont.StrikeoutPosition := pParam^;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- TS_FONT_STRIKEOUT_SIZE:
- if not Context.IsLocked then begin
- if Context.ActiveFont <> nil then begin
- Context.ActiveFont.StrikeoutSize := pParam^;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- // globals
- TS_GLOBAL_ANTIALIASING:
- case pParam^ of
- TS_ANTIALIASING_NONE:
- Context.gGlobalAntiAliasing := TS_ANTIALIASING_NONE;
- TS_ANTIALIASING_NORMAL:
- Context.gGlobalAntiAliasing := TS_ANTIALIASING_NORMAL;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- TS_GLOBAL_FORMAT:
- case pParam^ of
- TS_FORMAT_RGBA8:
- Context.gGlobalFormat := TS_FORMAT_RGBA8;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- // creator
- TS_CREATOR:
- case pParam^ of
- TS_CREATOR_SDL:
- Context.gCreator := TS_CREATOR_SDL;
- TS_CREATOR_GDI:
- Context.gCreator := TS_CREATOR_GDI;
- TS_CREATOR_GDI_FACENAME:
- Context.gCreator := TS_CREATOR_GDI_FACENAME;
- TS_CREATOR_GDI_STREAM:
- Context.gCreator := TS_CREATOR_GDI_STREAM;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- TS_CREATOR_CREATE_CHARS:
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont is TtsFontCreator then begin
- case pParam^ of
- TS_TRUE:
- TtsFontCreator(Context.ActiveFont).CreateChars := True;
- TS_FALSE:
- TtsFontCreator(Context.ActiveFont).CreateChars := False;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
-
- TS_CREATOR_ADD_RESIZING_BORDER:
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont is TtsFontCreator then begin
- case pParam^ of
- TS_TRUE:
- TtsFontCreator(Context.ActiveFont).AddResizingBorder := True;
- TS_FALSE:
- TtsFontCreator(Context.ActiveFont).AddResizingBorder := False;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_SET_PARAMETER);
-
- // renderer
- TS_RENDERER:
- if not Context.IsLocked then begin
- if tsGetParameteri(TS_RENDERER) <> pParam^ then begin
- if (Context.FontCount = 0) and (Context.ImageCount = 0) then begin
- case pParam^ of
- TS_RENDERER_NULL:
- begin
- if Context.Renderer <> nil then
- Context.Renderer.Free;
-
- Context.Renderer := TtsRendererNULL.Create(Context);
- end;
- TS_RENDERER_OPENGL:
- begin
- if OpenGL_initialized then begin
- if Context.Renderer <> nil then
- Context.Renderer.Free;
-
- Context.Renderer := TtsRendererOpenGL.Create(Context);
- end else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_SET_PARAMETER);
- end
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
- end else
- // Renderer only can set if no Images/Fonts exist
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- // opengl texture size
- TS_RENDERER_OPENGL_TEXTURE_SIZE:
- if Context.Renderer <> nil then begin
- if Context.Renderer is TtsRendererOpenGL then begin
- case pParam^ of
- TS_RENDERER_OPENGL_TEXTURE_SIZE_128:
- TtsRendererOpenGL(Context.Renderer).TextureSize := 128;
-
- TS_RENDERER_OPENGL_TEXTURE_SIZE_256:
- TtsRendererOpenGL(Context.Renderer).TextureSize := 256;
-
- TS_RENDERER_OPENGL_TEXTURE_SIZE_512:
- TtsRendererOpenGL(Context.Renderer).TextureSize := 512;
-
- TS_RENDERER_OPENGL_TEXTURE_SIZE_1024:
- TtsRendererOpenGL(Context.Renderer).TextureSize := 1024;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_SET_PARAMETER);
-
- // null renderer saves char images
- TS_RENDERER_NULL_SAVE_IMAGES:
- if Context.Renderer <> nil then begin
- if Context.Renderer is TtsRendererNULL then begin
- case pParam^ of
- TS_FALSE:
- Context.Renderer.SaveImages := False;
-
- TS_TRUE:
- Context.Renderer.SaveImages := True;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_SET_PARAMETER);
-
- // Align
- TS_ALIGN:
- if not Context.IsLocked then begin
- case pParam^ of
- TS_ALIGN_LEFT:
- Context.gAlign := TS_ALIGN_LEFT;
- TS_ALIGN_CENTER:
- Context.gAlign := TS_ALIGN_CENTER;
- TS_ALIGN_RIGHT:
- Context.gAlign := TS_ALIGN_RIGHT;
- TS_ALIGN_BLOCK:
- Context.gAlign := TS_ALIGN_BLOCK;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- // Vertical Align
- TS_VALIGN:
- if not Context.IsLocked then begin
- case pParam^ of
- TS_VALIGN_TOP:
- Context.gVAlign := TS_VALIGN_TOP;
- TS_VALIGN_CENTER:
- Context.gVAlign := TS_VALIGN_CENTER;
- TS_VALIGN_BOTTOM:
- Context.gVAlign := TS_VALIGN_BOTTOM;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- // Clipping
- TS_CLIP:
- if not Context.IsLocked then begin
- case pParam^ of
- TS_CLIP_COMPLETE:
- Context.gClip := TS_CLIP_COMPLETE;
- TS_CLIP_BORDER:
- Context.gClip := TS_CLIP_BORDER;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- // block offset
- TS_BLOCK_OFFSET_X:
- if not Context.IsLocked then begin
- Context.gBlockOffsetX := pParam^;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- TS_BLOCK_OFFSET_Y:
- if not Context.IsLocked then begin
- Context.gBlockOffsetY := pParam^;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_SET_PARAMETER);
-
- // single line
- TS_SINGLE_LINE:
- case pParam^ of
- TS_SINGLE_LINE_TOP:
- Context.gSingleLine := TS_SINGLE_LINE_TOP;
- TS_SINGLE_LINE_BASELINE:
- Context.gSingleLine := TS_SINGLE_LINE_BASELINE;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- {
- TS_TAB:
- case pParam^ of
- TS_TAB_FIXED:
- gTab := TS_TAB_FIXED;
- TS_TAB_ABSOLUTE:
- gTab := TS_TAB_ABSOLUTE;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- TS_TAB_FIXED_WIDTH:
- gTabWidth := pParam^;
- }
- // image modes
- TS_IMAGE_RED_MODE:
- case pParam^ of
- TS_MODE_REPLACE:
- Context.gImageMode[tsModeRed] := TS_MODE_REPLACE;
- TS_MODE_MODULATE:
- Context.gImageMode[tsModeRed] := TS_MODE_MODULATE;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- TS_IMAGE_GREEN_MODE:
- case pParam^ of
- TS_MODE_REPLACE:
- Context.gImageMode[tsModeGreen] := TS_MODE_REPLACE;
- TS_MODE_MODULATE:
- Context.gImageMode[tsModeGreen] := TS_MODE_MODULATE;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- TS_IMAGE_BLUE_MODE:
- case pParam^ of
- TS_MODE_REPLACE:
- Context.gImageMode[tsModeBlue] := TS_MODE_REPLACE;
- TS_MODE_MODULATE:
- Context.gImageMode[tsModeBlue] := TS_MODE_MODULATE;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- TS_IMAGE_ALPHA_MODE:
- case pParam^ of
- TS_MODE_REPLACE:
- Context.gImageMode[tsModeAlpha] := TS_MODE_REPLACE;
- TS_MODE_MODULATE:
- Context.gImageMode[tsModeAlpha] := TS_MODE_MODULATE;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- TS_IMAGE_LUMINANCE_MODE:
- case pParam^ of
- TS_MODE_REPLACE:
- Context.gImageMode[tsModeLuminance] := TS_MODE_REPLACE;
- TS_MODE_MODULATE:
- Context.gImageMode[tsModeLuminance] := TS_MODE_MODULATE;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- TS_IMAGE_LIBRARY:
- case pParam^ of
- TS_IMAGE_LIBRARY_SDL:
- Context.gImageLibrary := TS_IMAGE_LIBRARY_SDL;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- // code pages
- TS_EMPTY_CP_ENTRY:
- case pParam^ of
- TS_EMPTY_CP_ENTRY_IGNORE:
- Context.gEmptyCodePageEntry := TS_EMPTY_CP_ENTRY_IGNORE;
- TS_EMPTY_CP_ENTRY_USE_DEFAULT:
- Context.gEmptyCodePageEntry := TS_EMPTY_CP_ENTRY_USE_DEFAULT;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- TS_CODEPAGE:
- case pParam^ of
- TS_CODEPAGE_UTF8:
- SetCodePage(TS_CODEPAGE_UTF8, nil, nil);
- TS_CODEPAGE_8859_1:
- SetCodePage(TS_CODEPAGE_8859_1, nil, nil);
- TS_CODEPAGE_8859_2:
- SetCodePage(TS_CODEPAGE_8859_2, tsAnsiSBCDToWide, @CP_8859_2);
- TS_CODEPAGE_8859_3:
- SetCodePage(TS_CODEPAGE_8859_3, tsAnsiSBCDToWide, @CP_8859_3);
- TS_CODEPAGE_8859_4:
- SetCodePage(TS_CODEPAGE_8859_4, tsAnsiSBCDToWide, @CP_8859_4);
- TS_CODEPAGE_8859_5:
- SetCodePage(TS_CODEPAGE_8859_5, tsAnsiSBCDToWide, @CP_8859_5);
- TS_CODEPAGE_8859_6:
- SetCodePage(TS_CODEPAGE_8859_6, tsAnsiSBCDToWide, @CP_8859_6);
- TS_CODEPAGE_8859_7:
- SetCodePage(TS_CODEPAGE_8859_7, tsAnsiSBCDToWide, @CP_8859_7);
- TS_CODEPAGE_8859_8:
- SetCodePage(TS_CODEPAGE_8859_8, tsAnsiSBCDToWide, @CP_8859_8);
- TS_CODEPAGE_8859_9:
- SetCodePage(TS_CODEPAGE_8859_9, tsAnsiSBCDToWide, @CP_8859_9);
- TS_CODEPAGE_8859_10:
- SetCodePage(TS_CODEPAGE_8859_10, tsAnsiSBCDToWide, @CP_8859_10);
- TS_CODEPAGE_8859_11:
- SetCodePage(TS_CODEPAGE_8859_11, tsAnsiSBCDToWide, @CP_8859_11);
- TS_CODEPAGE_8859_13:
- SetCodePage(TS_CODEPAGE_8859_13, tsAnsiSBCDToWide, @CP_8859_13);
- TS_CODEPAGE_8859_14:
- SetCodePage(TS_CODEPAGE_8859_14, tsAnsiSBCDToWide, @CP_8859_14);
- TS_CODEPAGE_8859_15:
- SetCodePage(TS_CODEPAGE_8859_15, tsAnsiSBCDToWide, @CP_8859_15);
- TS_CODEPAGE_8859_16:
- SetCodePage(TS_CODEPAGE_8859_16, tsAnsiSBCDToWide, @CP_8859_16);
- TS_CODEPAGE_037:
- SetCodePage(TS_CODEPAGE_037, tsAnsiSBCDToWide, @CP_037);
- TS_CODEPAGE_437:
- SetCodePage(TS_CODEPAGE_437, tsAnsiSBCDToWide, @CP_437);
- TS_CODEPAGE_500:
- SetCodePage(TS_CODEPAGE_500, tsAnsiSBCDToWide, @CP_500);
- TS_CODEPAGE_737:
- SetCodePage(TS_CODEPAGE_737, tsAnsiSBCDToWide, @CP_737);
- TS_CODEPAGE_775:
- SetCodePage(TS_CODEPAGE_775, tsAnsiSBCDToWide, @CP_775);
- TS_CODEPAGE_850:
- SetCodePage(TS_CODEPAGE_850, tsAnsiSBCDToWide, @CP_850);
- TS_CODEPAGE_852:
- SetCodePage(TS_CODEPAGE_852, tsAnsiSBCDToWide, @CP_852);
- TS_CODEPAGE_855:
- SetCodePage(TS_CODEPAGE_855, tsAnsiSBCDToWide, @CP_855);
- TS_CODEPAGE_857:
- SetCodePage(TS_CODEPAGE_857, tsAnsiSBCDToWide, @CP_857);
- TS_CODEPAGE_860:
- SetCodePage(TS_CODEPAGE_860, tsAnsiSBCDToWide, @CP_860);
- TS_CODEPAGE_861:
- SetCodePage(TS_CODEPAGE_861, tsAnsiSBCDToWide, @CP_861);
- TS_CODEPAGE_862:
- SetCodePage(TS_CODEPAGE_862, tsAnsiSBCDToWide, @CP_862);
- TS_CODEPAGE_863:
- SetCodePage(TS_CODEPAGE_863, tsAnsiSBCDToWide, @CP_863);
- TS_CODEPAGE_864:
- SetCodePage(TS_CODEPAGE_864, tsAnsiSBCDToWide, @CP_864);
- TS_CODEPAGE_865:
- SetCodePage(TS_CODEPAGE_865, tsAnsiSBCDToWide, @CP_865);
- TS_CODEPAGE_866:
- SetCodePage(TS_CODEPAGE_866, tsAnsiSBCDToWide, @CP_866);
- TS_CODEPAGE_869:
- SetCodePage(TS_CODEPAGE_869, tsAnsiSBCDToWide, @CP_869);
- TS_CODEPAGE_874:
- SetCodePage(TS_CODEPAGE_874, tsAnsiSBCDToWide, @CP_874);
- TS_CODEPAGE_875:
- SetCodePage(TS_CODEPAGE_875, tsAnsiSBCDToWide, @CP_875);
- TS_CODEPAGE_1026:
- SetCodePage(TS_CODEPAGE_1026, tsAnsiSBCDToWide, @CP_1026);
- TS_CODEPAGE_1250:
- SetCodePage(TS_CODEPAGE_1250, tsAnsiSBCDToWide, @CP_1250);
- TS_CODEPAGE_1251:
- SetCodePage(TS_CODEPAGE_1251, tsAnsiSBCDToWide, @CP_1251);
- TS_CODEPAGE_1252:
- SetCodePage(TS_CODEPAGE_1252, tsAnsiSBCDToWide, @CP_1252);
- TS_CODEPAGE_1253:
- SetCodePage(TS_CODEPAGE_1253, tsAnsiSBCDToWide, @CP_1253);
- TS_CODEPAGE_1254:
- SetCodePage(TS_CODEPAGE_1254, tsAnsiSBCDToWide, @CP_1254);
- TS_CODEPAGE_1255:
- SetCodePage(TS_CODEPAGE_1255, tsAnsiSBCDToWide, @CP_1255);
- TS_CODEPAGE_1256:
- SetCodePage(TS_CODEPAGE_1256, tsAnsiSBCDToWide, @CP_1256);
- TS_CODEPAGE_1257:
- SetCodePage(TS_CODEPAGE_1257, tsAnsiSBCDToWide, @CP_1257);
- TS_CODEPAGE_1258:
- SetCodePage(TS_CODEPAGE_1258, tsAnsiSBCDToWide, @CP_1258);
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
-
- TS_DEBUG_DRAW_CHAR_RECTS:
- case pParam^ of
- TS_TRUE:
- Context.gDebugDrawCharRects := True;
- TS_FALSE:
- Context.gDebugDrawCharRects := False;
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end;
- else
- SetError(TS_INVALID_ENUM, TS_FUNC_SET_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_SET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_SET_PARAMETER);
-end;
-
-
-function tsGetParameteri(ParamName: tsEnum): tsInt;
-begin
- tsGetParameteriv(ParamName, @Result);
-end;
-
-
-procedure tsGetParameteriv(ParamName: tsEnum; pParam: ptsInt);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if pParam <> nil then begin
- pParam^ := 0;
-
- case ParamName of
- TS_INFO_MAYOR_VERSION:
- pParam^ := TS_MAYOR_VERSION;
-
- TS_INFO_MINOR_VERSION:
- pParam^ := TS_MINOR_VERSION;
-
- TS_INFO_BUILD_NUMBER:
- pParam^ := TS_BUILD_NUMBER;
-
- TS_CONTEXT_BINDING:
- if Context <> nil then begin
- pParam^ := Context.ContextID;
- end;
-
- // font
- TS_FONT_STYLE:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := TS_STYLE_NORMAL;
-
- with Context.ActiveFont do begin
- if tsStyleBold in Style then
- pParam^ := pParam^ or TS_STYLE_BOLD;
-
- if tsStyleItalic in Style then
- pParam^ := pParam^ or TS_STYLE_ITALIC;
-
- if tsStyleUnderline in Style then
- pParam^ := pParam^ or TS_STYLE_UNDERLINE;
-
- if tsStyleStrikeout in Style then
- pParam^ := pParam^ or TS_STYLE_STRIKEOUT;
- end;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_FILE_STYLE:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := Context.ActiveFont.FontFileStyle;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_FIXED_WIDTH:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont.FixedWidth then
- pParam^ := TS_TRUE
- else
- pParam^ := TS_FALSE;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_ASCENT:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := Context.ActiveFont.Ascent;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_DESCENT:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := Context.ActiveFont.Descent;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_EXTERNAL_LEADING:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := Context.ActiveFont.ExternalLeading;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_BASELINE_OFFSET:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := Context.ActiveFont.BaselineOffset;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_LINESKIP:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- with Context.ActiveFont do
- pParam^ := Ascent + Descent + ExternalLeading;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_ANTIALIASING:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- case Context.ActiveFont.AntiAliasing of
- tsAANone:
- pParam^ := TS_ANTIALIASING_NONE;
- tsAANormal:
- pParam^ := TS_ANTIALIASING_NORMAL;
- end;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_FORMAT:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- case Context.ActiveFont.Format of
- tsFormatEmpty:
- pParam^ := TS_FORMAT_EMPTY;
- tsFormatRGBA8:
- pParam^ := TS_FORMAT_RGBA8;
- end;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_CHAR_SPACING:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := Context.ActiveFont.CharSpacing;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_LINE_SPACING:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := Context.ActiveFont.LineSpacing;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_UNDERLINE_POSITION:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := Context.ActiveFont.UnderlinePosition;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_UNDERLINE_SIZE:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := Context.ActiveFont.UnderlineSize;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_STRIKEOUT_POSITION:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := Context.ActiveFont.StrikeoutPosition;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_STRIKEOUT_SIZE:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- pParam^ := Context.ActiveFont.StrikeoutSize;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- // globals
- TS_GLOBAL_ANTIALIASING:
- if Context <> nil then begin
- pParam^ := Context.gGlobalAntiAliasing;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_GLOBAL_FORMAT:
- if Context <> nil then begin
- pParam^ := Context.gGlobalFormat;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- // creator
- TS_CREATOR:
- if Context <> nil then begin
- pParam^ := Context.gCreator;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_CREATOR_CREATE_CHARS:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont is TtsFontCreator then begin
- if TtsFontCreator(Context.ActiveFont).CreateChars then
- pParam^ := TS_TRUE
- else
- pParam^ := TS_FALSE;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_CREATOR_ADD_RESIZING_BORDER:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont is TtsFontCreator then begin
- if TtsFontCreator(Context.ActiveFont).AddResizingBorder then
- pParam^ := TS_TRUE
- else
- pParam^ := TS_FALSE;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- // Renderer
- TS_RENDERER:
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- if Context.Renderer is TtsRendererNULL then begin
- pParam^ := TS_RENDERER_NULL;
- end else
- if Context.Renderer is TtsRendererOpenGL then begin
- pParam^ := TS_RENDERER_OPENGL;
- end else
- SetError(TS_ERROR, TS_FUNC_GET_PARAMETER);
- end;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- // opengl texture size
- TS_RENDERER_OPENGL_TEXTURE_SIZE:
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- if Context.Renderer is TtsRendererOpenGL then begin
- pParam^ := TtsRendererOpenGL(Context.Renderer).TextureSize;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- // null renderer must save images
- TS_RENDERER_NULL_SAVE_IMAGES:
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- if Context.Renderer is TtsRendererNULL then begin
- case Context.Renderer.SaveImages of
- True:
- pParam^ := TS_TRUE;
- False:
- pParam^ := TS_FALSE;
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_ALIGN:
- if Context <> nil then begin
- pParam^ := Context.gAlign;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_VALIGN:
- if Context <> nil then begin
- pParam^ := Context.gVAlign;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_CLIP:
- if Context <> nil then begin
- pParam^ := Context.gClip;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_BLOCK_OFFSET_X:
- if Context <> nil then begin
- pParam^ := Context.gBlockOffsetX;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_BLOCK_OFFSET_Y:
- if Context <> nil then begin
- pParam^ := Context.gBlockOffsetY;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
-{
- TS_TAB:
- pParam^ := gTab;
-
- TS_TAB_FIXED_WIDTH:
- pParam^ := gTabWidth;
-}
-
- TS_SINGLE_LINE:
- if Context <> nil then begin
- pParam^ := Context.gSingleLine;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_IMAGE_RED_MODE:
- if Context <> nil then begin
- pParam^ := Context.gImageMode[tsModeRed];
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_IMAGE_GREEN_MODE:
- if Context <> nil then begin
- pParam^ := Context.gImageMode[tsModeGreen];
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_IMAGE_BLUE_MODE:
- if Context <> nil then begin
- pParam^ := Context.gImageMode[tsModeBlue];
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_IMAGE_ALPHA_MODE:
- if Context <> nil then begin
- pParam^ := Context.gImageMode[tsModeAlpha];
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_IMAGE_LUMINANCE_MODE:
- if Context <> nil then begin
- pParam^ := Context.gImageMode[tsModeLuminance];
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_IMAGE_LIBRARY:
- if Context <> nil then begin
- pParam^ := Context.gImageLibrary;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_EMPTY_CP_ENTRY:
- if Context <> nil then begin
- pParam^ := Context.gEmptyCodePageEntry;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_CODEPAGE:
- if Context <> nil then begin
- pParam^ := Context.gCodePage;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_DEBUG_DRAW_CHAR_RECTS:
- if Context <> nil then begin
- case Context.gDebugDrawCharRects of
- True:
- pParam^ := TS_TRUE;
- False:
- pParam^ := TS_FALSE;
- end;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
-
- TS_FONT_BINDING:
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- pParam^ := Context.Renderer.ActiveFontID;
- end
- else SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_GET_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_PARAMETER);
- else
- SetError(TS_INVALID_ENUM, TS_FUNC_GET_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_GET_PARAMETER);
-end;
-
-
-function tsGetStringA(ParamName: tsEnum): pAnsiChar;
-var
- Context: TtsContext;
-begin
- Result := nil;
-
- Context := gContext;
-
- case ParamName of
- TS_INFO_VERSION:
- if TS_VERSION_STR <> '' then
- Result := pAnsiChar(TS_VERSION_STR);
-
- TS_INFO_COPYRIGHT:
- if TS_COPYRIGHT_STR <> '' then
- Result := pAnsiChar(TS_COPYRIGHT_STR);
-
- TS_FONT_COPYRIGHT:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont.Copyright <> '' then
- Result := pAnsiChar(Context.ActiveFont.Copyright);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_STRING);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_STRING);
-
- TS_FONT_FACE_NAME:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont.FaceName <> '' then
- Result := pAnsiChar(Context.ActiveFont.FaceName);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_STRING);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_STRING);
-
- TS_FONT_STYLE_NAME:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont.StyleName <> '' then
- Result := pAnsiChar(Context.ActiveFont.StyleName);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_STRING);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_STRING);
-
- TS_FONT_FULL_NAME:
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont.FullName <> '' then
- Result := pAnsiChar(Context.ActiveFont.FullName);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_GET_STRING);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_GET_STRING);
- else
- SetError(TS_INVALID_ENUM, TS_FUNC_GET_STRING);
- end;
-end;
-
-
-// *** Context functions ***
-procedure tsContextCreate(pContextID: ptsContextID);
-begin
- if TextSuite_initialized then begin
- if pContextID <> nil then begin
- try
- gCriticalSection.Enter;
- try
- // unbound current context
- if gContext <> nil then begin
- gContext.gBoundThreadID := 0;
- gContext := nil;
- end;
-
- // create Context and bound it
- gContext := TtsContext.Create;
- gContext.gBoundThreadID := GetCurrentThreadId;
-
- // add to list
- gContexts.Add(gContext.ContextID, gContext);
-
- // return context id
- pContextID^ := gContext.ContextID;
- finally
- gCriticalSection.Leave;
- end;
- except
- on E: Exception do begin
- if E is EOutOfMemory then
- SetError(TS_OUT_OF_MEMORY, TS_FUNC_CONTEXT_CREATE)
- else
- SetError(TS_ERROR, TS_FUNC_CONTEXT_CREATE);
-
- pContextID^ := 0;
- end;
- end;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_CONTEXT_CREATE);
- end else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_CONTEXT_CREATE);
-end;
-
-
-procedure tsContextDestroy(ContextID: tsContextID);
-var
- Context: TtsContext;
-begin
- if TextSuite_initialized then begin
- try
- gCriticalSection.Enter;
- try
- Context := gContexts.Get(ContextID);
-
- if Context <> nil then begin
- // if context isn't bound or to actual thread
- if (Context.gBoundThreadID = 0) or (Context.gBoundThreadID = GetCurrentThreadId) then begin
- // if it's bound to actual thread
- if Context.gBoundThreadID = GetCurrentThreadId then begin
- gContext.gBoundThreadID := 0;
- gContext := nil;
- end;
-
- // delete from list
- gContexts.Delete(ContextID);
-
- // free them
- Context.Free;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_CONTEXT_DESTROY);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_CONTEXT_DESTROY);
- finally
- gCriticalSection.Leave;
- end;
- except
- SetError(TS_ERROR, TS_FUNC_CONTEXT_DESTROY);
- end;
- end else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_CONTEXT_DESTROY);
-end;
-
-
-procedure tsContextBind(ContextID: tsContextID);
-var
- Context: TtsContext;
-begin
- if TextSuite_initialized then begin
- gCriticalSection.Enter;
- try
- // if any context is bound then release him
- if gContext <> nil then begin
- gContext.gBoundThreadID := 0;
- gContext := nil;
- end;
-
- // bind new context if <> zero
- if ContextID <> 0 then begin
- Context := gContexts.Get(ContextID);
-
- if Context <> nil then begin
- // check if the context is bound or bound to actual context
- if (Context.gBoundThreadID = 0) or (Context.gBoundThreadID = GetCurrentThreadId) then begin
- gContext := Context;
- gContext.gBoundThreadID := GetCurrentThreadId;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_CONTEXT_BIND);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_CONTEXT_BIND);
- end;
- finally
- gCriticalSection.Leave;
- end;
- end else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_CONTEXT_BIND);
-end;
-
-
-// *** font functions ***
-//procedure tsFontCreate(pFontID: ptsFontID);
-//begin
-
-//end;
-
-
-procedure tsFontCreateCreatorA(Name: pAnsiChar; Size: tsInt; Style: tsBitmask; AntiAliasing: tsEnum; Format: tsEnum; pFontID: ptsFontID);
-var
- Context: TtsContext;
-
- TempStyle: TtsFontStyles;
- TempAntiAliasing: TtsAntiAliasing;
- TempFormat: TtsFormat;
-
- Creator: TtsFontCreator;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- if pFontID <> nil then begin
- pFontID^ := 0;
-
- // Style
- TempStyle := [];
-
- if (Style and TS_STYLE_BOLD) > 0 then
- TempStyle := TempStyle + [tsStyleBold];
-
- if (Style and TS_STYLE_ITALIC) > 0 then
- TempStyle := TempStyle + [tsStyleItalic];
-
- if (Style and TS_STYLE_UNDERLINE) > 0 then
- TempStyle := TempStyle + [tsStyleUnderline];
-
- if (Style and TS_STYLE_STRIKEOUT) > 0 then
- TempStyle := TempStyle + [tsStyleStrikeout];
-
- // AntiAliasing
- if AntiAliasing = TS_DEFAULT then
- AntiAliasing := Context.gGlobalAntiAliasing;
-
- case AntiAliasing of
- TS_ANTIALIASING_NONE:
- TempAntiAliasing := tsAANone;
- TS_ANTIALIASING_NORMAL:
- TempAntiAliasing := tsAANormal;
- else
- SetError(TS_INVALID_ENUM, TS_FUNC_FONT_CREATE_CREATOR);
-
- Exit;
- end;
-
- // Format
- if Format = TS_DEFAULT then
- Format := Context.gGlobalFormat;
-
- case Format of
- TS_FORMAT_RGBA8:
- TempFormat := tsFormatRGBA8;
- else
- SetError(TS_INVALID_ENUM, TS_FUNC_FONT_CREATE_CREATOR);
-
- Exit;
- end;
-
- Creator := nil;
-
- // create font
- try
- case Context.gCreator of
- TS_CREATOR_SDL:
- begin
- if SDL_TTF_initialized then
- Creator := TtsFontCreatorSDL.Create(Context.Renderer, Name, Size, TempStyle, TempFormat, TempAntiAliasing)
- else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_FONT_CREATE_CREATOR);
- end;
- TS_CREATOR_GDI:
- begin
- if GDI_initialized then
- Creator := TtsFontCreatorGDIFile.Create(Context.Renderer, Name, Size, TempStyle, TempFormat, TempAntiAliasing)
- else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_FONT_CREATE_CREATOR);
- end;
- TS_CREATOR_GDI_FACENAME:
- begin
- if GDI_initialized then
- Creator := TtsFontCreatorGDIFontFace.Create(Context.Renderer, Name, Size, TempStyle, TempFormat, TempAntiAliasing)
- else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_FONT_CREATE_CREATOR);
- end;
- TS_CREATOR_GDI_STREAM:
- begin
- if GDI_initialized then
- Creator := TtsFontCreatorGDIStream.Create(Context.Renderer, TStream(Name), Size, TempStyle, TempFormat, TempAntiAliasing)
- else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_FONT_CREATE_CREATOR);
- end;
- else
- SetError(TS_INVALID_ENUM, TS_FUNC_FONT_CREATE_CREATOR);
- end;
- except
- on E: Exception do begin
- if E is EOutOfMemory then
- SetError(TS_OUT_OF_MEMORY, TS_FUNC_FONT_CREATE_CREATOR)
- else
- SetError(TS_ERROR, TS_FUNC_FONT_CREATE_CREATOR);
- Exit;
- end;
- end;
-
- // Bind font
- if Creator <> nil then begin
- pFontID^ := Context.FontAdd(Creator);
-
- tsFontBind(pFontID^);
- end;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_FONT_CREATE_CREATOR);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_FONT_CREATE_CREATOR);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_CREATE_CREATOR);
-end;
-
-
-procedure tsFontDestroy(FontID: tsFontID);
-var
- Context: TtsContext;
- Font: TtsFont;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if not Context.IsLocked then begin
- Font := Context.FontGet(FontID);
-
- if Font <> nil then begin
- Context.FontDelete(FontID);
-
- Font.Free;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_FONT_DESTROY);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_DESTROY);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_DESTROY);
-end;
-
-
-procedure tsFontBind(FontID: tsFontID);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- if (FontID = 0) or (Context.FontGet(FontID) <> nil) then begin
- Context.Renderer.FontActivate(FontID);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_FONT_BIND);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_FONT_BIND);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_BIND);
-end;
-
-
-procedure tsFontAddCharRange(CharStart: WideChar; CharEnd: WideChar);
-var
- ActiveFont: TtsFont;
- CharIdx: WideChar;
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- ActiveFont := Context.ActiveFont;
-
- if ActiveFont <> nil then begin
- if ActiveFont is TtsFontCreator then begin
- for CharIdx := CharStart to CharEnd do
- TtsFontCreator(ActiveFont).AddChar(CharIdx);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_ADD_CHAR);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_ADD_CHAR);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_ADD_CHAR);
-end;
-
-
-procedure tsFontAddChars(Chars: pWideChar);
-var
- ActiveFont: TtsFont;
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- ActiveFont := Context.ActiveFont;
-
- if ActiveFont <> nil then begin
- if ActiveFont is TtsFontCreator then begin
- if Chars <> nil then begin
- while Chars^ <> #0 do begin
- TtsFontCreator(ActiveFont).AddChar(Chars^);
-
- Inc(Chars);
- end;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_FONT_ADD_CHAR);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_ADD_CHAR);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_ADD_CHAR);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_ADD_CHAR);
-end;
-
-
-procedure tsFontAddChar(Char: WideChar);
-var
- ActiveFont: TtsFont;
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- ActiveFont := Context.ActiveFont;
-
- if ActiveFont <> nil then begin
- if ActiveFont is TtsFontCreator then begin
- TtsFontCreator(ActiveFont).AddChar(Char);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_ADD_CHAR);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_ADD_CHAR);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_ADD_CHAR);
-end;
-
-
-procedure tsFontDeleteCharRange(CharStart: WideChar; CharEnd: WideChar);
-var
- Char: WideChar;
- ActiveFont: TtsFont;
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- ActiveFont := Context.ActiveFont;
-
- if ActiveFont <> nil then begin
- if ActiveFont is TtsFontCreator then begin
- for Char := CharStart to CharEnd do
- TtsFontCreator(ActiveFont).DeleteChar(Char);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_DELETE_CHAR);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_DELETE_CHAR);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_DELETE_CHAR);
-end;
-
-
-procedure tsFontDeleteChars(Chars: pWideChar);
-var
- ActiveFont: TtsFont;
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- ActiveFont := Context.ActiveFont;
-
- if ActiveFont <> nil then begin
- if ActiveFont is TtsFontCreator then begin
- if Chars <> nil then begin
- while Chars^ <> #0 do begin
- TtsFontCreator(ActiveFont).DeleteChar(Chars^);
-
- Inc(Chars);
- end;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_FONT_DELETE_CHAR);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_DELETE_CHAR);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_DELETE_CHAR);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_DELETE_CHAR);
-end;
-
-
-procedure tsFontDeleteChar(Char: WideChar);
-var
- ActiveFont: TtsFont;
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- ActiveFont := Context.ActiveFont;
-
- if ActiveFont <> nil then begin
- if ActiveFont is TtsFontCreator then begin
- TtsFontCreator(Context.ActiveFont).DeleteChar(Char);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_FONT_DELETE_CHAR);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_DELETE_CHAR);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_DELETE_CHAR);
-end;
-
-
-procedure tsFontSetCharParameteri(Char: WideChar; ParamName: tsEnum; Param: tsInt);
-begin
- if ((ParamName <> TS_CHAR_GLYPHORIGIN) and
- (ParamName <> TS_CHAR_GLYPHRECT)) then begin
- tsFontSetCharParameteriv(Char, ParamName, @Param);
- end else
- SetError(TS_INVALID_ENUM, TS_FUNC_FONT_SET_CHAR_PARAMETER);
-end;
-
-
-procedure tsFontSetCharParameteriv(Char: WideChar; ParamName: tsEnum; pParam: ptsInt);
-var
- tsChar: TtsChar;
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if pParam <> nil then begin
- tsChar := Context.ActiveFont.Char[Char];
-
- if tsChar <> nil then begin
- case ParamName of
- TS_CHAR_ADVANCE:
- tsChar.Advance := pParam^;
-
- TS_CHAR_GLYPHORIGIN:
- begin
- tsChar.GlyphOriginX := ptsPoint(pParam)^.X;
- tsChar.GlyphOriginY := ptsPoint(pParam)^.Y;
- end;
-
- TS_CHAR_GLYPHORIGIN_X:
- tsChar.GlyphOriginX := pParam^;
-
- TS_CHAR_GLYPHORIGIN_Y:
- tsChar.GlyphOriginY := pParam^;
-
- TS_CHAR_GLYPHRECT:
- tsChar.GlyphRect := pTsRect(pParam)^;
-
- TS_CHAR_GLYPHRECT_TOP:
- tsChar.GlyphRect.Top := pParam^;
-
- TS_CHAR_GLYPHRECT_LEFT:
- tsChar.GlyphRect.Left := pParam^;
-
- TS_CHAR_GLYPHRECT_RIGHT:
- tsChar.GlyphRect.Right := pParam^;
-
- TS_CHAR_GLYPHRECT_BOTTOM:
- tsChar.GlyphRect.Bottom := pParam^;
- else
- SetError(TS_INVALID_ENUM, TS_FUNC_FONT_SET_CHAR_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_FONT_SET_CHAR_PARAMETER);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_FONT_SET_CHAR_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_SET_CHAR_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_SET_CHAR_PARAMETER);
-end;
-
-
-function tsFontGetCharParameteri(Char: WideChar; ParamName: tsEnum): tsInt;
-begin
- if ((ParamName <> TS_CHAR_GLYPHORIGIN) and
- (ParamName <> TS_CHAR_GLYPHRECT)) then begin
- tsFontGetCharParameteriv(Char, ParamName, @Result);
- end else
- SetError(TS_INVALID_ENUM, TS_FUNC_FONT_GET_CHAR_PARAMETER);
-end;
-
-
-procedure tsFontGetCharParameteriv(Char: WideChar; ParamName: tsEnum; pParam: ptsInt);
-var
- tsChar: TtsChar;
- Context: TtsContext;
-begin
- pParam^ := 0;
- Context := gContext;
-
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if pParam <> nil then begin
- tsChar := Context.ActiveFont.Char[Char];
-
- if tsChar <> nil then begin
- case ParamName of
- TS_CHAR_ADVANCE:
- pParam^ := tsChar.Advance;
- TS_CHAR_GLYPHORIGIN:
- begin
- ptsPoint(pParam)^.X := tsChar.GlyphOriginX;
- ptsPoint(pParam)^.Y := tsChar.GlyphOriginY;
- end;
- TS_CHAR_GLYPHORIGIN_X:
- pParam^ := tsChar.GlyphOriginX;
- TS_CHAR_GLYPHORIGIN_Y:
- pParam^ := tsChar.GlyphOriginY;
- TS_CHAR_GLYPHRECT:
- PtsRect(pParam)^ := tsChar.GlyphRect;
- TS_CHAR_GLYPHRECT_TOP:
- pParam^ := tsChar.GlyphRect.Top;
- TS_CHAR_GLYPHRECT_LEFT:
- pParam^ := tsChar.GlyphRect.Left;
- TS_CHAR_GLYPHRECT_RIGHT:
- pParam^ := tsChar.GlyphRect.Right;
- TS_CHAR_GLYPHRECT_BOTTOM:
- pParam^ := tsChar.GlyphRect.Bottom;
- else
- SetError(TS_INVALID_ENUM, TS_FUNC_FONT_GET_CHAR_PARAMETER);
- end;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_FONT_GET_CHAR_PARAMETER);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_FONT_GET_CHAR_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_FONT_GET_CHAR_PARAMETER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_FONT_GET_CHAR_PARAMETER);
-end;
-
-
-procedure tsPostAddFillColor3ub(Red, Green, Blue: tsByte; ChannelMask: tsBitmask);
-begin
- tsPostAddFillColor4f(Red / $FF, Green / $FF, Blue / $FF, 1, ChannelMask);
-end;
-
-
-procedure tsPostAddFillColor3f(Red, Green, Blue: tsFloat; ChannelMask: tsBitmask);
-begin
- tsPostAddFillColor4f(Red, Green, Blue, 1, ChannelMask);
-end;
-
-
-procedure tsPostAddFillColor4ub(Red, Green, Blue, Alpha: tsByte; ChannelMask: tsBitmask);
-begin
- tsPostAddFillColor4f(Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF, ChannelMask);
-end;
-
-
-procedure tsPostAddFillColor4f(Red, Green, Blue, Alpha: tsFloat; ChannelMask: tsBitmask);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont is TtsFontCreator then begin
- TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostFillColor.Create(Red, Green, Blue, Alpha, ChannelMask, Context.gImageMode));
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_FILL_COLOR);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_FILL_COLOR);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_FILL_COLOR);
-end;
-
-
-procedure tsPostAddFillPattern(PatternImageID: tsImageID; X, Y: tsInt; ChannelMask: tsBitmask);
-var
- Context: TtsContext;
- Image: TtsImage;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont is TtsFontCreator then begin
- Image := Context.ImageGet(PatternImageID);
-
- if Image <> nil then
- TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostFillPattern.Create(Image, X, Y, ChannelMask, Context.gImageMode))
- else
- SetError(TS_INVALID_VALUE, TS_FUNC_POST_ADD_FILL_PATTERN);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_FILL_PATTERN);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_FILL_PATTERN);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_FILL_PATTERN);
-end;
-
-
-procedure tsPostAddBorder3ub(Width, Strength: Single; Red, Green, Blue: tsByte);
-begin
- tsPostAddBorder4f(Width, Strength, Red / $FF, Green / $FF, Blue / $FF, 1);
-end;
-
-
-procedure tsPostAddBorder3f(Width, Strength: Single; Red, Green, Blue: tsFloat);
-begin
- tsPostAddBorder4f(Width, Strength, Red, Green, Blue, 1);
-end;
-
-
-procedure tsPostAddBorder4ub(Width, Strength: Single; Red, Green, Blue, Alpha: tsByte);
-begin
- tsPostAddBorder4f(Width, Strength, Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF);
-end;
-
-
-procedure tsPostAddBorder4f(Width, Strength: Single; Red, Green, Blue, Alpha: tsFloat);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont is TtsFontCreator then begin
- TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostBorder.Create(Width, Strength, Red, Green, Blue, Alpha));
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_BORDER);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_BORDER);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_BORDER);
-end;
-
-
-procedure tsPostAddShadow3ub(Radius: Single; X, Y: tsInt; Red, Green, Blue: tsByte);
-begin
- tsPostAddShadow4f(Radius, X, Y, Red / $FF, Green / $FF, Blue / $FF, 1);
-end;
-
-
-procedure tsPostAddShadow3f(Radius: Single; X, Y: tsInt; Red, Green, Blue: tsFloat);
-begin
- tsPostAddShadow4f(Radius, X, Y, Red, Green, Blue, 1);
-end;
-
-
-procedure tsPostAddShadow4ub(Radius: Single; X, Y: tsInt; Red, Green, Blue, Alpha: tsByte);
-begin
- tsPostAddShadow4f(Radius, X, Y, Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF);
-end;
-
-
-procedure tsPostAddShadow4f(Radius: Single; X, Y: tsInt; Red, Green, Blue, Alpha: tsFloat);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont is TtsFontCreator then begin
- TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostShadow.Create(Radius, X, Y, Red, Green, Blue, Alpha));
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_SHADOW);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_SHADOW);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_SHADOW);
-end;
-
-
-(*
-procedure tsPostAddKerning;
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont is TtsFontCreator then begin
- TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostKerning.Create);
- end else
- SetError(TS_INVALID_OPERATION;
- end else
- SetError(TS_NO_ACTIVE_FONT;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT;
-end;
-*)
-
-procedure tsPostAddCustom(PostProcessProc: tsPostProcessProc; Data: Pointer);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont is TtsFontCreator then begin
- TtsFontCreator(Context.ActiveFont).AddPostProcessStep(TtsPostCustom.Create(Context, PostProcessProc, Data));
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_CUSTOM);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_CUSTOM);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_CUSTOM);
-end;
-
-
-procedure tsPostDelete(PostIndex: tsInt);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.ActiveFont <> nil then begin
- if Context.ActiveFont is TtsFontCreator then begin
- if PostIndex = TS_POST_INDEX_ALL then begin
- TtsFontCreator(Context.ActiveFont).ClearPostProcessSteps;
- end else
-
- begin
- // tranlate to direct index
- if PostIndex = TS_POST_INDEX_LAST then
- PostIndex := TtsFontCreator(Context.ActiveFont).PostProcessStepCount -1;
-
- TtsFontCreator(Context.ActiveFont).DeletePostProcessStep(PostIndex);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_POST_DELETE);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_DELETE);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_DELETE);
-end;
-
-
-procedure tsPostAddUsageRange(PostIndex: tsInt; UsageType: tsEnum; CharStart, CharEnd: WideChar);
-var
- Context: TtsContext;
- ActFont: TtsFont;
- Usage: TtsFontProcessStepUsage;
- Idx: Integer;
-
-
- procedure AssignUsage(Idx: Integer);
- var
- PostProcess: TtsPostProcessStep;
- begin
- PostProcess := TtsFontCreator(ActFont).PostProcessStep[Idx];
-
- if PostProcess <> nil then begin
- PostProcess.AddUsageRange(Usage, CharStart, CharEnd);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_POST_ADD_USAGE);
- end;
-
-begin
- Context := gContext;
-
- if Context <> nil then begin
- ActFont := Context.ActiveFont;
- if ActFont <> nil then begin
- if ActFont is TtsFontCreator then begin
- // getting usagetype
- case UsageType of
- TS_POST_USAGE_INCLUDE:
- Usage := tsUInclude;
- TS_POST_USAGE_EXCLUDE:
- Usage := tsUExclude;
- else
- SetError(TS_INVALID_ENUM, TS_FUNC_POST_ADD_USAGE);
- Exit;
- end;
-
- // add usage to post processors
- if PostIndex = TS_POST_INDEX_ALL then begin
- for Idx := 0 to TtsFontCreator(ActFont).PostProcessStepCount -1 do
- AssignUsage(Idx);
- end else
-
- begin
- if PostIndex = TS_POST_INDEX_LAST then
- PostIndex := TtsFontCreator(ActFont).PostProcessStepCount -1;
-
- AssignUsage(PostIndex);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_USAGE);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_USAGE);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_USAGE);
-end;
-
-
-procedure tsPostAddUsageChars(PostIndex: tsInt; UsageType: tsEnum; Chars: pWideChar);
-var
- Context: TtsContext;
- ActFont: TtsFont;
- Usage: TtsFontProcessStepUsage;
- Idx: Integer;
-
-
- procedure AssignUsage(Idx: Integer);
- var
- PostProcess: TtsPostProcessStep;
- begin
- PostProcess := TtsFontCreator(ActFont).PostProcessStep[Idx];
-
- if PostProcess <> nil then begin
- PostProcess.AddUsageChars(Usage, Chars);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_POST_ADD_USAGE);
- end;
-
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Chars <> nil then begin
- ActFont := Context.ActiveFont;
- if ActFont <> nil then begin
- if ActFont is TtsFontCreator then begin
- // getting usagetype
- case UsageType of
- TS_POST_USAGE_INCLUDE:
- Usage := tsUInclude;
- TS_POST_USAGE_EXCLUDE:
- Usage := tsUExclude;
- else
- SetError(TS_INVALID_ENUM, TS_FUNC_POST_ADD_USAGE);
- Exit;
- end;
-
- // add usage to post processors
- if PostIndex = TS_POST_INDEX_ALL then begin
- for Idx := 0 to TtsFontCreator(ActFont).PostProcessStepCount -1 do
- AssignUsage(Idx);
- end else
-
- begin
- if PostIndex = TS_POST_INDEX_LAST then
- PostIndex := TtsFontCreator(ActFont).PostProcessStepCount -1;
-
- AssignUsage(PostIndex);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_POST_ADD_USAGE);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_ADD_USAGE);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_POST_ADD_USAGE);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_ADD_USAGE);
-end;
-
-
-procedure tsPostClearUsage(PostIndex: tsInt); cdecl;
-var
- Context: TtsContext;
- ActFont: TtsFont;
- Idx: Integer;
-
-
- procedure ClearUsage(Idx: Integer);
- var
- PostProcess: TtsPostProcessStep;
- begin
- PostProcess := TtsFontCreator(ActFont).PostProcessStep[Idx];
-
- if PostProcess <> nil then begin
- PostProcess.ClearIncludeRange;
- PostProcess.ClearExcludeRange;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_POST_CLEAR_USAGE);
- end;
-
-begin
- Context := gContext;
-
- if Context <> nil then begin
- ActFont := Context.ActiveFont;
- if ActFont <> nil then begin
- if ActFont is TtsFontCreator then begin
- if PostIndex = TS_POST_INDEX_ALL then begin
- for Idx := 0 to TtsFontCreator(ActFont).PostProcessStepCount -1 do
- ClearUsage(Idx);
- end else
-
- begin
- if PostIndex = TS_POST_INDEX_LAST then
- PostIndex := TtsFontCreator(ActFont).PostProcessStepCount -1;
-
- ClearUsage(PostIndex);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_POST_CLEAR_USAGE);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_POST_CLEAR_USAGE);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_POST_CLEAR_USAGE);
-end;
-
-
-function tsStringAnsiToWide(pText: pAnsiChar): pWideChar;
-var
- Context: TtsContext;
-begin
- Result := nil;
-
- if TextSuite_initialized then begin
- Context := gContext;
-
- try
- if Context <> nil then begin
- if pText <> nil then begin
- Result := Context.AnsiToWide(pText);
-
- if Result <> nil then begin
- gCriticalSection.Enter;
- try
- gStrings.Add(Result);
- finally
- gCriticalSection.Leave;
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_STRING_ANSI_TO_WIDE);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_STRING_ANSI_TO_WIDE);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_STRING_ANSI_TO_WIDE);
- except
- on E: Exception do begin
- if E is EOutOfMemory then
- SetError(TS_OUT_OF_MEMORY, TS_FUNC_STRING_ANSI_TO_WIDE)
- else
- SetError(TS_ERROR, TS_FUNC_STRING_ANSI_TO_WIDE);
- end;
- end;
- end else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_STRING_ANSI_TO_WIDE);
-end;
-
-
-function tsStringAlloc(Size: tsInt): pWideChar; cdecl;
-begin
- Result := nil;
-
- if TextSuite_initialized then begin
- try
- Result := tsStrAlloc(Size);
-
- gCriticalSection.Enter;
- try
- gStrings.Add(Result);
- finally
- gCriticalSection.Leave;
- end;
- except
- on E: Exception do begin
- if E is EOutOfMemory then
- SetError(TS_OUT_OF_MEMORY, TS_FUNC_STRING_ALLOC)
- else
- SetError(TS_ERROR, TS_FUNC_STRING_ALLOC);
- end;
- end;
- end else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_STRING_ALLOC);
-end;
-
-
-procedure tsStringDispose(pText: pWideChar);
-var
- ValidString: Boolean;
-begin
- if TextSuite_initialized then begin
- if pText <> nil then begin
- try
- // delete String from hash
- gCriticalSection.Enter;
- try
- ValidString := gStrings.Delete(pText);
- finally
- gCriticalSection.Leave;
- end;
-
- // if sting valid free them
- if ValidString then
- tsStrDispose(pText)
- else
- SetError(TS_INVALID_OPERATION, TS_FUNC_STRING_DISPOSE);
- except
- on E: Exception do begin
- if E is EAccessViolation then
- SetError(TS_INVALID_OPERATION, TS_FUNC_STRING_DISPOSE)
- else
- SetError(TS_ERROR, TS_FUNC_STRING_DISPOSE);
- end;
- end;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_STRING_DISPOSE);
- end else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_STRING_DISPOSE);
-end;
-
-
-procedure tsTextBeginBlock(Left, Top, Width, Height: tsInt; Flags: tsBitmask);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- if not Context.IsLocked then begin
- Context.Renderer.BeginBlock(Left, Top, Width, Height, Flags);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_BEGIN_BLOCK);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_BEGIN_BLOCK);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_BEGIN_BLOCK);
-end;
-
-
-procedure tsTextEndBlock;
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- if Context.IsLocked then begin
- Context.Renderer.EndBlock;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_END_BLOCK);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_END_BLOCK);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_END_BLOCK);
-end;
-
-
-procedure tsTextColor3ub(Red, Green, Blue: tsByte);
-begin
- tsTextColor4f(Red / $FF, Green / $FF, Blue / $FF, 1);
-end;
-
-
-procedure tsTextColor3f(Red, Green, Blue: tsFloat);
-begin
- tsTextColor4f(Red, Green, Blue, 1);
-end;
-
-
-procedure tsTextColor4ub(Red, Green, Blue, Alpha: tsByte);
-begin
- tsTextColor4f(Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF);
-end;
-
-
-procedure tsTextColor4f(Red, Green, Blue, Alpha: tsFloat);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- Context.Renderer.Color(Red, Green, Blue, Alpha);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_COLOR);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_COLOR);
-end;
-
-
-procedure tsTextOutA(pText: pAnsiChar);
-var
- pTemp: PWideChar;
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- if Context.ActiveFont <> nil then begin
- if pText <> nil then begin
- // convert text via codepage
- pTemp := Context.AnsiToWide(pText);
- if pTemp <> nil then begin
- try
- Context.Renderer.TextOut(pTemp);
- finally
- tsStrDispose(pTemp);
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_OUT);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_TEXT_OUT);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_TEXT_OUT);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_OUT);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_OUT);
-end;
-
-
-procedure tsTextOutW(pText: pWideChar);
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- if Context.ActiveFont <> nil then begin
- if pText <> nil then begin
- Context.Renderer.TextOut(pText);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_TEXT_OUT);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_TEXT_OUT);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_OUT);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_OUT);
-end;
-
-
-function tsTextGetWidthA(pText: pAnsiChar): tsInt;
-var
- pTemp: PWideChar;
- Context: TtsContext;
-begin
- Result := 0;
- Context := gContext;
-
- if Context <> nil then begin
- pTemp := nil;
-
- // if pText is assigned convert it
- if pText <> nil then begin
- pTemp := Context.AnsiToWide(pText);
-
- if pTemp = nil then begin
- SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_GET_WIDTH);
- Exit;
- end;
- end;
-
- try
- Result := tsTextGetWidthW(pTemp);
- finally
- if pTemp <> nil then
- tsStrDispose(pTemp);
- end;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_GET_WIDTH);
-end;
-
-
-function tsTextGetWidthW(pText: pWideChar): tsInt;
-var
- Context: TtsContext;
-begin
- Result := 0;
-
- Context := gContext;
-
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- // Width from the text
- if pText <> nil then begin
- if Context.ActiveFont <> nil then begin
- Result := Context.Renderer.TextGetWidth(pText);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_TEXT_GET_WIDTH);
- end else
-
- // Width from blockmode
- begin
- if Context.IsLocked then begin
- Result := Context.Renderer.TextGetDrawWidth;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_TEXT_GET_WIDTH);
- end;
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_GET_WIDTH);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_GET_WIDTH);
-end;
-
-
-function tsTextGetHeightA(pText: pAnsiChar): tsInt;
-var
- pTemp: PWideChar;
- Context: TtsContext;
-begin
- Result := 0;
- Context := gContext;
-
- if Context <> nil then begin
- pTemp := nil;
-
- // if pText is assigned convert it
- if pText <> nil then begin
- pTemp := Context.AnsiToWide(pText);
-
- if pTemp = nil then begin
- SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_GET_WIDTH);
- Exit;
- end;
- end;
-
- try
- Result := tsTextGetHeightW(pTemp);
- finally
- if pTemp <> nil then
- tsStrDispose(pTemp);
- end;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_GET_WIDTH);
-end;
-
-
-function tsTextGetHeightW(pText: pWideChar): tsInt;
-var
- Context: TtsContext;
-begin
- Result := 0;
-
- Context := gContext;
-
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- // Height from the text
- if pText <> nil then begin
- if Context.ActiveFont <> nil then begin
- with Context.ActiveFont do
- Result := Ascent + Descent + ExternalLeading;
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_TEXT_GET_HEIGHT);
- end else
-
- // Height from blockmode
- begin
- if Context.IsLocked then begin
- Result := Context.Renderer.TextGetDrawHeight;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_TEXT_GET_HEIGHT);
- end;
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_GET_HEIGHT);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_GET_HEIGHT);
-end;
-
-
-procedure tsCharOutW(CharCode: WideChar); cdecl;
-var
- Context: TtsContext;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if Context.Renderer <> nil then begin
- if not Context.IsLocked then begin
- if Context.Renderer.ActiveFont <> nil then begin
- if Context.Renderer.ActiveFont.Char[CharCode] <> nil then begin
- Context.Renderer.CharOut(CharCode);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_TEXT_OUT);
- end else
- SetError(TS_NO_ACTIVE_FONT, TS_FUNC_TEXT_OUT);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_TEXT_OUT);
- end else
- SetError(TS_NO_ACTIVE_RENDERER, TS_FUNC_TEXT_OUT);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_TEXT_OUT);
-end;
-
-
-// *** image functions ***
-procedure tsImageCreate(pImageID: ptsImageID);
-var
- Context: TtsContext;
- Image: TtsImage;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- if pImageID <> nil then begin
- // create image
- try
- Image := TtsImage.Create;
- except
- on E: Exception do begin
- if E is EOutOfMemory then
- SetError(TS_OUT_OF_MEMORY, TS_FUNC_IMAGE_CREATE)
- else
- SetError(TS_ERROR, TS_FUNC_IMAGE_CREATE);
- Exit;
- end;
- end;
-
- // add image
- pImageID^ := Context.ImageAdd(Image);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_CREATE);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_CREATE);
-end;
-
-
-procedure tsImageDestroy(ImageID: tsImageID);
-var
- Context: TtsContext;
- Image: TtsImage;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- Image := Context.ImageGet(ImageID);
-
- if Image <> nil then begin
- Context.ImageDelete(ImageID);
-
- Image.Free;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_DESTROY);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_DESTROY);
-end;
-
-
-procedure tsImageLoadA(ImageID: tsImageID; Filename: pAnsiChar);
-var
- Context: TtsContext;
- Image: TtsImage;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- case gContext.gImageLibrary of
- // SDL_image
- TS_IMAGE_LIBRARY_SDL:
- begin
- if SDL_IMAGE_initialized then begin
- Image := Context.ImageGet(ImageID);
-
- if Image <> nil then begin
- try
- Image.LoadFromFile(Filename);
- except
- on E: Exception do begin
- if E is EOutOfMemory then
- SetError(TS_OUT_OF_MEMORY, TS_FUNC_IMAGE_LOAD)
- else
- SetError(TS_ERROR, TS_FUNC_IMAGE_LOAD);
- end;
- end;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_LOAD);
- end else
- SetError(TS_NOT_INITIALIZED, TS_FUNC_IMAGE_LOAD);
- end;
- else
- SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_LOAD);
- end;
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_LOAD);
-end;
-
-
-procedure tsImageAssignFrom(ImageID: tsImageID; FromImageID: tsImageID);
-var
- Context: TtsContext;
- Image, ImageFrom: TtsImage;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- Image := Context.ImageGet(ImageID);
- ImageFrom := Context.ImageGet(FromImageID);
-
- if (Image <> nil) and (ImageFrom <> nil) then begin
- if not ImageFrom.Empty then begin
- try
- Image.AssignFrom(ImageFrom)
- except
- on E: Exception do begin
- if E is EOutOfMemory then
- SetError(TS_OUT_OF_MEMORY, TS_FUNC_IMAGE_ASSIGN_FROM)
- else
- SetError(TS_ERROR, TS_FUNC_IMAGE_ASSIGN_FROM);
- Exit;
- end;
- end;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_ASSIGN_FROM);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_ASSIGN_FROM);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_ASSIGN_FROM);
-end;
-
-
-procedure tsImageNew(ImageID: tsImageID; Width: tsInt; Height: tsInt; Format: tsEnum);
-var
- Context: TtsContext;
- Image: TtsImage;
- ImageFormat: TtsFormat;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- Image := Context.ImageGet(ImageID);
-
- if Image <> nil then begin
- // format
- if Format = TS_DEFAULT then
- Format := Context.gGlobalFormat;
-
- case Format of
- TS_FORMAT_RGBA8:
- ImageFormat := tsFormatRGBA8;
- else
- SetError(TS_INVALID_ENUM, TS_FUNC_IMAGE_NEW);
-
- // leave the function
- Exit;
- end;
-
- if (Width > 0) and (Height > 0) then begin
- try
- Image.CreateEmpty(ImageFormat, Width, Height);
- except
- on E: Exception do begin
- if E is EOutOfMemory then
- SetError(TS_OUT_OF_MEMORY, TS_FUNC_IMAGE_NEW)
- else
- SetError(TS_ERROR, TS_FUNC_IMAGE_NEW);
- end;
- end;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_NEW);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_NEW);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_NEW);
-end;
-
-
-procedure tsImageGetInfo(ImageID: tsImageID; pisEmpty: ptsBool; pWidth: ptsInt; pHeight: ptsInt; pFormat: ptsEnum; pData: PPointer);
-var
- Context: TtsContext;
- Image: TtsImage;
-begin
- Context := gContext;
-
- // defaults
- if pisEmpty <> nil then
- pisEmpty^ := TS_FALSE;
-
- if pWidth <> nil then
- pWidth^ := 0;
-
- if pHeight <> nil then
- pHeight^ := 0;
-
- if pFormat <> nil then
- pFormat^ := TS_FORMAT_EMPTY;
-
- if pData <> nil then
- pData^ := nil;
-
- // query values
- if Context <> nil then begin
- Image := Context.ImageGet(ImageID);
-
- if Image <> nil then begin
- // isEmpty
- if pisEmpty <> nil then
- if Image.Empty then
- pisEmpty^ := TS_TRUE
- else
- pisEmpty^ := TS_FALSE;
-
- // Width
- if pWidth <> nil then
- pWidth^ := Image.Width;
-
- // Height
- if pHeight <> nil then
- pHeight^ := Image.Height;
-
- // Format
- if pFormat <> nil then begin
- case Image.Format of
- tsFormatEmpty:
- pFormat^ := TS_FORMAT_EMPTY;
- tsFormatRGBA8:
- pFormat^ := TS_FORMAT_RGBA8;
- end;
- end;
-
- // Data
- if pData <> nil then
- pData^ := Image.Data;
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_GET_INFO);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_GET_INFO);
-end;
-
-
-function tsImageGetIsEmpty(ImageID: tsImageID): tsBool;
-begin
- tsImageGetInfo(ImageID, @Result, nil, nil, nil, nil);
-end;
-
-
-function tsImageGetWidth(ImageID: tsImageID): tsInt;
-begin
- tsImageGetInfo(ImageID, nil, @Result, nil, nil, nil);
-end;
-
-
-function tsImageGetHeight(ImageID: tsImageID): tsInt;
-begin
- tsImageGetInfo(ImageID, nil, nil, @Result, nil, nil);
-end;
-
-
-function tsImageGetFormat(ImageID: tsImageID): tsEnum;
-begin
- tsImageGetInfo(ImageID, nil, nil, nil, @Result, nil);
-end;
-
-
-function tsImageGetData(ImageID: tsImageID): Pointer;
-begin
- tsImageGetInfo(ImageID, nil, nil, nil, nil, @Result);
-end;
-
-
-function tsImageScanline(ImageID: tsImageID; ScanLine: tsInt): Pointer;
-var
- Context: TtsContext;
- Image: TtsImage;
-begin
- Result := nil;
-
- Context := gContext;
-
- if Context <> nil then begin
- Image := Context.ImageGet(ImageID);
-
- if Image <> nil then begin
- if not Image.Empty then begin
- Result := Image.ScanLine[ScanLine];
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_SCANLINE);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_SCANLINE);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_SCANLINE);
-end;
-
-
-procedure tsImageResize(ImageID: tsImageID; Width, Height, X, Y: tsInt);
-var
- Context: TtsContext;
- Image: TtsImage;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- Image := Context.ImageGet(ImageID);
-
- if Image <> nil then begin
- if not Image.Empty then begin
- Image.Resize(Width, Height, X, Y);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_RESIZE);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_RESIZE);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_RESIZE);
-end;
-
-
-procedure tsImageBlend(ImageID, OverImageID: tsImageID; X, Y: tsInt; AutoExpand: tsBool);
-var
- Context: TtsContext;
- Image, ImageOver: TtsImage;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- Image := Context.ImageGet(ImageID);
- ImageOver := Context.ImageGet(OverImageID);
-
- if (Image <> nil) and (ImageOver <> nil) then begin
- if (not Image.Empty) and (not ImageOver.Empty) then begin
- Image.BlendImage(ImageOver, X, Y, AutoExpand = TS_TRUE);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_BLEND);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_BLEND);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_BLEND);
-end;
-
-
-procedure tsImageBlur(ImageID: tsImageID; X, Y: tsFloat; ChannelMask: tsBitmask; AutoExpand: tsBool; ExpandSizeX, ExpandSizeY: ptsInt);
-var
- Context: TtsContext;
- Image: TtsImage;
-
- HorzKernel, VertKernel: TtsKernel1D;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- Image := Context.ImageGet(ImageID);
-
- if Image <> nil then begin
- if not Image.Empty then begin
- // Creating kernels
- HorzKernel := TtsKernel1D.Create(X, 0);
- VertKernel := TtsKernel1D.Create(Y, 0);
-
- if AutoExpand = TS_TRUE then begin
- // resizing image
- Image.Resize(Image.Width + HorzKernel.Size * 2, Image.Height + VertKernel.Size * 2, HorzKernel.Size, VertKernel.Size);
-
- if ExpandSizeX <> nil then
- ExpandSizeX^ := HorzKernel.Size;
-
- if ExpandSizeY <> nil then
- ExpandSizeY^ := VertKernel.Size
- end else
-
- begin
- if ExpandSizeX <> nil then
- ExpandSizeX^ := 0;
-
- if ExpandSizeY <> nil then
- ExpandSizeY^ := 0;
- end;
-
- // bluring image
- Image.Blur(HorzKernel, VertKernel, ChannelMask);
-
- // freeing
- HorzKernel.Free;
- VertKernel.Free;
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_BLUR);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_BLUR);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_BLUR);
-end;
-
-
-procedure tsImageFillColor3ub(ImageID: tsImageID; Red, Green, Blue: tsByte; ChannelMask: tsBitmask);
-begin
- tsImageFillColor4f(ImageID, Red / $FF, Green / $FF, Blue / $FF, 1, ChannelMask);
-end;
-
-
-procedure tsImageFillColor3f(ImageID: tsImageID; Red, Green, Blue: tsFloat; ChannelMask: tsBitmask);
-begin
- tsImageFillColor4f(ImageID, Red, Green, Blue, 1, ChannelMask);
-end;
-
-
-procedure tsImageFillColor4ub(ImageID: tsImageID; Red, Green, Blue, Alpha: tsByte; ChannelMask: tsBitmask);
-begin
- tsImageFillColor4f(ImageID, Red / $FF, Green / $FF, Blue / $FF, Alpha / $FF, ChannelMask);
-end;
-
-
-procedure tsImageFillColor4f(ImageID: tsImageID; Red, Green, Blue, Alpha: tsFloat; ChannelMask: tsBitmask);
-var
- Context: TtsContext;
- Image: TtsImage;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- Image := Context.ImageGet(ImageID);
-
- if Image <> nil then begin
- if not Image.Empty then begin
- Image.FillColor(Red, Green, Blue, Alpha, ChannelMask, Context.gImageMode);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_FILL_COLOR);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_FILL_COLOR);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_FILL_COLOR);
-end;
-
-
-procedure tsImageFillPattern(ImageID, PatternImageID: tsImageID; X, Y: tsInt; ChannelMask: tsBitmask);
-var
- Context: TtsContext;
- Image, ImagePattern: TtsImage;
-begin
- Context := gContext;
-
- if Context <> nil then begin
- Image := Context.ImageGet(ImageID);
- ImagePattern := Context.ImageGet(PatternImageID);
-
- if (Image <> nil) and (ImagePattern <> nil) then begin
- if (not Image.Empty) and (not ImagePattern.Empty) then begin
- Image.FillPattern(ImagePattern, X, Y, ChannelMask, Context.gImageMode);
- end else
- SetError(TS_INVALID_OPERATION, TS_FUNC_IMAGE_FILL_PATTERN);
- end else
- SetError(TS_INVALID_VALUE, TS_FUNC_IMAGE_FILL_PATTERN);
- end else
- SetError(TS_NO_ACTIVE_CONTEXT, TS_FUNC_IMAGE_FILL_PATTERN);
-end;
-
-
-{$endif}
-
-
-end.
diff --git a/old/TextSuiteCPUUtils.pas b/old/TextSuiteCPUUtils.pas
deleted file mode 100644
index ef0157b..0000000
--- a/old/TextSuiteCPUUtils.pas
+++ /dev/null
@@ -1,143 +0,0 @@
-{
-TextSuite (C) Steffen Xonna (aka Lossy eX)
-http://www.opengl24.de/
------------------------------------------------------------------------
-For copyright informations see file copyright.txt.
-}
-
-{$I TextSuiteOptions.inc}
-
-unit TextSuiteCPUUtils;
-
-{$ifdef TS_PURE_PASCAL}
- {$message fatal 'This unit is''t compatible to the flag TS_PURE_PASCAL.'}
-{$endif}
-
-interface
-
-
-var
- supportFPU,
- supportCMOV,
- supportMMX,
- supportMMX_EXT,
- supportSSE,
- supportSSE2,
- support3DNow,
- support3DNow_EXT,
- supportSSE3,
- supportSSSE3
- : ByteBool;
-
-
-procedure ReadCPUFlags;
-
-function GetSSESafeMem(Size: Cardinal): Pointer;
-function GetSSESafeAddr(Addr: Pointer): Pointer;
-
-
-implementation
-
-
-const
- BIT_FPU = 1 shl 0;
- BIT_CMOV = 1 shl 15;
- BIT_MMX = 1 shl 23;
- BIT_SSE = 1 shl 25;
- BIT_SSE2 = 1 shl 26;
- BIT_3DNOW_EXT = 1 shl 30;
- BIT_3DNOW = 1 shl 31;
-
- BIT_SSE3 = 1 shl 0;
- BIT_SSSE3 = 1 shl 9;
-
-
-procedure ReadCPUFlags;
-asm
- pushfd
- pop eax // copy EEFlags to eax
- mov edx, eax // copy to edx
-
- xor eax, $00200000 // clear bit 21
- push eax
- popfd // restore to EEFlags
-
- pushfd
- pop eax // copy EEFlags to eax
- xor eax, edx // test if flags hav changed
- jnz @@supportCPUID
-
- ret
-
-@@supportCPUID:
-
- push ebx // save ebx
-
- mov eax, 1 // function 1
- cpuid
-
- // test flags
- test edx, BIT_FPU
- setnz [supportFPU] // FPU supported
-
- test edx, BIT_CMOV
- setnz [supportCMOV] // CMOV supported
-
- test edx, BIT_MMX
- setnz [supportMMX] // MMX supported
-
- test edx, BIT_SSE
- setnz [supportSSE] // SSE supported
-
- test edx, BIT_SSE2
- setnz [supportSSE2] // SSE2 supported
-
- test ecx, BIT_SSE3
- setnz [supportSSE3] // SSE3 supported
-
- test ecx, BIT_SSSE3
- setnz [supportSSSE3] // SSSE3 supported
-
- // test extended functions
- mov eax, $80000000
- cpuid
- cmp eax, $80000000
- jbe @@no_ext_functions
-
- mov eax, $80000001
- cpuid
-
- test edx, BIT_3DNOW
- setnz [support3DNow] // 3DNow supported
-
- test edx, BIT_3DNOW_EXT
- setnz [support3DNow_EXT] // 3DNowExt supported
-
-
-@@no_ext_functions:
-
- pop ebx // restore ebx
-
-@@end:
-end;
-
-
-function GetSSESafeMem(Size: Cardinal): Pointer;
-begin
- GetMem(Result, Size + $F);
-end;
-
-
-function GetSSESafeAddr(Addr: Pointer): Pointer;
-asm
- test eax, $F // test if one of the last bits are set
- jz @@end // address is allways 16 Byte aligned
-
- or eax, $F // fill the last 4 bits
- inc eax // add 1
-
-@@end:
-end;
-
-
-end.
\ No newline at end of file
diff --git a/old/TextSuiteClasses.pas b/old/TextSuiteClasses.pas
deleted file mode 100644
index fb5e3ae..0000000
--- a/old/TextSuiteClasses.pas
+++ /dev/null
@@ -1,5762 +0,0 @@
-{
-TextSuite (C) Steffen Xonna (aka Lossy eX)
-http://www.opengl24.de/
------------------------------------------------------------------------
-For copyright informations see file copyright.txt.
-}
-
-{$WARNINGS OFF}
-{$HINTS OFF}
-
-{$I TextSuiteOptions.inc}
-
-unit TextSuiteClasses;
-
-interface
-
-
-uses
- Classes,
-
- TextSuite,
- TextSuiteWideUtils,
- TextSuiteImports;
-
-
-{ intern types for Renderer }
-const
- TS_BLOCK_FONT = $1;
- TS_BLOCK_COLOR = $2;
- TS_BLOCK_WORD = $3;
- TS_BLOCK_SPACE = $4;
- TS_BLOCK_LINEBREAK = $5;
- TS_BLOCK_TAB = $6;
-
-
-type
- TtsFontStyle = (tsStyleBold, tsStyleItalic, tsStyleUnderline, tsStyleStrikeout);
- TtsFontStyles = set of TtsFontStyle;
-
- TtsAntiAliasing = (tsAANone, tsAANormal);
- TtsFormat = (tsFormatEmpty, tsFormatRGBA8);
-
- TtsImageMode = (tsModeRed, tsModeGreen, tsModeBlue, tsModeAlpha, tsModeLuminance);
- TtsImageModes = array [TtsImageMode] of tsEnum;
-
-
- tsQuad = array[0..3] of tsPoint;
-
- tsPointFloat = packed record
- X: Single;
- Y: Single;
- end;
- tsQuadFloat = array[0..3] of tsPointFloat;
-
-
-const
- cModesReplace : TtsImageModes = (TS_MODE_REPLACE, TS_MODE_REPLACE, TS_MODE_REPLACE, TS_MODE_REPLACE, TS_MODE_REPLACE);
- cModesNormal : TtsImageModes = (TS_MODE_REPLACE, TS_MODE_REPLACE, TS_MODE_REPLACE, TS_MODE_MODULATE, TS_MODE_REPLACE);
-
-type
- PtsHashEntry = ^TtsHashEntry;
- TtsHashEntry = record
- Name: Integer;
- Value: Pointer;
- Next: PtsHashEntry;
- end;
-
- TtsHash = class(TObject)
- private
- fHashArray: array of PtsHashEntry;
- fHashEntrys: Integer;
- fCount: Integer;
-
- function IntToPos(Name: Integer): Integer;
- public
- property Count: Integer read fCount;
-
- constructor Create(HashEntrys: Integer);
- destructor Destroy; override;
-
- procedure Add(Name: Integer; Value: Pointer);
- procedure Delete(Name: Integer);
- procedure Clear;
-
- function Get(Name: Integer): Pointer;
- procedure GetNames(const NameList: TList);
- procedure GetValues(const ValueList: TList);
- end;
-
-
- PtsStringHashEntry = ^TtsStringHashEntry;
- TtsStringHashEntry = record
- pString: pWideChar;
- Next: PtsStringHashEntry;
- end;
-
- TtsStringHash = class(TObject)
- private
- fHashArray: array of PtsStringHashEntry;
- fHashEntrys: Cardinal;
- public
- constructor Create(HashEntrys: Integer);
- destructor Destroy; override;
-
- procedure Add(pString: pWideChar);
- function Delete(pString: pWideChar): Boolean;
- end;
-
-
- TtsKernel1DItem = packed record
- Offset: Integer;
- Value: Single;
-
- DataOffset: Integer;
- end;
-
- TtsKernel1D = class
- public
- Size: Integer;
- ValueSum: Double;
-
- Items: array of TtsKernel1DItem;
- ItemCount: Integer;
-
- constructor Create(Radius, Strength: Single);
-
- procedure UpdateDataOffset(DataSize: Integer);
- end;
-
-
- TtsKernel2DItem = packed record
- OffsetX: Integer;
- OffsetY: Integer;
- Value: Single;
-
- DataOffset: Integer;
- end;
-
- TtsKernel2D = class
- public
- SizeX: Integer;
- SizeY: Integer;
-
- MidSizeX: Integer;
- MidSizeY: Integer;
-
- ValueSum: Double;
-
- Items: array of TtsKernel2DItem;
- ItemCount: Integer;
-
- constructor Create(Radius, Strength: Single);
-
- procedure UpdateDataOffset(DataSizeX, DataSizeY: Integer);
- end;
-
-
- TtsImage = class;
- TtsRenderer = class;
- TtsRendererImageReference = class;
- TtsContext = class;
- TtsChar = class;
-
-
- TtsImageFunc = procedure(Image: TtsImage; X, Y: Integer; var Pixel: tsColor; Data: Pointer);
-
- TtsImage = class
- private
- fWidth: Integer;
- fHeight: Integer;
- fFormat: TtsFormat;
-
- fData: Pointer;
- fScanLinesValid: Boolean;
- fScanLines: array of Pointer;
-
- procedure SetDataPtr(aData: Pointer; aFormat: TtsFormat = tsFormatEmpty; aWidth: Integer = 0; aHeight: Integer = 0);
-
- function GetFormatSize(Format: TtsFormat): Integer;
-
- procedure UpdateScanLines;
- function GetScanLine(Index: Integer): pointer;
- function GetEmpty: Boolean;
- public
- procedure BeforeDestruction; override;
-
- procedure AssignFrom(Image: TtsImage);
- procedure CreateEmpty(Format: TtsFormat; aWidth, aHeight: Integer);
- procedure LoadFromFile(FileName: PAnsiChar);
-
- procedure Resize(NewWidth, NewHeight, X, Y: Integer);
- procedure FindMinMax(var MinMaxInfo: tsRect);
-
- procedure AddFunc(Func: TtsImageFunc; Data: Pointer);
-
- procedure FillColor(Red, Green, Blue, Alpha: Single; ChannelMask: tsBitmask; Modes: TtsImageModes);
- procedure FillPattern(Pattern: TtsImage; X, Y: Integer; ChannelMask: tsBitmask; Modes: TtsImageModes);
-
- procedure BlendImage(Image: TtsImage; X, Y: Integer; AutoExpand: Boolean = True);
- procedure Blur(HorzKernel, VertKernel: TtsKernel1D; ChannelMask: tsBitmask);
-
- procedure AddResizingBorder(tsChar: TtsChar);
-
- property Empty: Boolean read GetEmpty;
-
- property Data: Pointer read fData;
- property Width: Integer read fWidth;
- property Height: Integer read fHeight;
- property Format: TtsFormat read fFormat;
-
- property ScanLine[Index: Integer]: pointer read GetScanline;
- end;
-
-
- TtsChar = class
- protected
- // CharCode
- fCharCode: WideChar;
- public
- // Position of char
- GlyphOriginX: Smallint;
- GlyphOriginY: Smallint;
- Advance: SmallInt;
- GlyphRect: tsRect;
-
- HasResizingBorder: Boolean;
-
- // Kerning
-// KerningValuesLeft: array of WORD;
-// KerningValuesRight: array of WORD;
-
- // Renderer data for Imagehandling
- RendererImageReference: TtsRendererImageReference;
-
- constructor Create(CharCode: WideChar);
- destructor Destroy; override;
-
- procedure ExpandRect(Left, Top, Right, Bottom: Integer);
-
- // Kerning
-// procedure CalculateKerningData(CharImage: TtsImage);
-// function CalculateKerningValue(LastChar: TtsChar): Smallint;
-
- // CharCode
- property CharCode: WideChar read fCharCode;
- end;
-
-
- PtsFontCharArray = ^TtsFontCharArray;
- TtsFontCharArray = packed record
- Chars: array [Byte] of TtsChar;
- CharCount: Byte;
- end;
-
-
- TtsTextMetric = record
- Ascent: Integer;
- Descent: Integer;
- LineSkip: Integer;
- LineSkip_with_LineSpace: Integer;
- end;
-
-
- TtsFont = class
- private
- // Strings
- fCopyright: AnsiString;
- fFaceName: AnsiString;
- fStyleName: AnsiString;
- fFullName: AnsiString;
-
- // font styles
- fSize: Integer;
- fStyle: TtsFontStyles;
- fFormat: TtsFormat;
- fAntiAliasing: TtsAntiAliasing;
-
- // font settings
- fAscent: Integer;
- fDescent: Integer;
- fExternalLeading: Integer;
- fBaselineOffset: Integer;
-
- fDefaultChar: WideChar;
-
- fFontFileStyle: Integer;
- fFixedWidth: Boolean;
-
- fCharSpacing: Integer;
- fLineSpacing: Integer;
-
- fUnderlinePosition: Integer;
- fUnderlineSize: Integer;
- fStrikeoutPosition: Integer;
- fStrikeoutSize: Integer;
-
- // chars
- fChars: array [Byte] of PtsFontCharArray;
- protected
- fRenderer: TtsRenderer;
-
- function Validate(CharCode: WideChar): Boolean; virtual;
-
- procedure AddChar(CharCode: WideChar; Char: TtsChar);
- function GetChar(CharCode: WideChar): TtsChar;
- public
- // chars
- property Char[CharCode: WideChar]: TtsChar read GetChar;
-
- // strings
- property Copyright: AnsiString read fCopyright write fCopyright;
- property FaceName: AnsiString read fFaceName write fFaceName;
- property StyleName: AnsiString read fStyleName write fStyleName;
- property FullName: AnsiString read fFullName write fFullName;
-
- property Size: Integer read fSize write fSize;
- property Style: TtsFontStyles read fStyle write fStyle;
- property Format: TtsFormat read fFormat write fFormat;
- property AntiAliasing: TtsAntiAliasing read fAntiAliasing write fAntiAliasing;
-
- // Font propertys
- property Ascent: Integer read fAscent write fAscent;
- property Descent: Integer read fDescent write fDescent;
- property ExternalLeading: Integer read fExternalLeading write fExternalLeading;
- property BaselineOffset: Integer read fBaselineOffset write fBaselineOffset;
-
- property DefaultChar: WideChar read fDefaultChar write fDefaultChar;
-
- property FontFileStyle: Integer read fFontFileStyle write fFontFileStyle;
- property FixedWidth: Boolean read fFixedWidth write fFixedWidth;
-
- property CharSpacing: Integer read fCharSpacing write fCharSpacing;
- property LineSpacing: Integer read fLineSpacing write fLineSpacing;
-
- property UnderlinePosition: Integer read fUnderlinePosition write fUnderlinePosition;
- property UnderlineSize: Integer read fUnderlineSize write fUnderlineSize;
- property StrikeoutPosition: Integer read fStrikeoutPosition write fStrikeoutPosition;
- property StrikeoutSize: Integer read fStrikeoutSize write fStrikeoutSize;
-
- constructor Create(Renderer: TtsRenderer; Size: Integer; Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
- destructor Destroy; override;
-
- procedure ClearChars;
-
- procedure DeleteChar(CharCode: WideChar);
-
- procedure GetTextMetric(var Metric: TtsTextMetric);
- end;
-
-
- PtsPostProcessStepRange = ^TtsPostProcessStepRange;
- TtsPostProcessStepRange = record
- StartChar: WideChar;
- EndChar: WideChar;
- end;
-
- TtsFontProcessStepUsage = (tsUInclude, tsUExclude);
-
- TtsPostProcessStep = class
- protected
- fIncludeCharRange: TList;
- fExcludeCharRange: TList;
-
- procedure ClearList(List: TList);
-
- procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); virtual; abstract;
- public
- constructor Create;
- destructor Destroy; override;
-
- function IsInRange(CharCode: WideChar): Boolean;
- procedure AddUsageRange(Usage: TtsFontProcessStepUsage; StartChar, EndChar: WideChar);
- procedure AddUsageChars(Usage: TtsFontProcessStepUsage; Chars: pWideChar);
-
- procedure ClearIncludeRange;
- procedure ClearExcludeRange;
- end;
-
-
- TtsFontCreator = class(TtsFont)
- private
- fPostProcessSteps: TList;
-
- function GetPostProcessStepCount: Integer;
- function GetPostProcessStep(Index: Integer): TtsPostProcessStep;
- protected
- fCreateChars: Boolean;
- fAddResizingBorder: Boolean;
-
- function Validate(CharCode: WideChar): Boolean; override;
-
- function GetGlyphMetrics(CharCode: WideChar; var GlyphOriginX, GlyphOriginY, GlyphWidth, GlyphHeight, Advance: Integer): Boolean; virtual; abstract;
-
- procedure GetCharImage(CharCode: WideChar; const CharImage: TtsImage); virtual; abstract;
-
- procedure DrawLine(Char: TtsChar; CharImage: TtsImage; LinePosition, LineSize: Integer);
- procedure DoPostProcess(var CharImage: TtsImage; const tsChar: TtsChar);
- public
- property CreateChars: Boolean read fCreateChars write fCreateChars;
- property AddResizingBorder: Boolean read fAddResizingBorder write fAddResizingBorder;
-
- constructor Create(Renderer: TtsRenderer; Size: Integer; Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
- destructor Destroy; override;
-
- procedure AddChar(CharCode: WideChar); overload;
-
- function AddPostProcessStep(PostProcessStep: TtsPostProcessStep): TtsPostProcessStep;
- procedure DeletePostProcessStep(Index: Integer);
- procedure ClearPostProcessSteps;
-
- property PostProcessStepCount: Integer read GetPostProcessStepCount;
- property PostProcessStep[Index: Integer]: TtsPostProcessStep read GetPostProcessStep;
- end;
-
-
- TtsFontCreatorSDL = class(TtsFontCreator)
- protected
- fSDLFont: PTTF_Font;
-
- function GetGlyphMetrics(CharCode: WideChar; var GlyphOriginX, GlyphOriginY, GlyphWidth, GlyphHeight, Advance: Integer): Boolean; override;
-
- procedure GetCharImage(CharCode: WideChar; const CharImage: TtsImage); override;
- public
- constructor Create(Renderer: TtsRenderer; const Filename: AnsiString; Size: Integer; Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
- destructor Destroy; override;
- end;
-
-
- TtsFontCreatorGDIFontFace = class(TtsFontCreator)
- protected
- fFontHandle: THandle;
- fMat2: TMat2;
-
- fFontname: AnsiString;
-
- function GetGlyphIndex(CharCode: WideChar): Integer;
-
- function GetGlyphMetrics(CharCode: WideChar; var GlyphOriginX, GlyphOriginY, GlyphWidth, GlyphHeight, Advance: Integer): Boolean; override;
-
- procedure GetCharImageAntialiased(DC: HDC; CharCode: WideChar; const CharImage: TtsImage);
- procedure GetCharImageNone(DC: HDC; CharCode: WideChar; const CharImage: TtsImage);
-
- procedure GetCharImage(CharCode: WideChar; const CharImage: TtsImage); override;
- public
- constructor Create(Renderer: TtsRenderer; const Fontname: AnsiString; Size: Integer; Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
- destructor Destroy; override;
- end;
-
-
- TtsFontCreatorGDIFile = class(TtsFontCreatorGDIFontFace)
- protected
- fFilename: pAnsiChar;
- fFontRegistred: Boolean;
-
- function RegisterFont(Filename: pAnsiChar; RegisterPublic: Boolean): boolean;
- function UnRegisterFont(Filename: pAnsiChar; RegisterPublic: Boolean): boolean;
-
- function GetFaceName(Filename: pAnsiChar; var Face: AnsiString): boolean;
- public
- constructor Create(Renderer: TtsRenderer; const Filename: AnsiString; Size: Integer; Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
- destructor Destroy; override;
- end;
-
- TtsFontCreatorGDIStream = class(TtsFontCreatorGDIFontFace)
- protected
- fFontRegistred: Boolean;
- fHandle: THandle;
-
- function RegisterFont(Data: TStream): boolean;
- function UnRegisterFont(): boolean;
-
- function GetFaceName(Stream: TStream; var Face: AnsiString): boolean;
- public
- constructor Create(Renderer: TtsRenderer; const Source: TStream; Size: Integer; Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
- destructor Destroy; override;
- end;
-
- PtsLineItem = ^TtsLineItem;
- TtsLineItem = record
- NextItem: PtsLineItem;
- PrevItem: PtsLineItem;
-
- ItemType: Integer;
- case Integer of
- TS_BLOCK_FONT: (
- Font: TtsFont;
- FontID: tsFontID;
- );
-
- TS_BLOCK_COLOR: (
- Red: Single;
- Green: Single;
- Blue: Single;
- Alpha: Single;
- );
-
- TS_BLOCK_WORD, TS_BLOCK_SPACE: (
- Word: PWideChar;
- WordLength: Integer;
- );
- end;
-
- PtsLinesItem = ^TtsLinesItem;
- TtsLinesItem = record
- NextLine: PtsLinesItem;
-
- LineItemFirst: PtsLineItem;
- LineItemLast: PtsLineItem;
-
- LineLength: Integer;
- LineAutoBreak: Boolean;
- end;
-
- TtsTempLines = record
- Lines: PtsLinesItem;
- Empty: Boolean;
- end;
-
-
- { *** *** }
- TtsRendererImageReference = class
- end;
-
-
- TtsRenderer = class
- private
- fContext: TtsContext;
-
- fSaveImages: Boolean;
-
- fisBlock: Boolean;
- fBlockLeft: Integer;
- fBlockTop: Integer;
- fBlockWidth: Integer;
- fBlockHeight: Integer;
- fFlags: Integer;
-
- fWordWrap: Boolean;
-// fSingleLine: Boolean;
-
- fActiveFont: TtsFont;
- fActiveFontID: Cardinal;
- fLastActiveFont: TtsFont;
- fLastActiveFontID: Cardinal;
-
- fLinesFirst: PtsLinesItem;
- fLinesLast: PtsLinesItem;
- fLinesTemp: TtsTempLines;
-
- // drawings
- fLineTop: Integer;
- fTextOffsetY: Integer;
- fTextOffsetX: Integer;
-
- function GetActiveFont: TtsFont;
- function GetActiveFontID: Cardinal;
-
- function SplitText(pText: PWideChar): PtsLineItem;
- procedure CalculateWordLength(Font: TtsFont; pWord: PtsLineItem);
- procedure SplitIntoLines(pItemList: PtsLineItem);
-
- procedure DrawLine(pLine: PtsLineItem; LineLength: Integer; LineBreak: Boolean);
- procedure DrawLines(pLinesItem: PtsLinesItem);
- function CalculateLinesHeight(pLinesItem: PtsLinesItem): Integer;
-
- procedure GetLineMetric(pLine: PtsLineItem; var Metric: TtsTextMetric);
-
- procedure PushLineItem(pLine: PtsLineItem);
- procedure FreeLineItems(var pLine: PtsLineItem);
-
- procedure PushTempLines;
- procedure FreeLines(var pLinesItem: PtsLinesItem);
- procedure TrimSpaces(pLinesItem: PtsLinesItem);
- protected
- procedure DrawChar(Font: TtsFont; Char: TtsChar); virtual; abstract;
- procedure DrawSetPosition(X, Y: Integer); virtual; abstract;
- procedure DrawSetPositionRelative(X, Y: Integer); virtual; abstract;
- procedure DrawSetColor(Red, Green, Blue, Alpha: Single); virtual; abstract;
-
- function AddImage(Char: TtsChar; CharImage: TtsImage): TtsRendererImageReference; virtual; abstract;
- procedure RemoveImageReference(ImageReference: TtsRendererImageReference); virtual; abstract;
- public
- property ActiveFont: TtsFont read GetActiveFont;
- property ActiveFontID: Cardinal read GetActiveFontID;
-
- property SaveImages: Boolean read fSaveImages write fSaveImages;
-
- property isBlock: Boolean read FisBlock;
-
- constructor Create(Context: TtsContext);
- destructor Destroy; override;
-
- procedure BeginBlock(Left, Top, Width, Height: Integer; Flags: tsBitmask); virtual;
- procedure EndBlock;
-
- procedure FontActivate(FontID: Cardinal);
- procedure Color(Red, Green, Blue, Alpha: Single);
- procedure TextOut(pText: pWideChar);
-
- function TextGetWidth(pText: pWideChar): Integer;
- function TextGetDrawWidth: Integer;
- function TextGetDrawHeight: Integer;
-
- procedure CharOut(CharCode: WideChar);
- end;
-
-
- TtsRendererNULLImageReference = class(TtsRendererImageReference)
- Image: TtsImage;
- end;
-
-
- TtsRendererNULL = class(TtsRenderer)
- protected
- procedure DrawChar(Font: TtsFont; Char: TtsChar); override;
- procedure DrawSetPosition(X, Y: Integer); override;
- procedure DrawSetPositionRelative(X, Y: Integer); override;
- procedure DrawSetColor(Red, Green, Blue, Alpha: Single); override;
-
- function AddImage(Char: TtsChar; CharImage: TtsImage): TtsRendererImageReference; override;
- procedure RemoveImageReference(ImageReference: TtsRendererImageReference); override;
- end;
-
-
-
- TtsRendererOpenGLImageReference = class(TtsRendererImageReference)
- TexID: Integer;
- Coordinates: tsRect;
-
- TexCoords: tsQuadFloat;
- Vertex: tsQuadFloat;
- end;
-
-
- PtsRendererOpenGLTexture = ^TtsRendererOpenGLTexture;
- TtsRendererOpenGLTexture = record
- glTextureID: Cardinal;
-
- Width: Integer;
- Height: Integer;
- end;
-
-
- PtsRendererOpenGLManagedEntry = ^TtsRendererOpenGLManagedEntry;
- TtsRendererOpenGLManagedEntry = record
- Start: Word;
- Count: Word;
-
- NextEntry: PtsRendererOpenGLManagedEntry;
- end;
-
-
- PtsRendererOpenGLTextureEntry = ^TtsRendererOpenGLTextureEntry;
- TtsRendererOpenGLTextureEntry = record
- ID: Integer;
- Texture: PtsRendererOpenGLTexture;
-
- Lines: array of PtsRendererOpenGLManagedEntry;
- Usage: Integer;
- end;
-
-
- TtsRendererOpenGL = class(TtsRenderer)
- private
- fPos: tsPoint;
-
- fTextureSize: Integer;
-
- // Texture
- fTextures: TList;
-
- procedure AllocSpace(var FirstManaged: PtsRendererOpenGLManagedEntry; Start, Count: Word);
- procedure FreeSpace(var FirstManaged: PtsRendererOpenGLManagedEntry; Start, Count: Word);
-
- function GetTextureByID(ID: Integer): PtsRendererOpenGLTexture;
-
- function AddImageToTexture(Texture: PtsRendererOpenGLTextureEntry; Image: TtsImage; var TextureID: Integer; var Coordinates: tsRect): boolean;
- function CreateNewTexture: PtsRendererOpenGLTextureEntry;
-
- procedure DeleteTexture(Idx: Integer);
- procedure ClearTextures;
- protected
- procedure DrawChar(Font: TtsFont; Char: TtsChar); override;
- procedure DrawSetPosition(X, Y: Integer); override;
- procedure DrawSetPositionRelative(X, Y: Integer); override;
- procedure DrawSetColor(Red, Green, Blue, Alpha: Single); override;
-
- function AddImage(Char: TtsChar; CharImage: TtsImage): TtsRendererImageReference; override;
- procedure RemoveImageReference(ImageReference: TtsRendererImageReference); override;
- public
- property TextureSize: Integer read fTextureSize write fTextureSize;
-
- procedure BeginBlock(Left, Top, Width, Height: Integer; Flags: tsBitmask); override;
-
- procedure AfterConstruction; override;
- procedure BeforeDestruction; override;
- end;
-
-
- // context structures/types for use in unit TextSuite
- TtsContext = class
- private
- fContextID: Cardinal;
-
- // Fonts
- fFonts: TtsHash;
- fLastFontID: Cardinal;
-
- // Images
- fImages: TtsHash;
- fLastImageID: Cardinal;
-
- function GetIsLocked: boolean;
-
- procedure ClearFonts;
- procedure ClearImages;
- function GetActiveFont: TtsFont;
- public
- // ThreadID
- gBoundThreadID: Cardinal;
-
- // error
- Error: Cardinal;
-
- // globals settings
- Renderer: TtsRenderer;
- gCreator: tsEnum;
- gGlobalFormat: tsEnum;
- gGlobalAntiAliasing: tsEnum;
-
- gDebugDrawCharRects: Boolean;
-
- gEmptyCodePageEntry: tsEnum;
- gCodePage: tsEnum;
- gCodePagePtr: Pointer;
- gCodePageFunc: TtsAnsiToWideCharFunc;
-
- gSingleLine: tsEnum;
- gAlign: tsEnum;
- gVAlign: tsEnum;
- gClip: tsEnum;
- gBlockOffsetX: tsInt;
- gBlockOffsetY: tsInt;
-
- gImageMode: TtsImageModes;
- gImageLibrary: tsEnum;
-
-{ Tab: tsEnum;
- TabWidth: tsInt; }
-
- // context specific / helper
- property ContextID: Cardinal read fContextID;
-
- property IsLocked: boolean read GetIsLocked;
-
- property ActiveFont: TtsFont read GetActiveFont;
-
- // helper functions
- function ImageAdd(Image: TtsImage): Cardinal;
- function ImageGet(Image: Cardinal): TtsImage;
- procedure ImageDelete(Image: Cardinal);
- function ImageCount: Cardinal;
-
- function FontAdd(Font: TtsFont): Cardinal;
- function FontGet(Font: Cardinal): TtsFont;
- procedure FontDelete(Font: Cardinal);
- function FontCount: Cardinal;
-
- function AnsiToWide(pText: pAnsiChar): pWideChar;
-
- constructor Create;
- destructor Destroy; override;
- end;
-
-
- PtsContextFontEntry = ^TtsContextFontEntry;
- TtsContextFontEntry = record
- FontID: tsFontID;
- Font: TtsFont;
- end;
-
-
- PtsContextImageEntry = ^TtsContextImageEntry;
- TtsContextImageEntry = record
- ImageID: tsImageID;
- Image: TtsImage;
- end;
-
-
-// Helper
-function MakeColor(Red: Byte = 0; Green: Byte = 0; Blue: Byte = 0; Alpha: Byte = 0): tsColor;
-
-
-implementation
-
-
-uses
- Math,
- SysUtils,
- SyncObjs,
- TextSuitePostProcess,
- TextSuiteTTFUtils;
-
-
-var
- gLastContextID: Cardinal;
-
-
-// Helper
-function MakeColor(Red, Green, Blue, Alpha: Byte): tsColor;
-begin
- Result.Red := Red;
- Result.Green := Green;
- Result.Blue := Blue;
- Result.Alpha := Alpha;
-end;
-
-
-procedure TranslateQuad(var Dest: tsQuadFloat; const Source: tsQuadFloat; const Translate: tsPoint);
-begin
- Dest[0].X := Source[0].X + Translate.X;
- Dest[0].Y := Source[0].Y + Translate.Y;
-
- Dest[1].X := Source[1].X + Translate.X;
- Dest[1].Y := Source[1].Y + Translate.Y;
-
- Dest[2].X := Source[2].X + Translate.X;
- Dest[2].Y := Source[2].Y + Translate.Y;
-
- Dest[3].X := Source[3].X + Translate.X;
- Dest[3].Y := Source[3].Y + Translate.Y;
-end;
-
-
-{ TtsHash }
-
-procedure TtsHash.Add(Name: Integer; Value: Pointer);
-var
- Pos: Integer;
- Entry, HashEntry: PtsHashEntry;
-begin
- if Name <> 0 then begin
- Pos := IntToPos(Name);
- HashEntry := fHashArray[Pos];
- Entry := fHashArray[Pos];
-
- if (HashEntry = nil) then begin
- if (Value = nil) then
- Exit;
-
- New(HashEntry);
- HashEntry^.Name := Name;
- HashEntry^.Value := Value;
- HashEntry^.Next := nil;
- fHashArray[Pos] := HashEntry;
- Inc(fCount);
-
- Exit;
- end;
-
- while HashEntry <> nil do begin
- if Name = HashEntry^.Name then begin
- if Value = nil then begin
- if (HashEntry = fHashArray[Pos]) then
- fHashArray[Pos] := fHashArray[Pos]^.Next
- else
- Entry^.Next := HashEntry^.Next;
-
- Dispose(HashEntry);
- Dec(fCount);
- Exit;
- end;
-
- HashEntry^.Value := Value;
- Exit;
- end;
-
- if HashEntry^.Next = nil
- then break;
-
- Entry := HashEntry;
- HashEntry := HashEntry^.Next;
- end;
-
- if (Value = nil)
- then Exit;
-
- New(Entry);
- Entry^.Name := Name;
- Entry^.Value := Value;
- Entry^.Next := nil;
- Inc(fCount);
-
- HashEntry^.Next := Entry;
- end;
-end;
-
-
-procedure TtsHash.Clear;
-var
- Idx: Integer;
- TempEntry, Entry: PtsHashEntry;
-begin
- for Idx := Low(fHashArray) to High(fHashArray) do begin
- Entry := fHashArray[Idx];
-
- while Entry <> nil do begin
- TempEntry := Entry;
- Entry := Entry^.Next;
-
- Dispose(TempEntry);
- end;
-
- fHashArray[Idx] := nil;
- end;
-
- fCount := 0;
-end;
-
-
-constructor TtsHash.Create(HashEntrys: Integer);
-begin
- inherited Create;
-
- fHashEntrys := Max(1, HashEntrys);
- SetLength(fHashArray, fHashEntrys);
-end;
-
-
-procedure TtsHash.Delete(Name: Integer);
-begin
- // Add with an empty value is enough
- Add(Name, nil);
-end;
-
-
-destructor TtsHash.Destroy;
-begin
- Clear;
-
- inherited;
-end;
-
-
-function TtsHash.Get(Name: Integer): Pointer;
-var
- Pos: Integer;
- Entry: PtsHashEntry;
-begin
- Result := nil;
-
- if Name <> 0 then begin
- Pos := IntToPos(Name);
- Entry := fHashArray[Pos];
-
- if Entry <> nil then begin
- while Entry <> nil do begin
- if Name = Entry^.Name then begin
- Result := Entry^.Value;
-
- Break;
- end;
-
- Entry := Entry^.Next;
- end;
- end;
- end;
-end;
-
-
-procedure TtsHash.GetNames(const NameList: TList);
-var
- Idx: Integer;
- Entry: PtsHashEntry;
-begin
- Assert(NameList <> nil, 'TtsHash.GetNames - NameList is undefined');
-
- NameList.Clear;
-
- for Idx := Low(fHashArray) to High(fHashArray) do begin
- Entry := fHashArray[Idx];
-
- while Entry <> nil do begin
- NameList.Add({%H-}Pointer(Entry^.Name));
-
- Entry := Entry^.Next;
- end;
- end;
-end;
-
-
-procedure TtsHash.GetValues(const ValueList: TList);
-var
- Idx: Integer;
- Entry: PtsHashEntry;
-begin
- Assert(ValueList <> nil, 'TtsHash.GetValues - ValuesList is undefined');
-
- ValueList.Clear;
-
- for Idx := Low(fHashArray) to High(fHashArray) do begin
- Entry := fHashArray[Idx];
-
- while Entry <> nil do begin
- ValueList.Add(Entry^.Value);
-
- Entry := Entry^.Next;
- end;
- end;
-end;
-
-
-function TtsHash.IntToPos(Name: Integer): Integer;
-begin
- if Name < 0 then
- Result := -Name
- else
- Result := Name;
-
- Result := Result mod fHashEntrys;
-end;
-
-
-{ TtsStringHash }
-
-procedure TtsStringHash.Add(pString: pWideChar);
-var
- Pos: Integer;
- Entry, HashEntry: PtsStringHashEntry;
-begin
- if pString <> nil then begin
- Pos := {%H-}Cardinal(pString) mod fHashEntrys;
- Entry := fHashArray[Pos];
- HashEntry := Entry;
-
- // is empty field
- if (Entry = nil) then begin
- New(Entry);
- Entry^.pString := pString;
- Entry^.Next := nil;
- fHashArray[Pos] := Entry;
-
- Exit;
- end;
-
- // search last
- while HashEntry <> nil do begin
- if HashEntry^.Next = nil
- then break;
-
- HashEntry := HashEntry^.Next;
- end;
-
- New(Entry);
- Entry^.pString := pString;
- Entry^.Next := nil;
-
- HashEntry^.Next := Entry;
- end;
-end;
-
-
-constructor TtsStringHash.Create(HashEntrys: Integer);
-begin
- inherited Create;
-
- fHashEntrys := Max(1, HashEntrys);
- SetLength(fHashArray, fHashEntrys);
-end;
-
-
-function TtsStringHash.Delete(pString: pWideChar) : Boolean;
-var
- Pos: Integer;
- Entry, HashEntry: PtsStringHashEntry;
-begin
- Result := False;
-
- if pString <> nil then begin
- Pos := {%H-}Cardinal(pString) mod fHashEntrys;
- HashEntry := fHashArray[Pos];
- Entry := nil;
-
- while HashEntry <> nil do begin
- if pString = HashEntry^.pString then begin
- if (HashEntry = fHashArray[Pos]) then
- fHashArray[Pos] := fHashArray[Pos]^.Next
- else
- Entry^.Next := HashEntry^.Next;
-
- Dispose(HashEntry);
-
- Result := True;
-
- Exit;
- end;
-
- Entry := HashEntry;
- HashEntry := HashEntry^.Next;
- end;
- end;
-end;
-
-
-destructor TtsStringHash.Destroy;
-var
- Idx: Integer;
- Temp: PtsStringHashEntry;
-begin
- for Idx := Low(fHashArray) to High(fHashArray) do begin
- while fHashArray[Idx] <> nil do begin
- Temp := fHashArray[Idx];
-
- fHashArray[Idx] := fHashArray[Idx]^.Next;
-
- tsStrDispose(Temp^.pString);
- Dispose(Temp);
- end;
- end;
-
- SetLength(fHashArray, 0);
-
- inherited;
-end;
-
-
-{ TtsKernel1D }
-
-constructor TtsKernel1D.Create(Radius, Strength: Single);
-var
- TempRadius, SQRRadius, TempStrength, TempValue: Double;
- Idx: Integer;
-
-
- function CalcValue(Index: Integer): Single;
- var
- Temp: Double;
- begin
- Temp := Max(0, Abs(Index) - TempStrength);
- Temp := Sqr(Temp * TempRadius) / SQRRadius;
-
- Result := Exp(-Temp);
- end;
-
-begin
- inherited Create;
-
- // calculate new radius and strength
- TempStrength := Min(Radius - 1, Radius * Strength);
- TempRadius := Radius - 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;
-
- ValueSum := 0;
- 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;
-
- // sum
- ValueSum := ValueSum + TempValue;
- if Idx > 0 then
- ValueSum := ValueSum + TempValue;
- end;
-end;
-
-
-procedure TtsKernel1D.UpdateDataOffset(DataSize: Integer);
-var
- Idx: Integer;
-begin
- for Idx := 0 to ItemCount -1 do
- with Items[Idx] do
- DataOffset := Offset * DataSize;
-end;
-
-
-
-{ TtsKernel2D }
-
-constructor TtsKernel2D.Create(Radius, Strength: Single);
-var
- TempRadius, SQRRadius, TempStrength, TempValue: Double;
- X, Y, Height, Width: Integer;
-
-
- function CalcValue(Index: Single): Single;
- var
- Temp: Double;
- begin
- Temp := Max(0, Abs(Index) - TempStrength);
- Temp := Sqr(Temp * TempRadius) / SQRRadius;
-
- Result := Exp(-Temp);
- end;
-
-
- procedure QuickSort(L, R: Integer);
- var
- I, J: Integer;
- P, T: TtsKernel2DItem;
-
- function Compare(const Item1, Item2: TtsKernel2DItem): Integer;
- begin
- if Item1.Value = Item2.Value then
- Result := 0
- else
- if Item1.Value > Item2.Value then
- Result := -1
- else
- Result := 1;
- end;
-
- begin
- repeat
- I := L;
- J := R;
- P := Items[(L + R) shr 1];
-
- repeat
- while Compare(Items[I], P) < 0 do
- Inc(I);
-
- while Compare(Items[J], P) > 0 do
- Dec(J);
-
- if I <= J then begin
- T := Items[I];
- Items[I] := Items[J];
- Items[J] := T;
- Inc(I);
- Dec(J);
- end;
- until I > J;
-
- if L < J then
- QuickSort(L, J);
-
- L := I;
- until I >= R;
- end;
-
-
-begin
- inherited Create;
-
- // calculate new radius and strength
- TempStrength := Min(Radius - 1, Radius * Strength);
- TempRadius := Radius - TempStrength;
-
- SQRRadius := sqr(TempRadius) * sqr(TempRadius);
-
- // caluculating X size of the kernel
- SizeX := 0;
- MidSizeX := SizeX;
-
- while CalcValue(SizeX) > 0.5 do begin
- Inc(SizeX);
- Inc(MidSizeX);
- end;
-
- while CalcValue(SizeX) > 0.001 do
- Inc(SizeX);
-
- // caluculating Y size of the kernel
- SizeY := 0;
- MidSizeY := SizeY;
-
- while CalcValue(SizeY) > 0.5 do begin
- Inc(SizeY);
- Inc(MidSizeY);
- end;
-
- while CalcValue(SizeY) > 0.001 do
- Inc(SizeY);
-
- ValueSum := 0;
-
- Width := SizeX * 2 + 1;
- Height := SizeY * 2 + 1;
- ItemCount := Height * Width;
- SetLength(Items, ItemCount);
-
- Width := SizeX * 2 + 1;
- Height := SizeY * 2 + 1;
- ItemCount := Height * Width;
- SetLength(Items, ItemCount);
-
- // calculate Value (yes thats right. there is no -1)
- for Y := 0 to SizeY do begin
- for X := 0 to SizeX do begin
- TempValue := CalcValue(Sqrt(Sqr(X) + Sqr(Y)));
-
- with Items[(SizeY + Y) * Width + (SizeX + X)] do begin
- OffsetX := X;
- OffsetY := Y;
- Value := TempValue;
- end;
-
- with Items[(SizeY + Y) * Width + (SizeX - X)] do begin
- OffsetX := -X;
- OffsetY := Y;
- Value := TempValue;
- end;
-
- with Items[(SizeY - Y) * Width + (SizeX + X)] do begin
- OffsetX := X;
- OffsetY := -Y;
- Value := TempValue;
- end;
-
- with Items[(SizeY - Y) * Width + (SizeX - X)] do begin
- OffsetX := -X;
- OffsetY := -Y;
- Value := TempValue;
- end;
-
- // sum
- ValueSum := ValueSum + TempValue;
- if (X > 0) and (Y > 0) then
- ValueSum := ValueSum + TempValue;
- end;
- end;
-
- // sort
- QuickSort(0, ItemCount -1);
-
- // cut small items
- while Items[ItemCount -1].Value < 0.001 do
- Dec(ItemCount);
-
- SetLength(Items, ItemCount);
-end;
-
-
-procedure TtsKernel2D.UpdateDataOffset(DataSizeX, DataSizeY: Integer);
-var
- Idx: Integer;
-begin
- for Idx := 0 to ItemCount -1 do
- with Items[Idx] do
- DataOffset := OffsetX * DataSizeX + OffsetY * DataSizeY;
-end;
-
-
-{ TtsChar }
-
-(*
-procedure TtsChar.CalculateKerningData(CharImage: TtsImage);
-var
- Y: Integer;
- pLeft, pRight: PtsColor;
-
-
- function GetFirstPixel(pData: PtsColor; MinOpaque: Byte; IncValue, MaxSteps: Integer) : Integer;
- var
- CurStep: Integer;
- begin
- Result := MaxSteps;
- CurStep := 0;
-
- while CurStep < MaxSteps do begin
- if pData^.Alpha >= MinOpaque then begin
- Result := CurStep;
- Break;
- end;
-
- Inc(CurStep);
- Inc(pData, IncValue);
- end;
- end;
-
-begin
- SetLength(KerningValuesLeft, CharImage.Height);
- SetLength(KerningValuesRight, CharImage.Height);
-
- for Y := 0 to CharImage.Height - 1 do begin
- pRight := CharImage.ScanLine[Y];
- Inc(pRight, CharImage.Width -1);
- KerningValuesRight[Y] := GetFirstPixel(pRight, $40, -1, CharImage.Width);
-
- pLeft:= CharImage.ScanLine[Y];
- KerningValuesLeft[Y] := GetFirstPixel(pLeft, $40, 1, CharImage.Width);
- end;
-end;
-*)
-
-
-//function TtsChar.CalculateKerningValue(LastChar: TtsChar): Smallint;
-//begin
-// Result := 0;
-//var
-// TempHeight, TempLastHeight: Integer;
-// Y, YMin, YMax: Integer;
-// LeftYMin, LeftYMax, RightYMin, RightYMax: Integer;
-//
-// Dist, TempDist: Integer;
-//
-// function GetMinDistance(Row: Integer): Integer;
-// begin
-//// Result :=
-//// Self.KerningValuesLeft[Self.BaseLine - Self.GlyphRect.Top + Row] +
-//// LastChar.KerningValuesRight[LastChar.BaseLine - LastChar.GlyphRect.Top + Row];
-// end;
-//
-//begin
-// Result := 0;
-//
-// if Assigned(LastChar) then begin
-// TempLastHeight := Length(LastChar.KerningValuesRight);
-// TempHeight := Length(Self.KerningValuesLeft);
-//
-// if (TempLastHeight > 0) and (TempHeight > 0) then begin
-// LeftYMin := Self.GlyphRect.Bottom - Self.BaseLine;
-// LeftYMax := Self.GlyphRect.Top - Self.BaseLine;
-//
-// RightYMin := LastChar.GlyphRect.Bottom - LastChar.BaseLine;
-// RightYMax := LastChar.GlyphRect.Top - LastChar.BaseLine;
-//
-// YMin := Min(LeftYMin, RightYMin);
-// YMax := Max(LeftYMax, RightYMax);
-//
-// Dist := -1;
-//
-// for Y := YMax to YMin -1 do begin
-// TempDist := GetMinDistance(Y);
-//
-// if (Dist = -1) then
-// Dist := TempDist
-// else
-//
-// if TempDist < Dist then
-// Dist := TempDist;
-// end;
-//
-// // calculate advance of last char to diff
-// Dist := Dist + LastChar.Advance - (LastChar.GlyphRect.Right - LastChar.GlyphRect.Left);
-//
-// Result := -Dist +3;
-// end;
-// end;
-//end;
-
-
-constructor TtsChar.Create(CharCode: WideChar);
-begin
- inherited Create;
-
- fCharCode := CharCode;
-end;
-
-
-destructor TtsChar.Destroy;
-begin
-// SetLength(KerningValuesLeft, 0);
-// SetLength(KerningValuesRight, 0);
-
- inherited;
-end;
-
-
-procedure TtsChar.ExpandRect(Left, Top, Right, Bottom: Integer);
-begin
- Advance := Advance + Left + Right;
- GlyphOriginY := GlyphOriginY + Top + Bottom;
-
- GlyphRect.Right := GlyphRect.Right + Left + Right;
- GlyphRect.Bottom := GlyphRect.Bottom + Top + Bottom;
-end;
-
-
-{ TtsImage }
-type
- TtsModeFunc = function(Source, Dest: Byte): Byte; register;
-
-
-function ModeFuncIgnore(Source, Dest: Byte): Byte; register;
-{$ifdef TS_PURE_PASCAL}
-begin
- Result := Dest;
-{$else}
-asm
- mov al, dl
-{$endif}
-end;
-
-
-function ModeFuncReplace(Source, Dest: Byte): Byte; register;
-{$ifdef TS_PURE_PASCAL}
-begin
- Result := Source;
-{$else}
-asm
-{$endif}
-end;
-
-
-function ModeFuncModulate(Source, Dest: Byte): Byte; register;
-{$ifdef TS_PURE_PASCAL}
-begin
- Result := (Source * Dest) div $FF
-{$else}
-asm
-// inc ax
-// inc dx
- mul dl
- shr eax, 8
-{$endif}
-end;
-
-
-procedure TtsImage.AddFunc(Func: TtsImageFunc; Data: Pointer);
-var
- X, Y: Integer;
- pPix: PtsColor;
-begin
- for Y := 0 to Height - 1 do begin
- pPix := ScanLine[Y];
-
- for X := 0 to Width - 1 do begin
- Func(Self, X, Y, pPix^, Data);
-
- Inc(pPix);
- end;
- end;
-end;
-
-
-procedure TtsImage.AddResizingBorder(tsChar: TtsChar);
-var
- X, Y: Integer;
- pPix: PtsColor;
-
- pTemp: PtsColor;
- SumCount: Integer;
- SumColor: array [0..2] of integer;
-begin
- SumColor[0] := 0;
- SumColor[1] := 0;
- SumColor[2] := 0;
- SumCount := 0;
-
- // settings of char
- tsChar.GlyphRect.Top := tsChar.GlyphRect.Top + 1;
- tsChar.GlyphRect.Left := tsChar.GlyphRect.Left + 1;
- tsChar.GlyphRect.Right := tsChar.GlyphRect.Right + 1;
- tsChar.GlyphRect.Bottom := tsChar.GlyphRect.Bottom + 1;
-
- // resize image
- Resize(Width + 4, Height + 4, 2, 2);
-
- // calculate color of invisible pixels
- for Y := 0 to Height -1 do begin
- pPix := ScanLine[Y];
-
- for X := 0 to Width -1 do begin
- if pPix^.Alpha = 0 then begin
- // row -1
- if Y > 0 then begin
- pTemp := pPix;
- Dec(pTemp, fWidth);
-
- // row -1 / col
- if pTemp^.Alpha > 0 then begin
- Inc(SumCount);
- Inc(SumColor[0], pTemp^.Red);
- Inc(SumColor[1], pTemp^.Green);
- Inc(SumColor[2], pTemp^.Blue);
- end;
-
- // row -1 / col -1
- if X > 0 then begin
- Dec(pTemp);
-
- if pTemp^.Alpha > 0 then begin
- Inc(SumCount);
- Inc(SumColor[0], pTemp^.Red);
- Inc(SumColor[1], pTemp^.Green);
- Inc(SumColor[2], pTemp^.Blue);
- end;
-
- Inc(pTemp);
- end;
-
- // row -1 / col +1
- if X < fWidth -1 then begin
- Inc(pTemp);
-
- if pTemp^.Alpha > 0 then begin
- Inc(SumCount);
- Inc(SumColor[0], pTemp^.Red);
- Inc(SumColor[1], pTemp^.Green);
- Inc(SumColor[2], pTemp^.Blue);
- end;
- end;
- end;
-
- // row +1
- if Y < fHeight -1 then begin
- pTemp := pPix;
- Inc(pTemp, fWidth);
-
- // row +1 / col
- if pTemp^.Alpha > 0 then begin
- Inc(SumCount);
- Inc(SumColor[0], pTemp^.Red);
- Inc(SumColor[1], pTemp^.Green);
- Inc(SumColor[2], pTemp^.Blue);
- end;
-
- // row +1 / col -1
- if X > 0 then begin
- Dec(pTemp);
-
- if pTemp^.Alpha > 0 then begin
- Inc(SumCount);
- Inc(SumColor[0], pTemp^.Red);
- Inc(SumColor[1], pTemp^.Green);
- Inc(SumColor[2], pTemp^.Blue);
- end;
-
- Inc(pTemp);
- end;
-
- // row +1 / col +1
- if X < fWidth -1 then begin
- Inc(pTemp);
-
- if pTemp^.Alpha > 0 then begin
- Inc(SumCount);
- Inc(SumColor[0], pTemp^.Red);
- Inc(SumColor[1], pTemp^.Green);
- Inc(SumColor[2], pTemp^.Blue);
- end;
- end;
- end;
-
- // row / col -1
- if X > 0 then begin
- pTemp := pPix;
- Dec(pTemp);
-
- if pTemp^.Alpha > 0 then begin
- Inc(SumCount);
- Inc(SumColor[0], pTemp^.Red);
- Inc(SumColor[1], pTemp^.Green);
- Inc(SumColor[2], pTemp^.Blue);
- end;
- end;
-
- // row / col +1
- if X < fWidth -1 then begin
- pTemp := pPix;
- Inc(pTemp);
-
- if pTemp^.Alpha > 0 then begin
- Inc(SumCount);
- Inc(SumColor[0], pTemp^.Red);
- Inc(SumColor[1], pTemp^.Green);
- Inc(SumColor[2], pTemp^.Blue);
- end;
- end;
-
- // any pixel next to the transparent pixel they are opaque?
- if SumCount > 0 then begin
- // calculate resulting pixel color
- pPix^.Red := SumColor[0] div SumCount;
- pPix^.Green := SumColor[1] div SumCount;
- pPix^.Blue := SumColor[2] div SumCount;
-
- // clearing values
- SumColor[0] := 0;
- SumColor[1] := 0;
- SumColor[2] := 0;
- SumCount := 0;
- end;
- end;
-
- Inc(pPix);
- end;
- end;
-end;
-
-
-procedure TtsImage.AssignFrom(Image: TtsImage);
-var
- pImage: Pointer;
- ImageSize: Integer;
-begin
- ImageSize := Image.Width * Image.Height * GetFormatSize(Image.Format);
-
- GetMem(pImage, ImageSize);
-
- if pImage <> nil then
- Move(Image.Data^, pImage^, ImageSize);
-
- SetDataPtr(pImage, Image.Format, Image.Width, Image.Height);
-end;
-
-
-procedure TtsImage.BeforeDestruction;
-begin
- SetDataPtr(nil);
-
- inherited;
-end;
-
-
-procedure TtsImage.BlendImage(Image: TtsImage; X, Y: Integer; AutoExpand: Boolean);
-var
- pImage, pDest: PtsColor;
- X1, X2, Y1, Y2, BX1, BX2, BY1, BY2, NewWidth, NewHeight: Integer;
- TempX, TempY: Integer;
-
- TempLines: array of PtsColor;
- pSource: PtsColor;
-
- // Blending
- pUnder, pOver: PtsColor;
- ResultAlpha, FaqUnder, FaqOver: Byte;
-begin
- // Calculate new size
- X1 := Min(X, 0);
- X2 := Max(X + Image.Width, Width);
-
- Y1 := Min(Y, 0);
- Y2 := Max(Y + Image.Height, Height);
-
- BX1 := Max(X, 0);
- BX2 := Min(X + Image.Width, Width);
-
- BY1 := Max(Y, 0);
- BY2 := Min(Y + Image.Height, Height);
-
- NewWidth := X2 - X1;
- NewHeight := Y2 - Y1;
-
- // Allocate new image
- GetMem(pImage, NewWidth * NewHeight * GetFormatSize(Format));
- try
- FillChar(pImage^, NewWidth * NewHeight * GetFormatSize(Format), #$00);
-
- // ScanLines
- SetLength(TempLines, NewHeight);
-
- for TempY := 0 to NewHeight - 1 do begin
- TempLines[TempY] := pImage;
- Inc(TempLines[TempY], NewWidth * TempY);
- end;
-
- // copy non overlapping data from underlaying Image
- for TempY := 0 to Height -1 do begin
- pDest := TempLines[TempY - Y1];
- Inc(pDest, - X1);
-
- pSource := ScanLine[TempY];
-
- for TempX := 0 to Width -1 do begin
- pDest^ := pSource^;
-
- Inc(pDest);
- Inc(pSource);
- end;
- end;
-
- // copy non overlapping data from overlaying Image
- for TempY := 0 to Image.Height -1 do begin
- pDest := TempLines[TempY + Y - Y1];
- Inc(pDest, X - X1);
-
- pSource := Image.ScanLine[TempY];
-
- for TempX := 0 to Image.Width -1 do begin
- pDest^ := pSource^;
-
- Inc(pDest);
- Inc(pSource);
- end;
- end;
-
- // Blend overlapped
- for TempY := BY1 to BY2 - 1 do begin
- pOver := Image.ScanLine[TempY - Min(BY1, Y)];
- Inc(pOver, BX1 - X);
-
- pUnder := ScanLine[TempY - Min(BY1, 0)];
- Inc(pUnder, BX1);
-
- pDest := TempLines[TempY - Min(Y, 0)];
- Inc(pDest, BX1 - Min(X, 0));
-
- for TempX := BX1 to BX2 - 1 do begin
- ResultAlpha := pOver^.Alpha + pUnder^.Alpha * ($FF - pOver^.Alpha) div $FF;
-
- if ResultAlpha > 0 then begin
- FaqUnder := (pUnder^.Alpha * ($FF - pOver^.Alpha) div $FF) * $FF div ResultAlpha;
- FaqOver := pOver^.Alpha * $FF div ResultAlpha;
-
- pDest^.Red := (pOver^.Red * FaqOver + pUnder^.Red * FaqUnder) div $FF;
- pDest^.Green := (pOver^.Green * FaqOver + pUnder^.Green * FaqUnder) div $FF;
- pDest^.Blue := (pOver^.Blue * FaqOver + pUnder^.Blue * FaqUnder) div $FF;
- end else begin
- pDest^.Red := 0;
- pDest^.Green := 0;
- pDest^.Blue := 0;
- end;
-
- pDest^.Alpha := ResultAlpha;
-
- Inc(pOver);
- Inc(pUnder);
- Inc(pDest);
- end;
- end;
-
- // Set new image
- SetDataPtr(pImage, Format, NewWidth, NewHeight);
- except
- FreeMem(pImage);
- end;
-end;
-
-
-
-type
- TtsImageBlurFuncData = packed record
- Kernel: TtsKernel1D;
- Pos, MaxPos: Integer;
- end;
-
- TBlurFunc = function(pSource: pByte; var Data: TtsImageBlurFuncData): Byte; register;
-
-
-function BlurFuncKernel(pSource: pByte; var Data: TtsImageBlurFuncData): Byte; register;
-var
- Idx: Integer;
- pTemp: pByte;
- TempSum, TempMax: Double;
-begin
- TempSum := 0;
- TempMax := 0;
-
- with Data do begin
- for Idx := 0 to Kernel.ItemCount -1 do begin
- with Kernel.Items[Idx] do begin
- if (Pos + Offset >= 0) and (Pos + Offset < MaxPos) then begin
- pTemp := pSource;
- Inc(pTemp, DataOffset);
-
- TempSum := TempSum + pTemp^ * Value;
- TempMax := TempMax + Value;
- end;
- end;
- end;
- end;
-
- Result := Round(TempSum / TempMax);
-end;
-
-
-function BlurFuncIgnore(pSource: pByte; var Data: TtsImageBlurFuncData): Byte; register;
-{$ifdef TS_PURE_PASCAL}
-begin
- Result := pSource^;
-{$else}
-asm
- mov al, byte ptr [eax]
-{$endif}
-end;
-
-
-procedure TtsImage.Blur(HorzKernel, VertKernel: TtsKernel1D; ChannelMask: tsBitmask);
-var
- X, Y: Integer;
- Temp: TtsImage;
-
- pSource, pDest: ptsColor;
-
- FuncData: TtsImageBlurFuncData;
- RedFunc, GreenFunc, BlueFunc, AlphaFunc: TBlurFunc;
-
-
- procedure AssignFunc(var Func: TBlurFunc; MaskBit: Cardinal);
- begin
- if MaskBit and ChannelMask > 0 then
- Func := BlurFuncKernel
- else
- Func := BlurFuncIgnore;
- end;
-
-
-begin
- // casing functions
- AssignFunc(RedFunc, TS_CHANNEL_RED);
- AssignFunc(GreenFunc, TS_CHANNEL_GREEN);
- AssignFunc(BlueFunc, TS_CHANNEL_BLUE);
- AssignFunc(AlphaFunc, TS_CHANNEL_ALPHA);
-
-
- Temp := TtsImage.Create;
- try
- Temp.CreateEmpty(Format, Width, Height);
- Temp.FillColor(1, 1, 1, 0, TS_CHANNELS_RGBA, cModesReplace);
-
- // blur horz from original to temp image
- HorzKernel.UpdateDataOffset(4);
-
- FuncData.Kernel := HorzKernel;
- FuncData.MaxPos := Temp.Width;
-
- for Y := 0 to Temp.Height - 1 do begin
- pSource := Self.ScanLine[Y];
- pDest := Temp.ScanLine[Y];
-
- for X := 0 to FuncData.MaxPos - 1 do begin
- FuncData.Pos := X;
- pDest^.Red := RedFunc(@(pSource^.Red), FuncData);
- pDest^.Green := GreenFunc(@(pSource^.Green), FuncData);
- pDest^.Blue := BlueFunc(@(pSource^.Blue), FuncData);
- pDest^.Alpha := AlphaFunc(@(pSource^.Alpha), FuncData);
-
- Inc(pDest);
- Inc(pSource);
- end;
- end;
-
- // blur vert from temp to original image
- VertKernel.UpdateDataOffset(Width * 4);
-
- FuncData.Kernel := VertKernel;
- FuncData.MaxPos := Temp.Height;
-
- for Y := 0 to Temp.Height - 1 do begin
- pSource := Temp.ScanLine[Y];
- pDest := Self.ScanLine[Y];
-
- FuncData.Pos := Y;
-
- for X := 0 to Temp.Width - 1 do begin
- pDest^.Red := RedFunc(@(pSource^.Red), FuncData);
- pDest^.Green := GreenFunc(@(pSource^.Green), FuncData);
- pDest^.Blue := BlueFunc(@(pSource^.Blue), FuncData);
- pDest^.Alpha := AlphaFunc(@(pSource^.Alpha), FuncData);
-
- Inc(pDest);
- Inc(pSource);
- end;
- end;
-
- finally
- Temp.Free;
- end;
-end;
-
-
-procedure TtsImage.CreateEmpty(Format: TtsFormat; aWidth, aHeight: Integer);
-var
- pImage: pByte;
-begin
- pImage := AllocMem(aWidth * aHeight * GetFormatSize(Format));
-
- SetDataPtr(pImage, Format, aWidth, aHeight);
-end;
-
-
-procedure TtsImage.FillColor(Red, Green, Blue, Alpha: Single; ChannelMask: tsBitmask; Modes: TtsImageModes);
-//var
-// MaskColor: TtsFillcolorData;
-//begin
-// // prepare mask
-// FillChar(MaskColor.Mask, 4, $FF);
-// if ChannelMask and TS_CHANNEL_RED = TS_CHANNEL_RED then
-// MaskColor.Mask[0] := $00;
-// if ChannelMask and TS_CHANNEL_GREEN = TS_CHANNEL_GREEN then
-// MaskColor.Mask[1] := $00;
-// if ChannelMask and TS_CHANNEL_BLUE = TS_CHANNEL_BLUE then
-// MaskColor.Mask[2] := $00;
-// if ChannelMask and TS_CHANNEL_ALPHA = TS_CHANNEL_ALPHA then
-// MaskColor.Mask[3] := $00;
-//
-// pCardinal(@MaskColor.Mask[4])^ := pCardinal(@MaskColor.Mask[0])^;
-// pCardinal(@MaskColor.Mask[8])^ := pCardinal(@MaskColor.Mask[0])^;
-// pCardinal(@MaskColor.Mask[12])^ := pCardinal(@MaskColor.Mask[0])^;
-//
-// // prepare color
-// MaskColor.Color[0] := Round($FF * Red);
-// MaskColor.Color[1] := Round($FF * Green);
-// MaskColor.Color[2] := Round($FF * Blue);
-// MaskColor.Color[3] := Round($FF * Alpha);
-// pCardinal(@MaskColor.Color[4])^ := pCardinal(@MaskColor.Color[0])^;
-// pCardinal(@MaskColor.Color[8])^ := pCardinal(@MaskColor.Color[0])^;
-// pCardinal(@MaskColor.Color[12])^ := pCardinal(@MaskColor.Color[0])^;
-//
-// // image mode
-// FillChar(MaskColor.ModuloMask, 4, $00);
-// if (Modes[tsModeRed] = TS_MODE_MODULATE) and (MaskColor.Mask[0] > 0) then
-// MaskColor.ModuloMask[0] := $FF;
-// if (Modes[tsModeGreen] = TS_MODE_MODULATE) and (MaskColor.Mask[1] > 0) then
-// MaskColor.ModuloMask[1] := $FF;
-// if (Modes[tsModeBlue] = TS_MODE_MODULATE) and (MaskColor.Mask[2] > 0) then
-// MaskColor.ModuloMask[2] := $FF;
-// if (Modes[tsModeAlpha] = TS_MODE_MODULATE) and (MaskColor.Mask[3] > 0) then
-// MaskColor.ModuloMask[3] := $FF;
-// pCardinal(@MaskColor.ModuloMask[4])^ := pCardinal(@MaskColor.ModuloMask[0])^;
-//
-// // fill with color
-// if pCardinal(@MaskColor.ModuloMask[0])^ = 0 then
-// Fillcolor_RGBA8(Data, @MaskColor, Width * Height)
-// else
-// Fillcolor_RGBA8_modulo(Data, @MaskColor, Width * Height);
-//
-// {$IFNDEF TS_PURE_PASCAL}
-//// if supportSSE then
-//// Fillcolor_RGBA8_SSE(Data, @MaskColor, Width * Height)
-//// else
-// {$ENDIF}
-//
-//// Fillcolor_RGBA8(Data, @MaskColor, Width * Height);
-//end;
-var
- _Red, _Green, _Blue, _Alpha: Byte;
- RedFunc, GreenFunc, BlueFunc, AlphaFunc, LuminanceFunc: TtsModeFunc;
-
- Y, X: Integer;
- pPix: PtsColor;
-
-
- procedure AssignFunc(var Func: TtsModeFunc; Mask, Mode: tsEnum);
- begin
- if ChannelMask and Mask = Mask then begin
- if Mode = TS_MODE_MODULATE then
- Func := ModeFuncModulate
- else
- Func := ModeFuncReplace
- end else
- Func := ModeFuncIgnore
- end;
-
-
-begin
- _Red := Round($FF * Red);
- _Green := Round($FF * Green);
- _Blue := Round($FF * Blue);
- _Alpha := Round($FF * Alpha);
-
- AssignFunc(RedFunc, TS_CHANNEL_RED, Modes[tsModeRed]);
- AssignFunc(GreenFunc, TS_CHANNEL_GREEN, Modes[tsModeGreen]);
- AssignFunc(BlueFunc, TS_CHANNEL_BLUE, Modes[tsModeBlue]);
- AssignFunc(AlphaFunc, TS_CHANNEL_ALPHA, Modes[tsModeAlpha]);
- AssignFunc(LuminanceFunc, TS_CHANNEL_LUMINANCE, Modes[tsModeLuminance]);
-
- for Y := 0 to Height - 1 do begin
- pPix := ScanLine[Y];
-
- for X := 0 to Width - 1 do begin
- pPix^.Red := RedFunc (_Red, pPix^.Red);
- pPix^.Green := GreenFunc(_Green, pPix^.Green);
- pPix^.Blue := BlueFunc (_Blue, pPix^.Blue);
- pPix^.Alpha := AlphaFunc(_Alpha, pPix^.Alpha);
-
- Inc(pPix);
- end;
- end;
-end;
-
-
-procedure TtsImage.FillPattern(Pattern: TtsImage; X, Y: Integer; ChannelMask: tsBitmask; Modes: TtsImageModes);
-var
- TempX, TempY, RandX, RandY, PosX: Integer;
- RedFunc, GreenFunc, BlueFunc, AlphaFunc, LuminanceFunc: TtsModeFunc;
- pSrc, pDest: PtsColor;
-
-
- procedure AssignFunc(var Func: TtsModeFunc; Mask, Mode: tsEnum);
- begin
- if ChannelMask and Mask = Mask then begin
- if Mode = TS_MODE_MODULATE then
- Func := ModeFuncModulate
- else
- Func := ModeFuncReplace
- end else
- Func := ModeFuncIgnore
- end;
-
-
-begin
- // Pattern position
- if X < 0 then
- RandX := Random(Pattern.Width)
- else
- RandX := X;
-
- if Y < 0 then
- RandY := Random(Pattern.Height)
- else
- RandY := Y;
-
- AssignFunc(RedFunc, TS_CHANNEL_RED, Modes[tsModeRed]);
- AssignFunc(GreenFunc, TS_CHANNEL_GREEN, Modes[tsModeGreen]);
- AssignFunc(BlueFunc, TS_CHANNEL_BLUE, Modes[tsModeBlue]);
- AssignFunc(AlphaFunc, TS_CHANNEL_ALPHA, Modes[tsModeAlpha]);
- AssignFunc(LuminanceFunc, TS_CHANNEL_LUMINANCE, Modes[tsModeLuminance]);
-
- // Copy data
- for TempY := 0 to Height - 1 do begin
- pDest := ScanLine[TempY];
- pSrc := Pattern.Scanline[(TempY + RandY) mod Pattern.Height];
-
- Inc(pSrc, RandX);
- PosX := RandX;
-
- for TempX := 0 to Width - 1 do begin
- if PosX >= Pattern.Width then begin
- pSrc := Pattern.Scanline[(TempY + RandY) mod Pattern.Height];
- PosX := 0;
- end;
-
- pDest^.Red := RedFunc (pSrc^.Red, pDest^.Red);
- pDest^.Green := GreenFunc(pSrc^.Green, pDest^.Green);
- pDest^.Blue := BlueFunc (pSrc^.Blue, pDest^.Blue);
- pDest^.Alpha := AlphaFunc(pSrc^.Alpha, pDest^.Alpha);
-
- Inc(pDest);
- Inc(pSrc);
- Inc(PosX);
- end;
- end;
-end;
-
-
-procedure TtsImage.FindMinMax(var MinMaxInfo: tsRect);
-var
- X, Y: Integer;
- pPix: PtsColor;
-begin
- MinMaxInfo.Top := -1;
- MinMaxInfo.Left := -1;
- MinMaxInfo.Right := -1;
- MinMaxInfo.Bottom := -1;
-
- // Search for MinMax
- for Y := 0 to Height -1 do begin
- pPix := ScanLine[Y];
-
- for X := 0 to Width -1 do begin
- if pPix^.Alpha > 0 then begin
- if (X < MinMaxInfo.Left) or (MinMaxInfo.Left = -1) then
- MinMaxInfo.Left := X;
-
- if (X+1 > MinMaxInfo.Right) or (MinMaxInfo.Right = -1) then
- MinMaxInfo.Right := X +1;
-
- if (Y < MinMaxInfo.Top) or (MinMaxInfo.Top = -1) then
- MinMaxInfo.Top := Y;
-
- if (Y+1 > MinMaxInfo.Bottom) or (MinMaxInfo.Bottom = -1) then
- MinMaxInfo.Bottom := Y +1;
- end;
-
- Inc(pPix);
- end;
- end;
-end;
-
-
-function TtsImage.GetEmpty: Boolean;
-begin
- Result := fData = nil;
-end;
-
-
-function TtsImage.GetFormatSize(Format: TtsFormat): Integer;
-begin
- case Format of
- tsFormatRGBA8: Result := 4;
- else
- Result := 0;
- end;
-end;
-
-
-function TtsImage.GetScanLine(Index: Integer): pointer;
-begin
- if not fScanLinesValid then
- UpdateScanLines;
-
- if (fScanLinesValid) and (Index >= 0) and (Index <= High(fScanLines)) then
- Result := fScanLines[Index]
- else
- Result := nil;
-end;
-
-
-procedure TtsImage.LoadFromFile(FileName: PAnsiChar);
-var
- Surface, ConvSurface: PSDL_Surface;
- Format: TSDL_PixelFormat;
-
- ImageSize: Integer;
- Image: pByte;
-begin
- Surface := IMG_Load(FileName);
-
- if Surface <> nil then
- try
- FillChar(Format, SizeOf(TSDL_PixelFormat), 0);
- Format.BitsPerPixel := 32;
- Format.BytesPerPixel := 4;
- Format.RMask := $000000FF;
- Format.GMask := $0000FF00;
- Format.BMask := $00FF0000;
- Format.AMask := $FF000000;
- Format.Rshift := 0;
- Format.Gshift := 8;
- Format.Bshift := 16;
- Format.Ashift := 24;
-
- ConvSurface := SDL_ConvertSurface(Surface, @Format, SDL_SWSURFACE);
- if ConvSurface <> nil then
- try
- // Set Image Size
- ImageSize := ConvSurface^.Width * ConvSurface^.Height * 4;
-
- GetMem(Image, ImageSize);
- try
- // Copy image
- Move(ConvSurface^.pixels^, Image^, ImageSize);
-
- // Set new Data
- SetDataPtr(Image, tsFormatRGBA8, ConvSurface^.Width, ConvSurface^.Height);
- except
- FreeMem(Image);
- end;
- finally
- SDL_FreeSurface(ConvSurface);
- end;
- finally
- SDL_FreeSurface(Surface);
- end;
-end;
-
-
-procedure TtsImage.Resize(NewWidth, NewHeight, X, Y: Integer);
-var
- pImage: PByte;
- PixSize, LineSize, ImageSize, OrgLineSize: Integer;
-
- pSource, pDest: PByte;
- YStart, YEnd, YPos, XStart, XEnd: Integer;
-begin
- if (NewHeight = 0) or (NewWidth = 0) then begin
- SetDataPtr(nil);
- end else begin
- PixSize := GetFormatSize(Format);
- LineSize := PixSize * NewWidth;
- ImageSize := LineSize * NewHeight;
-
- OrgLineSize := PixSize * Width;
-
- GetMem(pImage, ImageSize);
- try
- FillChar(pImage^, ImageSize, 0);
-
- // positions
- YStart := Max(0, Y);
- YEnd := Min(NewHeight, Y + Height);
-
- XStart := Max(0, X);
- XEnd := Min(NewWidth, X + Width);
-
- // copy data
- for YPos := YStart to YEnd -1 do begin
- pDest := pImage;
- Inc(pDest, LineSize * YPos + PixSize * XStart);
-
- pSource := fData;
- Inc(pSource, OrgLineSize * (YPos - Y) + PixSize * (XStart - X));
-
- Move(pSource^, pDest^, (XEnd - XStart) * PixSize);
- end;
-
- // assign
- SetDataPtr(pImage, Format, NewWidth, NewHeight);
- except
- FreeMem(pImage);
- end;
- end;
-end;
-
-
-procedure TtsImage.SetDataPtr(aData: Pointer; aFormat: TtsFormat; aWidth, aHeight: Integer);
-begin
- fScanLinesValid := False;
-
- if fData <> nil then
- FreeMemory(fData);
-
- fData := aData;
- if fData <> nil then begin
- fWidth := aWidth;
- fHeight := aHeight;
- fFormat := aFormat;
- end else begin
- fWidth := 0;
- fHeight := 0;
- fFormat := tsFormatEmpty;
- end;
-end;
-
-
-procedure TtsImage.UpdateScanLines;
-var
- Idx, LineSize: Integer;
- Temp: pByte;
-begin
- LineSize := fWidth * GetFormatSize(fFormat);
-
- SetLength(fScanLines, fHeight);
- for Idx := 0 to fHeight -1 do begin
- Temp := fData;
- Inc(Temp, Idx * LineSize);
-
- fScanLines[Idx] := Temp;
- end;
-
- fScanLinesValid := True;
-end;
-
-
-{ TtsFont }
-
-procedure TtsFont.AddChar(CharCode: WideChar; Char: TtsChar);
-var
- Idx1, Idx2: Integer;
- Chars: PtsFontCharArray;
-begin
- Idx1 := Hi(Ord(CharCode));
- Chars := fChars[Idx1];
-
- if Chars = nil then begin
- New(Chars);
- FillChar(Chars^, SizeOf(TtsFontCharArray), 0);
-
- fChars[Idx1] := Chars;
- end;
-
- if Chars <> nil then begin
- Idx2 := Lo(Ord(CharCode));
- Chars^.Chars[Idx2] := Char;
- Chars^.CharCount := Chars^.CharCount + 1;
- end;
-end;
-
-
-procedure TtsFont.ClearChars;
-var
- Idx1, Idx2: Integer;
- Chars: PtsFontCharArray;
-
- Char: TtsChar;
-begin
- // iterate first step
- for Idx1 := Low(fChars) to High(fChars) do begin
- Chars := fChars[Idx1];
-
- // iterate second step
- if Chars <> nil then begin
- for Idx2 := Low(Chars^.Chars) to High(Chars^.Chars) do begin
- Char := Chars^.Chars[Idx2];
-
- // free char
- if Char <> nil then begin
- if Char.RendererImageReference <> nil then begin
- if fRenderer <> nil then
- fRenderer.RemoveImageReference(Char.RendererImageReference);
-
- Char.RendererImageReference.Free;
- end;
-
- Char.Free;
- end;
- end;
-
- // dispose
- fChars[Idx1] := nil;
- dispose(Chars);
- end;
- end;
-end;
-
-
-constructor TtsFont.Create(Renderer: TtsRenderer; Size: Integer; Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
-begin
- inherited Create;
-
- fRenderer := Renderer;
-
- fSize := Size;
- fStyle := Style;
- fFormat := Format;
- fAntiAliasing := AntiAliasing;
-end;
-
-
-procedure TtsFont.DeleteChar(CharCode: WideChar);
-var
- Idx1, Idx2: Integer;
- Chars: PtsFontCharArray;
- Char: TtsChar;
-begin
- // first step
- Idx1 := Hi(Ord(CharCode));
- Chars := fChars[Idx1];
-
- if Chars <> nil then begin
- // second step
- Idx2 := Lo(Ord(CharCode));
- Char := Chars^.Chars[Idx2];
-
- if Char <> nil then begin
- Chars^.Chars[Idx2] := nil;
- Chars^.CharCount := Chars^.CharCount -1;
-
- // no chars so delete the subpage
- if Chars^.CharCount = 0 then begin
- fChars[Idx1] := nil;
- Dispose(Chars);
- end;
-
- if Char.RendererImageReference <> nil then begin
- if fRenderer <> nil then
- fRenderer.RemoveImageReference(Char.RendererImageReference);
-
- Char.RendererImageReference.Free;
- end;
-
- Char.Free;
- end;
- end;
-end;
-
-
-destructor TtsFont.Destroy;
-begin
- // Chars
- ClearChars;
-
- inherited;
-end;
-
-
-function TtsFont.GetChar(CharCode: WideChar): TtsChar;
-{$IFDEF TS_PURE_PASCAL}
-var
- Chars: PtsFontCharArray;
-begin
- // first step
- Chars := fChars[Hi(Ord(CharCode))];
-
- // second step
- if Chars <> nil then
- Result := Chars^.Chars[Lo(Ord(CharCode))]
- else
- Result := nil;
-{$else}
-asm
- add eax, offset TtsFont.fChars // add offset of fChars to self
-
- movzx ecx, dh // extract high byte to ecx
- mov eax, dword ptr [eax + ecx * 4] // copy array element to eax
-
- test eax, eax // subarray is empty
- jz @@end
-
- movzx edx, dl // extract lower byte to ed x
- mov eax, dword ptr [eax + edx * 4] // copy array element to eax
-
-@@end:
-{$endif}
-end;
-
-
-procedure TtsFont.GetTextMetric(var Metric: TtsTextMetric);
-begin
- Metric.Ascent := Ascent;
- Metric.Descent := Descent;
- Metric.LineSkip := Ascent + Descent + ExternalLeading;
- Metric.LineSkip_with_LineSpace := Metric.LineSkip + LineSpacing;
-end;
-
-
-// May be fpc has problems because it's an virtual function
-function TtsFont.Validate(CharCode: WideChar): Boolean;
-//{$IFDEF TS_PURE_PASCAL}
-begin
- Result := GetChar(CharCode) <> nil;
-//{$else}
-//asm
-// // self is still in eax
-// // charcode is still is edx
-// call TtsFont.GetChar
-// test eax, eax
-// setnz al
-//{$endif}
-end;
-
-
-{ TtsFontCreator }
-
-procedure TtsFontCreator.AddChar(CharCode: WideChar);
-var
- tsChar: TtsChar;
-
- GlyphOriginX, GlyphOriginY, GlyphWidth, GlyphHeight, Advance: Integer;
- CharImage: TtsImage;
-begin
- if fCreateChars and (Ord(CharCode) > 0) then begin
- tsChar := GetChar(CharCode);
-
- // Check if the char allready was added
- if tsChar = nil then begin
- // check if the Char exists in the font
- if GetGlyphMetrics(CharCode, GlyphOriginX, GlyphOriginY, GlyphWidth, GlyphHeight, Advance) then
- if (GlyphOriginX <> 0) or (GlyphOriginY <> 0) or (GlyphWidth <> 0) or (GlyphHeight <> 0) or (Advance <> 0) then begin
- // Getting Image of Char
- CharImage := TtsImage.Create;
- try
- if fRenderer.SaveImages then begin
- if (GlyphWidth > 0) and (GlyphHeight > 0) then begin
- // getting char image
- GetCharImage(CharCode, CharImage);
- end;
- end;
-
- if (tsStyleUnderline in Style) or (tsStyleStrikeout in Style) then begin
- if (CharImage.Width = 0) and (CharImage.Height = 0) then begin
- CharImage.CreateEmpty(tsFormatRGBA8, Advance, 1);
- GlyphOriginY := 1;
- end;
- end;
-
- // Create new Entry for Char
- tsChar := TtsChar.Create(CharCode);
- tsChar.GlyphOriginX := GlyphOriginX;
- tsChar.GlyphOriginY := GlyphOriginY;
- tsChar.Advance := Advance;
- tsChar.GlyphRect.Left := 0;
- tsChar.GlyphRect.Top := 0;
- tsChar.GlyphRect.Right := CharImage.Width;
- tsChar.GlyphRect.Bottom := CharImage.Height;
-
- AddChar(CharCode, tsChar);
-
- if fRenderer.SaveImages then begin
- try
- // apply underline style
- if tsStyleUnderline in Style then
- DrawLine(tsChar, CharImage, UnderlinePosition, UnderlineSize);
-
- // apply strikeout stlye
- if tsStyleStrikeout in Style then
- DrawLine(tsChar, CharImage, StrikeoutPosition, StrikeoutSize);
- except
- CharImage.FillColor(1, 0, 0, 0, TS_CHANNELS_RGB, cModesNormal);
- end;
-
- // PostProcessing
- DoPostProcess(CharImage, tsChar);
-
- // Add invisible border for resizing (at last before adding)
- if AddResizingBorder then begin
- tsChar.HasResizingBorder := True;
-
- CharImage.AddResizingBorder(tsChar);
- end;
-
- // Add Image to Renderer
- tsChar.RendererImageReference := fRenderer.AddImage(tsChar, CharImage);
- end;
- finally
- FreeAndNil(CharImage);
- end;
- end;
- end;
- end;
-end;
-
-
-function TtsFontCreator.AddPostProcessStep(PostProcessStep: TtsPostProcessStep): TtsPostProcessStep;
-begin
- Result := PostProcessStep;
-
- fPostProcessSteps.Add(PostProcessStep);
-end;
-
-
-procedure TtsFontCreator.ClearPostProcessSteps;
-var
- Idx: Integer;
-begin
- for Idx := fPostProcessSteps.Count -1 downto 0 do
- DeletePostProcessStep(Idx);
-
- fPostProcessSteps.Clear;
-end;
-
-
-constructor TtsFontCreator.Create(Renderer: TtsRenderer; Size: Integer; Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
-begin
- inherited Create(Renderer, Size, Style, Format, AntiAliasing);
-
- fCreateChars := True;
-
- fPostProcessSteps := TList.Create;
-end;
-
-
-procedure TtsFontCreator.DeletePostProcessStep(Index: Integer);
-var
- Entry: TtsPostProcessStep;
-begin
- if (Index >= 0) and (Index < fPostProcessSteps.Count) then begin
- Entry := fPostProcessSteps[Index];
- Entry.Free;
-
- fPostProcessSteps.Delete(Index);
- end;
-end;
-
-
-destructor TtsFontCreator.Destroy;
-begin
- if fPostProcessSteps <> nil then begin
- ClearPostProcessSteps;
- FreeAndNil(fPostProcessSteps);
- end;
-
- inherited;
-end;
-
-
-procedure TtsFontCreator.DoPostProcess(var CharImage: TtsImage; const tsChar: TtsChar);
-var
- Idx: Integer;
- Entry: TtsPostProcessStep;
-begin
- if not CharImage.Empty then begin
- for Idx := 0 to fPostProcessSteps.Count - 1 do begin
- Entry := fPostProcessSteps[Idx];
-
- if Entry.IsInRange(tsChar.CharCode) then
- Entry.PostProcess(CharImage, tsChar);
- end;
- end;
-end;
-
-
-procedure TtsFontCreator.DrawLine(Char: TtsChar; CharImage: TtsImage; LinePosition, LineSize: Integer);
-var
- NewWidth, NewHeight, NewPosX, NewPosY, YOffset, Idx: Integer;
-
-
- procedure FillLine(pPix: ptsColor);
- var
- Idx: Integer;
- begin
- Idx := NewWidth;
- while Idx > 0 do begin
- pPix^.Red := $FF;
- pPix^.Green := $FF;
- pPix^.Blue := $FF;
- pPix^.Alpha := $FF;
-
- Inc(pPix);
- Dec(Idx);
- end;
- end;
-
-begin
- if LineSize <= 0 then
- Exit;
-
- LinePosition := LinePosition - LineSize;
-
- // calculate width and height
- NewWidth := CharImage.Width;
- NewPosX := 0;
- NewHeight := CharImage.Height;
- NewPosY := 0;
-
- // expand image to the full advance
- if Char.Advance > CharImage.Width then
- NewWidth := Char.Advance;
-
- // add glyph position to image width and set position
- if Char.GlyphOriginX > Char.GlyphRect.Left then begin
- NewWidth := NewWidth + Char.GlyphOriginX;
- NewPosX := Char.GlyphOriginX;
- end;
-
- if Char.GlyphOriginX < 0 then
- NewWidth := NewWidth - Char.GlyphOriginX;
-
- // line is under the image
- if LinePosition < (Char.GlyphOriginY - CharImage.Height) then
- NewHeight := NewHeight + (Char.GlyphOriginY - CharImage.Height - LinePosition);
-
- // line is above the image
- if LinePosition + LineSize > Char.GlyphOriginY then begin
- NewPosY := ((LinePosition + LineSize) - Char.GlyphOriginY);
- NewHeight := NewHeight + NewPosY;
- end;
-
- // resize
- CharImage.Resize(NewWidth, NewHeight, NewPosX, NewPosY);
-
- // draw lines
- YOffset := (Char.GlyphOriginY + NewPosY) - LinePosition;
- for Idx := 1 to LineSize do
- FillLine(CharImage.ScanLine[YOffset - Idx]);
-
- // move glyph rect
- Char.GlyphRect.Left := Char.GlyphRect.Left + NewPosX;
- Char.GlyphRect.Right := Char.GlyphRect.Right + NewPosX;
- Char.GlyphRect.Top := Char.GlyphRect.Top + NewPosY;
- Char.GlyphRect.Bottom := Char.GlyphRect.Bottom + NewPosY;
-end;
-
-
-function TtsFontCreator.GetPostProcessStep(Index: Integer): TtsPostProcessStep;
-begin
- if (Index >= 0) and (Index < fPostProcessSteps.Count) then
- Result := TtsPostProcessStep(fPostProcessSteps[Index])
- else
- Result := nil;
-end;
-
-
-function TtsFontCreator.GetPostProcessStepCount: Integer;
-begin
- Result := fPostProcessSteps.Count;
-end;
-
-
-function TtsFontCreator.Validate(CharCode: WideChar): Boolean;
-begin
- Result := Inherited Validate(CharCode);
-
- // if char wasnt found then create it.
- if not Result then begin
- AddChar(CharCode);
-
- // and test for creation
- Result := Inherited Validate(CharCode);
- end;
-end;
-
-
-{ TtsPostProcessStep }
-
-procedure TtsPostProcessStep.AddUsageChars(Usage: TtsFontProcessStepUsage; Chars: pWideChar);
-begin
- if Chars <> nil then
- while Chars^ <> #0 do begin
- AddUsageRange(Usage, Chars^, Chars^);
-
- Inc(Chars);
- end;
-end;
-
-
-procedure TtsPostProcessStep.AddUsageRange(Usage: TtsFontProcessStepUsage;
- StartChar, EndChar: WideChar);
-var
- pItem: PtsPostProcessStepRange;
-begin
- New(pItem);
-
- pItem^.StartChar := StartChar;
- pItem^.EndChar := EndChar;
-
- case Usage of
- tsUInclude:
- fIncludeCharRange.Add(pItem);
- tsUExclude:
- fExcludeCharRange.Add(pItem);
- end;
-end;
-
-
-procedure TtsPostProcessStep.ClearExcludeRange;
-begin
- ClearList(fExcludeCharRange);
-end;
-
-
-procedure TtsPostProcessStep.ClearIncludeRange;
-begin
- ClearList(fIncludeCharRange);
-end;
-
-
-procedure TtsPostProcessStep.ClearList(List: TList);
-var
- Idx: Integer;
- pItem: PtsPostProcessStepRange;
-begin
- for Idx := 0 to List.Count - 1 do begin
- pItem := List[Idx];
- Dispose(pItem);
- end;
-
- List.Clear;
-end;
-
-
-constructor TtsPostProcessStep.Create;
-begin
- inherited Create;
-
- fIncludeCharRange := TList.Create;
- fExcludeCharRange := TList.Create;
-end;
-
-
-destructor TtsPostProcessStep.Destroy;
-begin
- ClearIncludeRange;
- ClearExcludeRange;
-
- fIncludeCharRange.Free;
- fExcludeCharRange.Free;
-
- inherited;
-end;
-
-
-function TtsPostProcessStep.IsInRange(CharCode: WideChar): Boolean;
-var
- Idx: Integer;
- pItem: PtsPostProcessStepRange;
-begin
- // Look in include range
- if fIncludeCharRange.Count <> 0 then begin
- Result := False;
-
- for Idx := 0 to fIncludeCharRange.Count - 1 do begin
- pItem := fIncludeCharRange[Idx];
-
- if (CharCode >= pItem^.StartChar) and (CharCode <= pItem^.EndChar) then begin
- Result := True;
- Break;
- end;
- end;
- end else
- Result := True;
-
- // Look in exclude range but only if its included
- if Result then begin
- for Idx := 0 to fExcludeCharRange.Count - 1 do begin
- pItem := fExcludeCharRange[Idx];
-
- if (CharCode >= pItem^.StartChar) and (CharCode <= pItem^.EndChar) then begin
- Result := False;
- Break;
- end;
- end;
- end;
-end;
-
-
-{ TtsFontCreatorSDL }
-
-constructor TtsFontCreatorSDL.Create(Renderer: TtsRenderer; const Filename: AnsiString; Size: Integer;
- Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
-var
- TempStyle: Integer;
-begin
- inherited Create(Renderer, Size, Style, Format, AntiAliasing);
-
- // Init SDL_ttf
- if (TTF_WasInit = 0) then
- if (TTF_Init < 0) then
- raise Exception.Create('TtsFontCreator.Create: TTF_Init error');
-
- // Create FFT_Font
- fSDLFont := TTF_OpenFont(pAnsiChar(Filename), Size);
-
- // Getting style - SDL_ttf dosn't support it. so we only have normal
- fFontFileStyle := TS_STYLE_NORMAL;
-
- // getting props
- Ascent := TTF_FontAscent(fSDLFont);
- Descent := -TTF_FontDescent(fSDLFont);
- ExternalLeading := TTF_FontLineSkip(fSDLFont) - (Ascent + Descent);
-
- // SDL_ttf dosn't support it so we must calculate it by our self
- UnderlinePosition := - round(Ascent / 8);
- if UnderlinePosition > -1 then
- UnderlinePosition := -1;
-
- if tsStyleBold in Style then
- UnderlineSize := round(Ascent / 8)
- else
- UnderlineSize := round(Ascent / 13);
- if UnderlineSize < 1 then
- UnderlineSize := 1;
-
- StrikeoutPosition := round(Ascent / 3.5);
- if tsStyleBold in Style then
- StrikeoutSize := round(Ascent / 14)
- else
- StrikeoutSize := round(Ascent / 19);
- if StrikeoutSize < 1 then
- StrikeoutSize := 1;
-
- FixedWidth := TTF_FontFaceIsFixedWidth(fSDLFont) > 0;
-
- Copyright := '';
- FaceName := TTF_FontFaceFamilyName(fSDLFont);
- StyleName := TTF_FontFaceStyleName(fSDLFont);
- FullName := FaceName + #32 + StyleName;
-
- // Set style
- TempStyle := 0;
-
- if tsStyleBold in Style then
- TempStyle := TempStyle or TTF_STYLE_BOLD;
- if tsStyleItalic in Style then
- TempStyle := TempStyle or TTF_STYLE_ITALIC;
-// if tsStyleUnderline in Style then
-// TempStyle := TempStyle or TTF_STYLE_UNDERLINE;
-
- TTF_SetFontStyle(fSDLFont, TempStyle);
-end;
-
-
-destructor TtsFontCreatorSDL.Destroy;
-begin
- // Destroy Font
- TTF_CloseFont(fSDLFont);
- fSDLFont := nil;
-
- inherited;
-end;
-
-
-procedure TtsFontCreatorSDL.GetCharImage(CharCode: WideChar; const CharImage: TtsImage);
-const
- WHITE: TSDL_Color = (r: $FF; g: $FF; b: $FF; unused: 0);
- BLACK: TSDL_Color = (r: $00; g: $00; b: $00; unused: 0);
-
-var
- CharSurface: PSDL_Surface;
-
- X, Y, TempWidth: Integer;
- pSource: pByte;
- pDest: PtsColor;
-
-
- function GetPaletteEntry(Index: Byte): Byte;
- begin
- Result := 0;
-
- with CharSurface^.format^ do begin
- if palette <> nil then
- if (palette^.ncolors > 0) and (Index < palette^.ncolors) then
- Result := palette^.colors[Index].r
- end;
- end;
-
-
-begin
- //CharCode: Needs to use an widestring because of #0 endchar
-
- case AntiAliasing of
- tsAANone:
- CharSurface := TTF_RenderGlyph_Solid(fSDLFont, Ord(CharCode), WHITE);
- tsAANormal:
- CharSurface := TTF_RenderGlyph_Shaded(fSDLFont, Ord(CharCode), WHITE, BLACK);
- end;
-
-
- if CharSurface <> nil then
- try
- CharImage.CreateEmpty(fFormat, CharSurface^.Width, CharSurface^.Height);
- try
- TempWidth := CharSurface^.Width;
- if TempWidth mod 4 > 0 then
- TempWidth := (TempWidth div 4 + 1) * 4;
-
- for Y := 0 to CharSurface^.Height - 1 do begin
- pDest := CharImage.ScanLine[Y];
- pSource := CharSurface^.Pixels;
- Inc(pSource, Y * TempWidth);
-
- for X := 0 to CharSurface^.Width - 1 do begin
- pDest^.Red := $FF;
- pDest^.Green := $FF;
- pDest^.Blue := $FF;
- pDest^.Alpha := GetPaletteEntry(pSource^);
-
- Inc(pSource);
- Inc(pDest);
- end;
- end;
- except
- CharImage.Free;
- end;
- finally
- SDL_FreeSurface(CharSurface);
- end;
-end;
-
-
-function TtsFontCreatorSDL.GetGlyphMetrics(CharCode: WideChar; var GlyphOriginX, GlyphOriginY, GlyphWidth, GlyphHeight, Advance: Integer): Boolean;
-var
- MinX, MaxX, MinY, MaxY: Integer;
-begin
- if fSDLFont <> nil then begin
- Result := TTF_GlyphMetrics(fSDLFont, Ord(CharCode), MinX, MaxX, MinY, MaxY, Advance) = 0;
- GlyphWidth := MaxX - MinX;
- GlyphHeight := MaxY - MinY;
-
- GlyphOriginX := MinX;
- GlyphOriginY := GlyphHeight + MinY;
- end
-
- else
- Result := False;
-end;
-
-
-{ TtsFontCreatorGDIFontFace }
-
-constructor TtsFontCreatorGDIFontFace.Create(Renderer: TtsRenderer; const Fontname: AnsiString;
- Size: Integer; Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
-var
- Idx: Integer;
- LogFont: TLogFontA;
-
- DC: HDC;
-
- TableName: Cardinal;
- Buffer: Pointer;
- BufferSize: Cardinal;
- Lang: AnsiString;
-
- TextMetric: TTextMetricW;
- OutTextMetric: TOutlineTextmetricW;
-begin
- inherited Create (Renderer, Size, Style, Format, AntiAliasing);
-
- // setting up matrix
- FillChar(fMat2, SizeOf(TMat2), $00);
-
- fMat2.eM11.Value := 1;
- fMat2.eM22.Value := 1;
-
- fFontname := Fontname;
-
- // Creating Font
- FillChar(LogFont, SizeOf(LogFont), 0);
-
- // name
- fFontname := Fontname;
- for Idx := 1 to min(Length(Fontname), Length(LogFont.lfFaceName)) do
- LogFont.lfFaceName[Idx -1] := Fontname[Idx];
-
- // char set
- LogFont.lfCharSet := DEFAULT_CHARSET;
-
- // size
-// fPointSize := PointSize;
- LogFont.lfHeight := -Size; //-MulDiv(PointSize, GetDeviceCaps(Temp.Canvas.Handle, LOGPIXELSY), 72);
-
- // style
- if tsStyleBold in Style then
- LogFont.lfWeight := FW_BOLD
- else
- LogFont.lfWeight := FW_NORMAL;
-
- if tsStyleItalic in Style then
- LogFont.lfItalic := 1;
-
- if tsStyleUnderline in Style then
- LogFont.lfUnderline := 1;
-
- // smooth
- case AntiAliasing of
- tsAANone:
- LogFont.lfQuality := NONANTIALIASED_QUALITY;
- tsAANormal:
- LogFont.lfQuality := ANTIALIASED_QUALITY;
-// tsSmoothSmooth:
-// begin
-// if Smooth = tsSmoothSmooth then
-// fMat2.eM11.Value := 3;
-// end;
- end;
-
- // create font
- fFontHandle := CreateFontIndirectA(LogFont);
-
- // Getting informations about font
- DC := CreateCompatibleDC(0);
- try
- SelectObject(DC, fFontHandle);
-
- // find strings in text
- TableName := MakeTTTableName('n', 'a', 'm', 'e');
- BufferSize := GetFontData(DC, TableName, 0, nil, 0);
-
- if BufferSize <> GDI_ERROR then begin
- GetMem(Buffer, BufferSize);
- try
- if GetFontData(DC, TableName, 0, Buffer, BufferSize) <> GDI_ERROR then begin
- SetLength(Lang, 4);
- GetLocaleInfoA(LOCALE_USER_DEFAULT, LOCALE_ILANGUAGE, @Lang[1], 4);
-
- GetTTString(Buffer, BufferSize, NAME_ID_COPYRIGHT, StrToInt('$' + String(Lang)), fCopyright);
- GetTTString(Buffer, BufferSize, NAME_ID_FACE_NAME, StrToInt('$' + String(Lang)), fFaceName);
- GetTTString(Buffer, BufferSize, NAME_ID_STYLE_NAME, StrToInt('$' + String(Lang)), fStyleName);
- GetTTString(Buffer, BufferSize, NAME_ID_FULL_NAME, StrToInt('$' + String(Lang)), fFullName);
- end;
- finally
- FreeMem(Buffer);
- end;
- end;
-
- // Text Metric
- GetTextMetricsW(DC, TextMetric);
-
- Ascent := TextMetric.tmAscent;
- Descent := TextMetric.tmDescent;
- ExternalLeading := TextMetric.tmExternalLeading;
-
- DefaultChar := TextMetric.tmDefaultChar;
-
- // inverse logic of the bit. clear then fixed pitch
- FixedWidth := TextMetric.tmPitchAndFamily and TMPF_FIXED_PITCH = 0;
-
- // style
- FontFileStyle := TS_STYLE_NORMAL;
-
- if TextMetric.tmWeight > 400 then
- FontFileStyle := FontFileStyle or TS_STYLE_BOLD;
-
- if TextMetric.tmItalic > 0 then
- FontFileStyle := FontFileStyle or TS_STYLE_ITALIC;
-
- if TextMetric.tmUnderlined > 0 then
- FontFileStyle := FontFileStyle or TS_STYLE_UNDERLINE;
-
- if TextMetric.tmStruckOut > 0 then
- FontFileStyle := FontFileStyle or TS_STYLE_STRIKEOUT;
-
- // Outline Text Metric
- GetOutlineTextMetricsW(DC, SizeOf(OutTextMetric), OutTextMetric);
-
- UnderlinePosition := OutTextMetric.otmsUnderscorePosition;
- UnderlineSize := OutTextMetric.otmsUnderscoreSize;
- if UnderlineSize < 1 then
- UnderlineSize := 1;
-
- StrikeoutPosition := OutTextMetric.otmsStrikeoutPosition;
- StrikeoutSize := OutTextMetric.otmsStrikeoutSize;
- if StrikeoutSize < 1 then
- StrikeoutSize := 1;
- finally
- DeleteDC(DC);
- end;
-end;
-
-
-destructor TtsFontCreatorGDIFontFace.Destroy;
-begin
- DeleteObject(fFontHandle);
-
- inherited;
-end;
-
-
-procedure TtsFontCreatorGDIFontFace.GetCharImage(CharCode: WideChar; const CharImage: TtsImage);
-var
- DC: HDC;
-begin
- DC := CreateCompatibleDC(0);
- try
- SelectObject(DC, fFontHandle);
-
- case AntiAliasing of
- tsAANone:
- GetCharImageNone(DC, CharCode, CharImage);
- tsAANormal:
- GetCharImageAntialiased(DC, CharCode, CharImage);
- end;
- finally
- DeleteDC(DC);
- end;
-end;
-
-
-procedure TtsFontCreatorGDIFontFace.GetCharImageAntialiased(DC: HDC; CharCode: WideChar; const CharImage: TtsImage);
-var
- Metric: TGlyphMetrics;
- pBuffer: Pointer;
- Size, OutlineResult: Cardinal;
- GlyphIndex: Integer;
- X, Y, Height, Width, Spacer: Integer;
- pDest: PtsColor;
- pSrc: pByte;
-
-
- procedure CopyPixel;
- var
- Idx: Integer;
- Temp, Count: Cardinal;
- begin
- Count := Min(X, fMat2.eM11.Value);
-
- Temp := 0;
- for Idx := 0 to Count -1 do begin
- Temp := Temp + pSrc^;
- Inc(pSrc);
- end;
-
- Dec(X, Count);
-
- pDest^.Red := $FF;
- pDest^.Green := $FF;
- pDest^.Blue := $FF;
- pDest^.Alpha := $FF * Temp div ($40 * Cardinal(fMat2.eM11.Value));
-
- Inc(pDest);
- end;
-
-
-begin
- FillChar(Metric, SizeOf(TGlyphMetrics), $00);
-
- // Translate Glyphindex
- GlyphIndex := GetGlyphIndex(CharCode);
-
- // size
-// if GlyphIndex <> 0 then
- Size := GetGlyphOutlineA(DC, GlyphIndex, GGO_GRAY8_BITMAP or GGO_GLYPH_INDEX, @Metric, 0, nil, @fMat2);
-// else
-// Size := GetGlyphOutlineA(DC, Ord(fDefaultChar), GGO_GRAY8_BITMAP, Metric, 0, nil, fMat2);
-
- if (Size <> GDI_ERROR) and (Size <> 0) then begin
- GetMem(pBuffer, Size);
- try
- // glyphdata
-// if GlyphIndex <> 0 then
- OutlineResult := GetGlyphOutlineA(DC, GlyphIndex, GGO_GRAY8_BITMAP or GGO_GLYPH_INDEX, @Metric, Size, pBuffer, @fMat2);
-// else
-// OutlineResult := GetGlyphOutlineA(DC, Ord(fDefaultChar), GGO_GRAY8_BITMAP, Metric, Size, pBuffer, fMat2);
-
- if OutlineResult <> GDI_ERROR then begin
- // Image size
- Height := Metric.gmBlackBoxY;
- Width := Integer(Metric.gmBlackBoxX) div fMat2.eM11.Value;
- if (Integer(Metric.gmBlackBoxX) mod fMat2.eM11.Value) <> 0 then
- Width := Width + fMat2.eM11.Value - (Integer(Metric.gmBlackBoxX) mod fMat2.eM11.Value);
-
- // spacer
- if (Metric.gmBlackBoxX mod 4) <> 0 then
- Spacer := 4 - (Metric.gmBlackBoxX mod 4)
- else
- Spacer := 0;
-
- // copy image
- if (Height > 0) and (Width > 0) then begin
- CharImage.CreateEmpty(fFormat, Width, Height);
-
- pSrc := pBuffer;
-
- for Y := 0 to Height -1 do begin
- pDest := CharImage.ScanLine[Y];
-
- X := Metric.gmBlackBoxX;
- while X > 0 do
- CopyPixel;
-
- if Spacer <> 0 then
- Inc(pSrc, Spacer);
- end;
- end;
- end;
- finally
- FreeMem(pBuffer);
- end;
- end;
-end;
-
-
-procedure TtsFontCreatorGDIFontFace.GetCharImageNone(DC: HDC; CharCode: WideChar; const CharImage: TtsImage);
-var
- Metric: TGlyphMetrics;
- pBuffer: Pointer;
- Size, OutlineResult: Cardinal;
- GlyphIndex: Integer;
- X, Y, Height, Width, SourceX, SourceWidth: Integer;
- pDest: PtsColor;
- pSrc: pByte;
-
-
- procedure ExpandByte;
- var
- Idx, Count, SourceCount: Integer;
- begin
- SourceCount := Min(8, SourceX);
- Count := Min(8, X);
-
- for Idx := 1 to Count do begin
- pDest^.Red := $FF;
- pDest^.Green := $FF;
- pDest^.Blue := $FF;
-
- if (pSrc^ and $80) > 0 then
- pDest^.Alpha := $FF
- else
- pDest^.Alpha := $00;
-
- pSrc^ := (pSrc^ and not $80) shl 1;
-
- Inc(pDest);
- end;
-
- Dec(SourceX, SourceCount);
- Dec(X, Count);
- end;
-
-
-begin
- // fMat2.eM11.Value must be 1
- Assert(fMat2.eM11.Value = 1);
-
- FillChar(Metric, SizeOf(TGlyphMetrics), $00);
-
- // Translate Glyphindex
- GlyphIndex := GetGlyphIndex(CharCode);
-
- // size
-// if GlyphIndex <> 0 then
- Size := GetGlyphOutlineA(DC, GlyphIndex, GGO_BITMAP or GGO_GLYPH_INDEX, @Metric, 0, nil, @fMat2);
-// else
-// Size := GetGlyphOutlineA(DC, Ord(fDefaultChar), GGO_BITMAP, Metric, 0, nil, fMat2);
-
- if (Size <> GDI_ERROR) and (Size <> 0) then begin
- GetMem(pBuffer, Size);
- try
- // glyphdata
-// if GlyphIndex <> 0 then
- OutlineResult := GetGlyphOutlineA(DC, GlyphIndex, GGO_BITMAP or GGO_GLYPH_INDEX, @Metric, Size, pBuffer, @fMat2);
-// else
-// OutlineResult := GetGlyphOutlineA(DC, Ord(fDefaultChar), GGO_BITMAP, Metric, Size, pBuffer, fMat2);
-
- if OutlineResult <> GDI_ERROR then begin
- SourceWidth := (Size div Metric.gmBlackBoxY) * 8;
- Width := Metric.gmBlackBoxX;
- Height := Metric.gmBlackBoxY;
-
- // copy image
- if (Height > 0) and (Width > 0) then begin
- CharImage.CreateEmpty(tsFormatRGBA8, Width, Height);
-
- pSrc := pBuffer;
-
- for Y := 0 to Height -1 do begin
- pDest := CharImage.ScanLine[Y];
-
- // copy data
- SourceX := SourceWidth;
- X := Width;
- while SourceX > 0 do begin
- ExpandByte;
-
- Inc(pSrc);
- end;
- end;
- end;
- end;
- finally
- FreeMem(pBuffer);
- end;
- end;
-end;
-
-
-function TtsFontCreatorGDIFontFace.GetGlyphIndex(CharCode: WideChar): Integer;
-var
-// ReadRawData: Boolean;
- DC: HDC;
- GCPRes: TGCPResultsW;
-begin
- Result := 0;
-
-// ReadRawData := True;
-
- DC := CreateCompatibleDC(0);
- try
- SelectObject(DC, fFontHandle);
-
- // windows nt
- if Addr(GetCharacterPlacementW) <> nil then begin
- FillChar(GCPRes, SizeOf(GCPRes), 0);
- GetMem(GCPRes.lpGlyphs, SizeOf(Cardinal));
- try
- GCPRes.lStructSize := SizeOf(GCPRes);
- GCPRes.lpGlyphs^ := 0;
- GCPRes.nGlyphs := 1;
-
- if GetCharacterPlacementW(DC, @CharCode, 1, GCP_MAXEXTENT, @GCPRes, 0) <> GDI_ERROR then begin
- if (GCPRes.nGlyphs = 1) and (GCPRes.lpGlyphs <> nil) then begin
- Result := GCPRes.lpGlyphs^;
-
-// ReadRawData := False;
- end;
- end;
- finally
- FreeMem(GCPRes.lpGlyphs);
- end;
- end;
-
- // windows 9x workaround
-// ReadRawData := True;
-
-// if ReadRawData then begin
-// if GetTTUnicodeCharCount(DC) > 0 then
-// Result := GetTTUnicodeGlyphIndex(DC, Ord(CharCode));
-// end;
- finally
- DeleteDC(DC);
- end;
-end;
-
-
-function TtsFontCreatorGDIFontFace.GetGlyphMetrics(CharCode: WideChar; var GlyphOriginX, GlyphOriginY, GlyphWidth, GlyphHeight, Advance: Integer): Boolean;
-var
- DC: HDC;
- Metric: TGlyphMetrics;
- Size: Cardinal;
- GlyphIndex: Integer;
-begin
- Result := False;
-
- // Set values to 0
- GlyphOriginX := 0;
- GlyphOriginY := 0;
- GlyphWidth := 0;
- GlyphHeight := 0;
- Advance := 0;
-
- // Translate Glyphindex
- GlyphIndex := GetGlyphIndex(CharCode);
-
- DC := CreateCompatibleDC(0);
- try
- SelectObject(DC, fFontHandle);
-
- // get value of resulting bitmaps
- case AntiAliasing of
- tsAANone: begin
-// if GlyphIndex <> 0 then
- Size := GetGlyphOutlineA(DC, GlyphIndex, GGO_BITMAP or GGO_GLYPH_INDEX, @Metric, 0, nil, @fMat2);
-// else
-// Size := GetGlyphOutlineA(DC, Ord(fDefaultChar), GGO_BITMAP, Metric, 0, nil, fMat2);
- end;
- tsAANormal: begin
-// if GlyphIndex <> 0 then
- Size := GetGlyphOutlineA(DC, GlyphIndex, GGO_GRAY8_BITMAP or GGO_GLYPH_INDEX, @Metric, 0, nil, @fMat2);
-// else
-// Size := GetGlyphOutlineA(DC, Ord(fDefaultChar), GGO_GRAY8_BITMAP, Metric, 0, nil, fMat2);
- end;
- else
- Size := 0;
- end;
-
- // dosn't work so get metric value
- if (Size = GDI_ERROR) or (Size = 0) then begin
-// if GlyphIndex <> 0 then
- Size := GetGlyphOutlineA(DC, GlyphIndex, GGO_METRICS or GGO_GLYPH_INDEX, @Metric, 0, nil, @fMat2);
-// else
-// Size := GetGlyphOutlineA(DC, Ord(fDefaultChar), GGO_METRICS, Metric, 0, nil, fMat2);
- end;
-
- // we have values?
- if (Size <> GDI_ERROR) and (Size > 0) then begin
- GlyphOriginX := Round(Metric.gmptGlyphOrigin.X / fMat2.eM11.value);
- GlyphOriginY := Metric.gmptGlyphOrigin.Y;
- GlyphWidth := Round(Metric.gmBlackBoxX / fMat2.eM11.value);
- GlyphHeight := Metric.gmBlackBoxY;
-
- Advance := Round(Metric.gmCellIncX / fMat2.eM11.value);
-
- Result := True;
- end;
- finally
- DeleteDC(DC)
- end;
-end;
-
-
-{ TtsFontCreatorGDIFile }
-
-constructor TtsFontCreatorGDIFile.Create(Renderer: TtsRenderer; const Filename: AnsiString;
- Size: Integer; Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
-var
- FaceName: AnsiString;
-begin
- // filename
- fFileName := StrNew(pAnsiChar(Filename));
-
- fFontRegistred := false;
- FaceName := '';
-
- if GetFaceName(fFilename, FaceName) then
- fFontRegistred := RegisterFont(fFilename, False);
-
- // inherited
- inherited Create(Renderer, FaceName, Size, Style, Format, AntiAliasing);
-end;
-
-
-destructor TtsFontCreatorGDIFile.Destroy;
-begin
- inherited;
-
- // unregister font
- if fFontRegistred then
- UnRegisterFont(fFilename, False);
-
- StrDispose(fFileName);
-end;
-
-
-function TtsFontCreatorGDIFile.GetFaceName(Filename: PAnsiChar; var Face: AnsiString): boolean;
-var
- Lang: AnsiString;
-begin
- SetLength(Lang, 4);
- GetLocaleInfoA(LOCALE_USER_DEFAULT, LOCALE_ILANGUAGE, @Lang[1], 4);
-
- Face := GetTTFontFullNameFromFile(Filename, StrToInt('$' + String(Lang)));
-
- Result := Face <> '';
-end;
-
-
-function TtsFontCreatorGDIFile.RegisterFont(Filename: pAnsiChar; RegisterPublic: Boolean): boolean;
-var
- Flags: Cardinal;
-begin
- Result := False;
-
- // Flags
- if not RegisterPublic then
- Flags := FR_PRIVATE or FR_NOT_ENUM
- else
- Flags := 0;
-
- // AddFontResource
- if Addr(AddFontResourceExA) <> nil then
- Result := AddFontResourceExA(FileName, Flags, nil) > 0
- else
-
- if Addr(AddFontResourceA) <> nil then
- Result := AddFontResourceA(FileName) > 0;
-end;
-
-
-function TtsFontCreatorGDIFile.UnRegisterFont(Filename: pAnsiChar; RegisterPublic: Boolean): boolean;
-var
- Flags: Cardinal;
-begin
- Result := False;
-
- // Flags
- if not RegisterPublic then
- Flags := FR_PRIVATE or FR_NOT_ENUM
- else
- Flags := 0;
-
- // RemoveFontResource
- if Addr(RemoveFontResourceExA) <> nil then
- Result := RemoveFontResourceExA(FileName, Flags, nil)
- else
-
- if Addr(RemoveFontResourceA) <> nil then
- Result := RemoveFontResourceA(FileName);
-end;
-
-{ TtsFontCreatorGDIFile }
-
-constructor TtsFontCreatorGDIStream.Create(Renderer: TtsRenderer; const Source: TStream;
- Size: Integer; Style: TtsFontStyles; Format: TtsFormat; AntiAliasing: TtsAntiAliasing);
-var
- FaceName: AnsiString;
-begin
- fFontRegistred := false;
- FaceName := '';
-
- if GetFaceName(Source, FaceName) then
- fFontRegistred := RegisterFont(Source);
-
- // inherited
- inherited Create(Renderer, FaceName, Size, Style, Format, AntiAliasing);
-end;
-
-
-destructor TtsFontCreatorGDIStream.Destroy;
-begin
- inherited;
-
- // unregister font
- if fFontRegistred then
- UnRegisterFont();
-end;
-
-
-function TtsFontCreatorGDIStream.GetFaceName(Stream: TStream; var Face: AnsiString): boolean;
-var
- Lang: AnsiString;
-begin
- SetLength(Lang, 4);
- GetLocaleInfoA(LOCALE_USER_DEFAULT, LOCALE_ILANGUAGE, @Lang[1], 4);
-
- Face := GetTTFontFullNameFromStream(Stream, StrToInt('$' + String(Lang)));
-
- Result := Face <> '';
-end;
-
-
-function TtsFontCreatorGDIStream.RegisterFont(Data: TStream): boolean;
-var
- ms: TMemoryStream;
- cnt: DWORD;
-begin
- Result := False;
- fHandle := 0;
-
- ms:= TMemoryStream.Create;
- try
- ms.CopyFrom(Data, 0);
- if Addr(AddFontMemResourceEx)<>nil then
- fHandle:= AddFontMemResourceEx(ms.Memory, ms.Size, nil, @cnt);
- Result:= fHandle > 0;
- finally
- ms.Free;
- end;
-end;
-
-
-function TtsFontCreatorGDIStream.UnRegisterFont(): boolean;
-begin
- Result := RemoveFontMemResourceEx(fHandle);
-end;
-
-{ TtsRenderer }
-
-procedure TtsRenderer.BeginBlock(Left, Top, Width, Height: Integer; Flags: tsBitmask);
-begin
- fisBlock := True;
-
- fBlockLeft := Left;
- fBlockTop := Top;
- fBlockWidth := Width;
- fBlockHeight := Height;
- fFlags := Flags;
-
- fWordWrap := fFlags and TS_BLOCKFLAG_WORD_WRAP = TS_BLOCKFLAG_WORD_WRAP;
-// fSingleLine := fFlags and TS_BLOCKFLAG_SINGLE_LINE = TS_BLOCKFLAG_SINGLE_LINE;
-
- fLineTop := Top + tsGetParameteri(TS_BLOCK_OFFSET_Y);
- fTextOffsetY := 0;
- fTextOffsetX := 0;
-
- with fLinesTemp do begin
- New(Lines);
-
- with Lines^ do begin
- NextLine := nil;
- LineItemFirst := nil;
- LineItemLast := nil;
- LineLength := 0;
- LineAutoBreak := False;
- end;
- Empty := True;
- end;
-
- fLinesFirst := nil;
- fLinesLast := nil;
-
- // if font is active add to list
- if fActiveFont <> nil then
- FontActivate(fActiveFontID);
-end;
-
-
-function TtsRenderer.CalculateLinesHeight(pLinesItem: PtsLinesItem): Integer;
-var
- pLine: PtsLineItem;
- Metric: TtsTextMetric;
-begin
- Result := 0;
-
- while pLinesItem <> nil do begin
- pLine := pLinesItem^.LineItemFirst;
-
- GetLineMetric(pLine, Metric);
- Result := Result + Metric.LineSkip_with_LineSpace;
-
- pLinesItem := pLinesItem^.NextLine;
- end;
-
- // remove last linespace from the lines
- Result := Result - (Metric.LineSkip_with_LineSpace - Metric.LineSkip);
-end;
-
-
-procedure TtsRenderer.CalculateWordLength(Font: TtsFont; pWord: PtsLineItem);
-var
- pTempWord: PWideChar;
- Char: TtsChar;
- CharSpacing: tsInt;
-begin
- if pWord^.ItemType in [TS_BLOCK_WORD, TS_BLOCK_SPACE] then begin
- CharSpacing := fLastActiveFont.CharSpacing;
-
- pTempWord := pWord^.Word;
- pWord^.WordLength := 0;
-
- while pTempWord^ <> #0 do begin
- // normal char
- if Font.Validate(pTempWord^) then
- Char := Font.GetChar(pTempWord^)
- else
-
- // default char
- if Font.Validate(Font.DefaultChar) then
- Char := Font.GetChar(Font.DefaultChar)
- else
- Char := nil;
-
- if Char <> nil then begin
- pWord^.WordLength := pWord^.WordLength + Char.Advance + CharSpacing;
- end;
-
- Inc(pTempWord);
- end;
- end;
-end;
-
-
-procedure TtsRenderer.Color(Red, Green, Blue, Alpha: Single);
-var
- LineItem: PtsLineItem;
-begin
- if isBlock then begin
- New(LineItem);
-
- LineItem^.NextItem := nil;
- LineItem^.PrevItem := nil;
- LineItem^.ItemType := TS_BLOCK_COLOR;
- LineItem^.Red := Red;
- LineItem^.Green := Green;
- LineItem^.Blue := Blue;
- LineItem^.Alpha := Alpha;
-
- PushLineItem(LineItem);
- end else
-
- begin
- DrawSetColor(Red, Green, Blue, Alpha);
- end;
-end;
-
-
-constructor TtsRenderer.Create(Context: TtsContext);
-begin
- inherited Create;
-
- fContext := Context;
-
- fSaveImages := True;
-end;
-
-
-destructor TtsRenderer.Destroy;
-begin
- if isBlock then
- EndBlock;
-
- inherited;
-end;
-
-
-procedure TtsRenderer.DrawLine(pLine: PtsLineItem; LineLength: Integer; LineBreak: Boolean);
-var
- pText: PWideChar;
- Char: TtsChar;
-
- Metric: TtsTextMetric;
-
- TempLeft, Temp: Integer;
- DrawLeft, SpaceTemp: Single;
- DrawAscent, LineSkip: Integer;
-
- DrawText: Boolean;
-
- BlockSpaceCount: Integer;
- BlockSpaceWidth: Single;
-
-
- function CountSpaces(pLine: PtsLineItem): Integer;
- var
- pText: PWideChar;
- begin
- Result := 0;
-
- while pLine <> nil do begin
- case pLine^.ItemType of
- TS_BLOCK_SPACE: begin
- pText := pLine^.Word;
-
- // Enumerate Text
- while pText^ <> #0 do begin
- Inc(Result);
- Inc(pText);
- end;
- end;
- end;
-
- pLine := pLine^.NextItem;
- end;
- end;
-
-
-begin
- if fFlags and TS_BLOCKFLAG_CALC_SIZE > 0 then
- Exit;
-
- BlockSpaceWidth := 0;
- DrawLeft := 0;
- TempLeft := 0;
-
- GetLineMetric(pLine, Metric);
-
- // set drawposition to new baseline
- DrawAscent := fLineTop + fTextOffsetY + Metric.Ascent;
-
- // increment linetop with height of line
- LineSkip := Metric.LineSkip;
- fLineTop := fLineTop + LineSkip;
-
- // clipping
- DrawText := True;
- if fisBlock then begin
- if not (fFlags and TS_BLOCKFLAG_NO_CLIP = TS_BLOCKFLAG_NO_CLIP) then begin
- case tsGetParameteri(TS_CLIP) of
- TS_CLIP_COMPLETE: begin
- if (fLineTop + fTextOffsetY < fBlockTop) or
- ((fLineTop + fTextOffsetY - LineSkip) > (fBlockTop + fBlockHeight)) then
- DrawText := False;
- end;
- TS_CLIP_BORDER: begin
- if ((fLineTop + fTextOffsetY - LineSkip) < fBlockTop) or
- (fLineTop + fTextOffsetY > (fBlockTop + fBlockHeight)) then
- DrawText := False;
- end;
- end;
- end;
- end;
-
- // TextBlock text alignment
- if isBlock then begin
- case tsGetParameteri(TS_ALIGN) of
- TS_ALIGN_CENTER:
- begin
- TempLeft := (fBlockWidth div 2) - (LineLength div 2);
- end;
- TS_ALIGN_RIGHT:
- begin
- TempLeft := fBlockWidth - LineLength;
- end;
- TS_ALIGN_BLOCK: begin
- if LineBreak then begin
- BlockSpaceCount := CountSpaces(pLine);
-
- if BlockSpaceCount > 0 then
- BlockSpaceWidth := (fBlockWidth - LineLength) / BlockSpaceCount;
- end;
- end;
- end;
-
- DrawSetPosition(fBlockLeft + TempLeft, DrawAscent);
- end else
-
- // Normal text alignment
- begin
- case tsGetParameteri(TS_ALIGN) of
- TS_ALIGN_CENTER:
- begin
- TempLeft := - (LineLength div 2);
- end;
- TS_ALIGN_RIGHT:
- begin
- TempLeft := - LineLength;
- end;
- end;
-
- DrawSetPositionRelative(TempLeft, 0);
- end;
-
- DrawSetPositionRelative(tsGetParameteri(TS_BLOCK_OFFSET_X), 0);
-
- // Enumerate LineItems
- while pLine <> nil do begin
- case pLine^.ItemType of
- TS_BLOCK_FONT: begin
- fActiveFont := pLine^.Font;
- fActiveFontID := pLine^.FontID;
- end;
-
- TS_BLOCK_COLOR: begin
- DrawSetColor(pLine^.Red, pLine^.Green, pLine^.Blue, pLine^.Alpha);
- end;
-
- TS_BLOCK_WORD: begin
- if DrawText then begin
- if fActiveFont <> nil then begin
- pText := pLine^.Word;
-
- // Enumerate Text
- while pText^ <> #0 do begin
- // normal char
- if fActiveFont.Validate(pText^) then
- Char := fActiveFont.GetChar(pText^)
- else
-
- // default char
- if fActiveFont.Validate(fActiveFont.DefaultChar) then
- Char := fActiveFont.GetChar(fActiveFont.DefaultChar)
- else
- Char := nil;
-
- if Char <> nil then begin
- DrawSetPositionRelative(Char.GlyphOriginX, -fActiveFont.fBaselineOffset);
- DrawChar(fActiveFont, Char);
- DrawSetPositionRelative(Char.Advance - Char.GlyphOriginX + fActiveFont.CharSpacing, fActiveFont.fBaselineOffset);
- end;
-
- Inc(pText);
- end;
- end;
- end;
- end;
-
- TS_BLOCK_SPACE: begin
- if DrawText then begin
- if fActiveFont <> nil then begin
- pText := pLine^.Word;
-
- // Enumerate Text
- while pText^ <> #0 do begin
- // normal char
- if fActiveFont.Validate(pText^) then
- Char := fActiveFont.GetChar(pText^)
- else
-
- // default char
- if fActiveFont.Validate(fActiveFont.DefaultChar) then
- Char := fActiveFont.GetChar(fActiveFont.DefaultChar)
- else
- Char := nil;
-
- if Char <> nil then begin
- // We have lines so we must repeat the "empty" space
- if (tsStyleUnderline in fActiveFont.Style) or (tsStyleStrikeout in fActiveFont.Style) then begin
- // width we need to draw
- SpaceTemp := Char.Advance + fActiveFont.CharSpacing + BlockSpaceWidth;
- // set the position to the normal end. Following we decrease
- // these value by the width of the drawn chars. So we get the
- // difference of the last drawn space.
- DrawLeft := DrawLeft + Char.Advance + fActiveFont.CharSpacing + BlockSpaceWidth;
-
- Temp := Char.Advance - Char.GlyphOriginX + fActiveFont.CharSpacing;
-
- while SpaceTemp > 0 do begin
- // draw the char
- DrawSetPositionRelative(Char.GlyphOriginX, 0);
- DrawChar(fActiveFont, Char);
- // set the position inside the drawer
- DrawSetPositionRelative(Temp, 0);
-
- // decrease need to draw width
- SpaceTemp := SpaceTemp - Temp;
- // decrease the drawwidth with the width of the char.
- DrawLeft := DrawLeft - Temp;
- end;
- end else
- // no lines so only set the position
- DrawLeft := DrawLeft + Char.Advance + fActiveFont.CharSpacing + BlockSpaceWidth;
- end;
-
- Inc(pText);
- end;
-
- DrawSetPositionRelative(Round(DrawLeft), 0);
- DrawLeft := DrawLeft - Round(DrawLeft);
- end;
- end;
- end;
-
- TS_BLOCK_LINEBREAK: begin
-
- end;
-// TS_BLOCK_TAB: begin
-// case tsGetParameteri(TS_TAB) of
-// TS_TAB_FIXED:
-// begin
-// Temp := tsGetParameteri(TS_TAB_FIXED_WIDTH);
-//
-//// if (DrawLeft - fBlockLeft) mod Temp > 0 then
-// DrawLeft := (Round(DrawLeft) mod Temp) + Temp;
-// end;
-// TS_TAB_ABSOLUTE:
-// begin
-//
-// end;
-// end;
-// end;
- end;
-
- pLine := pLine^.NextItem;
- end;
-end;
-
-
-procedure TtsRenderer.DrawLines(pLinesItem: PtsLinesItem);
-begin
- if fFlags and TS_BLOCKFLAG_CALC_SIZE = 0 then begin
- while pLinesItem <> nil do begin
- DrawLine(pLinesItem^.LineItemFirst, pLinesItem^.LineLength, pLinesItem^.LineAutoBreak);
-
- pLinesItem := pLinesItem^.NextLine;
- end;
- end;
-end;
-
-
-procedure TtsRenderer.EndBlock;
-var
- LinesHeight: Integer;
- VerticalAlign: tsEnum;
-begin
- // if temp line exist then push them
- with fLinesTemp do begin
- if Lines <> nil then
- if Lines^.LineItemFirst <> nil then
- PushTempLines;
-
- FreeLines(Lines);
- end;
-
- // if vertical align isn't top
- VerticalAlign := tsGetParameteri(TS_VALIGN);
- if (VerticalAlign = TS_VALIGN_CENTER) or
- (VerticalAlign = TS_VALIGN_BOTTOM) then begin
- // calculating height
- LinesHeight := CalculateLinesHeight(fLinesFirst);
-
- // setting offset
- case VerticalAlign of
- TS_VALIGN_CENTER:
- fTextOffsetY := fTextOffsetY + (fBlockHeight div 2 - LinesHeight div 2);
- TS_VALIGN_BOTTOM:
- fTextOffsetY := fTextOffsetY + (fBlockHeight - LinesHeight);
- end;
-
- // drawing lines
- DrawLines(fLinesFirst);
- end;
-
- // Free all lines
- FreeLines(fLinesFirst);
- fLinesLast := nil;
-
- fisBlock := False;
-end;
-
-
-procedure TtsRenderer.FontActivate(FontID: Cardinal);
-var
- pLine: PtsLineItem;
-begin
- if FontID <> 0 then begin
- fLastActiveFont := fContext.FontGet(FontID);
- fLastActiveFontID := FontID;
- end else
- fLastActiveFont := nil;
-
- // if in block then add blockitem
- if isBlock then begin
- New(pLine);
-
- pLine^.NextItem := nil;
- pLine^.PrevItem := nil;
- pLine^.ItemType := TS_BLOCK_FONT;
- pLine^.FontID := FontID;
- pLine^.Font := fLastActiveFont;
-
- if pLine^.Font <> nil then
- PushLineItem(pLine)
- else
- Dispose(pLine);
- end else
-
- // activate font
- begin
- fActiveFontID := FontID;
- fActiveFont := fLastActiveFont;
- end;
-end;
-
-
-procedure TtsRenderer.FreeLines(var pLinesItem: PtsLinesItem);
-var
- pTemp: PtsLinesItem;
-begin
-
- while pLinesItem <> nil do begin
- pTemp := pLinesItem;
-
- FreeLineItems(pLinesItem^.LineItemFirst);
- pLinesItem^.LineItemLast := pLinesItem^.LineItemFirst;
-
- pLinesItem := pLinesItem^.NextLine;
- Dispose(pTemp);
- end;
-end;
-
-
-procedure TtsRenderer.FreeLineItems(var pLine: PtsLineItem);
-var
- pTemp: PtsLineItem;
-begin
- while pLine <> nil do begin
- pTemp := pLine;
-
- case pLine^.ItemType of
- TS_BLOCK_WORD, TS_BLOCK_SPACE:
- tsStrDispose(pLine^.Word);
- end;
-
- pLine := pLine^.NextItem;
- Dispose(pTemp);
- end;
-end;
-
-
-function TtsRenderer.GetActiveFont: TtsFont;
-begin
- if fisBlock then
- Result := fLastActiveFont
- else
- Result := fActiveFont;
-end;
-
-
-function TtsRenderer.GetActiveFontID: Cardinal;
-begin
- if fisBlock then
- Result := fLastActiveFontID
- else
- Result := fActiveFontID;
-end;
-
-
-procedure TtsRenderer.GetLineMetric(pLine: PtsLineItem; var Metric: TtsTextMetric);
-var
- Font: TtsFont;
- Temp: TtsTextMetric;
-begin
- // Defaults
- Metric.Ascent := 0;
- Metric.Descent := 0;
- Metric.LineSkip := 0;
- Metric.LineSkip_with_LineSpace := 0;
-
- // calculating lines
- Font := fActiveFont;
-
- while pLine <> nil do begin
- case pLine^.ItemType of
- TS_BLOCK_FONT: begin
- Font := pLine^.Font;
- end;
-
- TS_BLOCK_WORD, TS_BLOCK_SPACE, TS_BLOCK_LINEBREAK: begin
- if Font <> nil then begin
- Font.GetTextMetric(Temp);
-
- if Temp.Ascent > Metric.Ascent then
- Metric.Ascent := Temp.Ascent;
-
- if Temp.Descent > Metric.Descent then
- Metric.Descent := Temp.Descent;
-
- if Temp.LineSkip > Metric.LineSkip then
- Metric.LineSkip := Temp.LineSkip;
-
- if Temp.LineSkip_with_LineSpace > Metric.LineSkip_with_LineSpace then
- Metric.LineSkip_with_LineSpace := Temp.LineSkip_with_LineSpace;
-
- // font was handled so we can remove the font to skip the following words.
- // because the value only will change if we change the font.
- Font := nil;
- end;
- end;
- end;
-
- pLine := pLine^.NextItem;
- end;
-end;
-
-
-procedure TtsRenderer.PushTempLines;
-begin
- TrimSpaces(fLinesTemp.Lines);
-
- fLinesTemp.Lines^.LineLength := fLinesTemp.Lines^.LineLength - fLastActiveFont.CharSpacing;
-
- // add after last item
- if fLinesFirst <> nil then begin
- fLinesLast^.NextLine := fLinesTemp.Lines;
- fLinesLast := fLinesTemp.Lines;
- end;
-
- // set first item
- if fLinesFirst = nil then begin
- fLinesFirst := fLinesTemp.Lines;
- fLinesLast := fLinesTemp.Lines;
- end;
-
- // if vertical align is top then draw direktlly
- if tsGetParameteri(TS_VALIGN) = TS_VALIGN_TOP then
- DrawLine(fLinesLast^.LineItemFirst, fLinesLast^.LineLength, fLinesLast^.LineAutoBreak);
-
- // create new item
- with fLinesTemp do begin
- New(Lines);
- with Lines^ do begin
- NextLine := nil;
- LineItemFirst := nil;
- LineItemLast := nil;
- LineLength := 0;
- LineAutoBreak := False;
- end;
-
- Empty := True;
- end;
-end;
-
-
-procedure TtsRenderer.PushLineItem(pLine: PtsLineItem);
-begin
- with fLinesTemp do begin
- if Lines <> nil then begin
- // add after last item
- if Lines^.LineItemLast <> nil then begin
- pLine^.PrevItem := Lines^.LineItemLast;
- Lines^.LineItemLast^.NextItem := pLine;
- Lines^.LineItemLast := pLine;
- end;
-
- // set first item
- if Lines^.LineItemFirst = nil then begin
- Lines^.LineItemFirst := pLine;
- Lines^.LineItemLast := pLine;
- end;
- end;
- end;
-end;
-
-
-procedure TtsRenderer.SplitIntoLines(pItemList: PtsLineItem);
-var
- pExtractItem: PtsLineItem;
-
-
- procedure PushWord(pItem: PtsLineItem);
- begin
- if pItem <> nil then begin
- with fLinesTemp.Lines^ do begin
- // add after last item
- if LineItemLast <> nil then begin
- LineItemLast^.NextItem := pItem;
- pItem^.PrevItem := LineItemLast;
- LineItemLast := pItem;
- end;
-
- // set first item
- if LineItemFirst = nil then begin
- LineItemFirst := pItem;
- LineItemLast := pItem;
- end;
- end;
- end;
- end;
-
-
-begin
- while pItemList <> nil do begin
- // extract word from list
- pExtractItem := pItemList;
- pItemList := pItemList^.NextItem;
- pExtractItem^.NextItem := nil;
- pExtractItem^.PrevItem := nil;
-
- case pExtractItem^.ItemType of
- TS_BLOCK_WORD, TS_BLOCK_SPACE: begin
- // calculate size
- CalculateWordLength(fLastActiveFont, pExtractItem);
-
- if fWordWrap {and not fSingleLine} then begin
- // if line + word is larger than draw width
- if fLinesTemp.Lines^.LineLength + pExtractItem^.WordLength > fBlockWidth then begin
- fLinesTemp.Lines^.LineAutoBreak := True;
-
- // if line is empty
- if fLinesTemp.Lines^.LineLength = 0 then begin
- // ### Split word into multiple lines
- PushWord(pExtractItem);
-
- pExtractItem := nil;
- end; // else
-
- PushTempLines;
- end;
- end;
-
- // add extracted word to intern small list
- if pExtractItem <> nil then begin
- // add word
- PushWord(pExtractItem);
-
- // add Length
- fLinesTemp.Lines^.LineLength := fLinesTemp.Lines^.LineLength + pExtractItem^.WordLength;
- end;
- end;
-
- TS_BLOCK_LINEBREAK: begin
-// if not fSingleLine then begin
- PushWord(pExtractItem);
-
- PushTempLines;
-// end;
- end;
-
- TS_BLOCK_TAB: begin
- PushWord(pExtractItem);
- end;
- end;
- end;
-end;
-
-
-function TtsRenderer.SplitText(pText: PWideChar): PtsLineItem;
-var
- pLastItem: PtsLineItem;
-
- State: Integer;
-
- WordLength: Integer;
- pWordBegin: PWideChar;
-
-
- procedure ExtractWord;
- var
- pWord: PWideChar;
- pWordItem: PtsLineItem;
-
-
- procedure AddItem;
- begin
- // add item to list
- if Result <> nil then begin
- pLastItem^.NextItem := pWordItem;
- pWordItem^.PrevItem := pLastItem;
- pLastItem := pWordItem;
- end;
-
- if Result = nil then begin
- Result := pWordItem;
- pLastItem := pWordItem;
- end;
- end;
-
-
- begin
- if State <> 0 then begin
- // Create listitem
- New(pWordItem);
- pWordItem^.NextItem := nil;
- pWordItem^.PrevItem := nil;
- pWordItem^.ItemType := State;
-
- // only if space or text
- case State of
- TS_BLOCK_WORD, TS_BLOCK_SPACE: begin
- pWordItem^.Word := tsStrAlloc(WordLength);
-
- // copy chars
- WordLength := 0;
- pWord := pWordItem^.Word;
-
- while pWordBegin <> pText do begin
- pWord^ := pWordBegin^;
-
- Inc(pWord);
- Inc(pWordBegin);
- end;
-
- AddItem;
- end;
-
- TS_BLOCK_LINEBREAK: begin
- if pWordBegin <> pText then begin
- // Skip Linebreak
- while pWordBegin <> pText do
- Inc(pWordBegin);
-
-// if not fSingleLine then begin
- AddItem;
-// end else
-
-// begin
-// Dispose(pWordItem);
-// pWordItem := nil;
-// end;
-
- end else
-
- begin
- Dispose(pWordItem);
- pWordItem := nil;
- end;
- end;
-
- TS_BLOCK_TAB: begin
- AddItem;
- end;
- end;
- end;
- end;
-
-
-begin
- Result := nil;
- pLastItem := nil;
- WordLength := 0;
- State := 0;
-
- pWordBegin := pText;
-
- // look for word breaks
- while pText^ <> #0 do begin
- case pText^ of
- // Tabulator
- #$0009: begin
- ExtractWord;
- Inc(pWordBegin);
- State := TS_BLOCK_TAB;
- end;
-
- // line breaks
- #$000D, #$000A: begin
- if State <> TS_BLOCK_LINEBREAK then
- ExtractWord;
-
- if pWordBegin <> pText then begin
- ExtractWord;
- Inc(pWordBegin);
- end;
-
- State := TS_BLOCK_LINEBREAK;
- end;
-
- // Spaces
- #$0020: begin
- if State <> TS_BLOCK_SPACE then begin
- ExtractWord;
-
- State := TS_BLOCK_SPACE;
- end;
- end;
- else
- if State <> TS_BLOCK_WORD then begin
- ExtractWord;
-
- State := TS_BLOCK_WORD;
- end;
- end;
-
- Inc(pText);
- Inc(WordLength);
- end;
-
- // copy last word
- if pWordBegin <> pText then
- ExtractWord;
-end;
-
-
-function TtsRenderer.TextGetDrawHeight: Integer;
-var
- pLinesItem: PtsLinesItem;
- Metric: TtsTextMetric;
-begin
- Result := 0;
-
- // all lines
- pLinesItem := fLinesFirst;
-
- while pLinesItem <> nil do begin
- GetLineMetric(pLinesItem^.LineItemFirst, Metric);
-
- Result := Result + Metric.LineSkip_with_LineSpace;
-
- pLinesItem := pLinesItem^.NextLine;
- end;
-
- // last if we had an templine
- if fLinesTemp.Lines <> nil then begin
- GetLineMetric(fLinesTemp.Lines^.LineItemFirst, Metric);
-
- Result := Result + Metric.LineSkip_with_LineSpace;
- end;
-end;
-
-
-function TtsRenderer.TextGetDrawWidth: Integer;
-var
- pLinesItem: PtsLinesItem;
- Temp: Integer;
- {%H-}Font: TtsFont;
-
-
- function IntGetLineWidth(pLine: PtsLineItem): Integer;
- begin
- Result := 0;
-
- while pLine <> nil do begin
- case pLine^.ItemType of
- TS_BLOCK_FONT: begin
- Font := pLine^.Font;
- end;
-
- TS_BLOCK_WORD, TS_BLOCK_SPACE: begin
- Result := Result + pLine^.WordLength;
- end;
- end;
-
- pLine := pLine^.NextItem;
- end;
- end;
-
-begin
- Result := 0;
-
- // all lines
- Font := fActiveFont;
-
- pLinesItem := fLinesFirst;
- while pLinesItem <> nil do begin
- Temp := IntGetLineWidth(pLinesItem^.LineItemFirst);
- if Temp > Result then
- Result := Temp;
-
- pLinesItem := pLinesItem^.NextLine;
- end;
-
- // last if we had an templine
- if fLinesTemp.Lines <> nil then begin
- Temp := IntGetLineWidth(fLinesTemp.Lines^.LineItemFirst);
-
- if Temp > Result then
- Result := Temp;
- end;
-end;
-
-
-function TtsRenderer.TextGetWidth(pText: pWideChar): Integer;
-var
- pItemList: PtsLineItem;
- pTempItem: PtsLineItem;
-begin
- Result := 0;
-
- pItemList := SplitText(pText);
- pTempItem := pItemList;
-
- while pTempItem <> nil do begin
- CalculateWordLength(fActiveFont, pTempItem);
- Result := Result + pTempItem^.WordLength;
-
- pTempItem := pTempItem^.NextItem;
- end;
-
- // Free Items
- FreeLineItems(pItemList);
-end;
-
-
-procedure TtsRenderer.TextOut(pText: pWideChar);
-var
- pItemList: PtsLineItem;
-
- pTempItem: PtsLineItem;
- TempLength: Integer;
-begin
- pItemList := SplitText(pText);
-
- if isBlock then begin
- SplitIntoLines(pItemList);
- end else
-
- begin
- DrawSetPosition(0, 0);
-
- // Calculate Word length
- TempLength := 0;
- pTempItem := pItemList;
-
- while pTempItem <> nil do begin
- CalculateWordLength(fActiveFont, pTempItem);
- TempLength := TempLength + pTempItem^.WordLength;
-
- pTempItem := pTempItem^.NextItem;
- end;
-
- // remove last Char Spacing
- TempLength := TempLength - fActiveFont.CharSpacing;
-
- // if single line is top then set the Position to the baseline
- if tsGetParameteri(TS_SINGLE_LINE) = TS_SINGLE_LINE_TOP then
- DrawSetPositionRelative(0, fActiveFont.Ascent);
-
- // draw
- DrawLine(pItemList, TempLength, False);
-
- // Free Items
- FreeLineItems(pItemList);
- end;
-end;
-
-
-
-procedure TtsRenderer.TrimSpaces(pLinesItem: PtsLinesItem);
-var
- pTempLoopItem, pTempItem: PtsLineItem;
-begin
- if pLinesItem <> nil then begin
- // delete all spaces at beginning
- while pLinesItem^.LineItemFirst <> nil do begin
- if pLinesItem^.LineItemFirst^.ItemType <> TS_BLOCK_SPACE then
- Break;
-
- // save first
- pTempItem := pLinesItem^.LineItemFirst;
-
- // remove first item fromlist
- pLinesItem^.LineItemFirst := pLinesItem^.LineItemFirst^.NextItem;
- if pLinesItem^.LineItemFirst = nil then
- pLinesItem^.LineItemLast := nil
- else
- pLinesItem^.LineItemFirst^.PrevItem := nil;
-
- pLinesItem^.LineLength := pLinesItem^.LineLength - pTempItem^.WordLength;
-
- // dispose item
- pTempItem^.NextItem := nil;
- FreeLineItems(pTempItem);
- end;
-
- // delete all spaces at the end
- while pLinesItem^.LineItemLast <> nil do begin
- if pLinesItem^.LineItemLast^.ItemType <> TS_BLOCK_SPACE then
- break;
-
- // save last item
- pTempItem := pLinesItem^.LineItemLast;
-
- // remove last item from list
- pLinesItem^.LineItemLast := pLinesItem^.LineItemLast^.PrevItem;
- if pLinesItem^.LineItemLast = nil then
- pLinesItem^.LineItemFirst := nil
- else
- pLinesItem^.LineItemLast^.NextItem := nil;
-
- pLinesItem^.LineLength := pLinesItem^.LineLength - pTempItem^.WordLength;
-
- // dispose item
- FreeLineItems(pTempItem);
- end;
-
-
- // delete all spaces until some text comes
- pTempLoopItem := pLinesItem^.LineItemFirst;
- while pTempLoopItem <> nil do begin
- // exit if we have an word
- if pTempLoopItem^.ItemType = TS_BLOCK_WORD then
- Break;
-
- pTempItem := pTempLoopItem;
-
- pTempLoopItem := pTempLoopItem^.NextItem;
-
- if pTempItem^.ItemType = TS_BLOCK_SPACE then begin
- pLinesItem^.LineLength := pLinesItem^.LineLength - pTempItem^.WordLength;
-
- // set new next/prev
- if pTempItem^.NextItem <> nil then
- pTempItem^.NextItem^.PrevItem := pTempItem^.PrevItem;
-
- if pTempItem^.PrevItem <> nil then
- pTempItem^.PrevItem^.NextItem := pTempItem^.NextItem;
-
- // remove item
- pTempItem^.PrevItem := nil;
- pTempItem^.NextItem := nil;
-
- FreeLineItems(pTempItem);
- end;
- end;
-
- // delete all spaces until some text comes
- pTempLoopItem := pLinesItem^.LineItemLast;
- while pTempLoopItem <> nil do begin
- // exit if we have an word
- if pTempLoopItem^.ItemType = TS_BLOCK_WORD then
- Break;
-
- pTempItem := pTempLoopItem;
-
- pTempLoopItem := pTempLoopItem^.PrevItem;
-
- if pTempItem^.ItemType = TS_BLOCK_SPACE then begin
- pLinesItem^.LineLength := pLinesItem^.LineLength - pTempItem^.WordLength;
-
- // set new next/prev
- if pTempItem^.PrevItem <> nil then
- pTempItem^.PrevItem^.NextItem := pTempItem^.NextItem;
-
- if pTempItem^.NextItem <> nil then
- pTempItem^.NextItem^.PrevItem := pTempItem^.PrevItem;
-
- // remove item
- pTempItem^.PrevItem := nil;
- pTempItem^.NextItem := nil;
-
- FreeLineItems(pTempItem);
- end;
- end;
- end;
-end;
-
-
-procedure TtsRenderer.CharOut(CharCode: WideChar);
-var
- tsChar: TtsChar;
-begin
- tsChar := fActiveFont.GetChar(CharCode);
-
- if tsChar <> nil then
- DrawChar(fActiveFont, tsChar);
-end;
-
-
-{ TtsRendererNULL }
-
-function TtsRendererNULL.AddImage(Char: TtsChar; CharImage: TtsImage): TtsRendererImageReference;
-begin
- Result := TtsRendererNULLImageReference.Create;
-
- if fSaveImages then
- with TtsRendererNULLImageReference(Result) do begin
- Image := TtsImage.Create;
- Image.AssignFrom(CharImage);
- end;
-end;
-
-
-procedure TtsRendererNULL.DrawChar(Font: TtsFont; Char: TtsChar);
-begin
- // nothing
-end;
-
-
-procedure TtsRendererNULL.DrawSetColor(Red, Green, Blue, Alpha: Single);
-begin
- // nothing
-end;
-
-
-procedure TtsRendererNULL.DrawSetPosition(X, Y: Integer);
-begin
- // nothing
-end;
-
-
-procedure TtsRendererNULL.DrawSetPositionRelative(X, Y: Integer);
-begin
- // nothing
-end;
-
-
-procedure TtsRendererNULL.RemoveImageReference(ImageReference: TtsRendererImageReference);
-begin
- if (ImageReference is TtsRendererNULLImageReference) then
- with TtsRendererNULLImageReference(ImageReference) do
- if Image <> nil then
- Image.Free;
-end;
-
-
-
-{ TtsRendererOpenGL }
-
-function TtsRendererOpenGL.AddImage(Char: TtsChar; CharImage: TtsImage): TtsRendererImageReference;
-var
- Idx: Integer;
- TextureEntry: PtsRendererOpenGLTextureEntry;
- TextureAdded: Boolean;
-
- Texture: PtsRendererOpenGLTexture;
- CharHeight, CharWidth: Integer;
-
- W1, H1, TempBorder: Single;
-begin
- Result := nil;
-
- if not CharImage.Empty then begin
- Result := TtsRendererOpenGLImageReference.Create;
-
- with TtsRendererOpenGLImageReference(Result) do begin
- Coordinates.Top := 0;
- Coordinates.Left := 0;
- Coordinates.Right := 0;
- Coordinates.Bottom := 0;
-
- TextureAdded := False;
- TextureEntry := nil;
-
- // look if we can add the image to an texture
- for Idx := 0 to fTextures.Count - 1 do begin
- if AddImageToTexture(fTextures[Idx], CharImage, TexID, Coordinates) then begin
- TextureEntry := fTextures[Idx];
- TextureAdded := True;
-
- Break;
- end;
- end;
-
- // could not added so create new texture
- if not TextureAdded then begin
- TextureEntry := CreateNewTexture;
-
- AddImageToTexture(TextureEntry, CharImage, TexID, Coordinates);
- end;
-
- // generating coords
- if TextureEntry <> nil then begin
- Texture := TextureEntry^.Texture;
-
- if Texture <> nil then begin
- with Char do begin
- CharHeight := Coordinates.Bottom - Coordinates.Top;
- CharWidth := Coordinates.Right - Coordinates.Left;
-
- // Set Variables for resizing border
- if HasResizingBorder then begin
- W1 := 1 / Texture^.Width;
- H1 := 1 / Texture^.Height;
- TempBorder := 2;
- end else begin
- W1 := 0;
- H1 := 0;
- TempBorder := 0;
- end;
-
- // Top Left
- TexCoords[0].X := Coordinates.Left / Texture^.Width + W1;
- TexCoords[0].Y := Coordinates.Top / Texture^.Height + H1;
-// Vertex[0].X := - GlyphRect.Left + Size1;
-// Vertex[0].Y := - GlyphRect.Top - GlyphOriginY + Size1;
- Vertex[0].X := - GlyphRect.Left;
- Vertex[0].Y := - GlyphRect.Top - GlyphOriginY;
-
- // Bottom Left
- TexCoords[1].X := Coordinates.Left / Texture^.Width + W1;
- TexCoords[1].Y := Coordinates.Bottom / Texture^.Height - H1;
-// Vertex[1].X := - GlyphRect.Left + Size1;
-// Vertex[1].Y := CharHeight - GlyphRect.Top - GlyphOriginY - Size1;
- Vertex[1].X := - GlyphRect.Left;
- Vertex[1].Y := CharHeight - GlyphRect.Top - GlyphOriginY - TempBorder;
-
- // Bottom Right
- TexCoords[2].X := Coordinates.Right / Texture^.Width - W1;
- TexCoords[2].Y := Coordinates.Bottom / Texture^.Height - H1;
-// Vertex[2].X := CharWidth - GlyphRect.Left - Size1;
-// Vertex[2].Y := CharHeight - GlyphRect.Top - GlyphOriginY - Size1;
- Vertex[2].X := CharWidth - GlyphRect.Left - TempBorder;
- Vertex[2].Y := CharHeight - GlyphRect.Top - GlyphOriginY - TempBorder;
-
- // Top Right
- TexCoords[3].X := Coordinates.Right / Texture^.Width - W1;
- TexCoords[3].Y := Coordinates.Top / Texture^.Height + H1;
-// Vertex[3].X := CharWidth - GlyphRect.Left - Size1;
-// Vertex[3].Y := - GlyphRect.Top - GlyphOriginY + Size1;
- Vertex[3].X := CharWidth - GlyphRect.Left - TempBorder;
- Vertex[3].Y := - GlyphRect.Top - GlyphOriginY;
- end;
- end;
- end;
- end;
- end;
-end;
-
-
-function TtsRendererOpenGL.AddImageToTexture(Texture: PtsRendererOpenGLTextureEntry; Image: TtsImage; var TextureID: Integer; var Coordinates: tsRect): boolean;
-var
- NeedX, NeedY: Word;
- Start: Word;
- Y, Y2: Integer;
- Managed: PtsRendererOpenGLManagedEntry;
-
-
- function CheckVertical(StartPos, EndPos: Integer): Boolean;
- var
- TempY: Integer;
- TempManaged: PtsRendererOpenGLManagedEntry;
- Found: Boolean;
- begin
- Result := False;
-
- for TempY := Y +1 to Y + NeedY -1 do begin
- TempManaged := Texture^.Lines[TempY];
-
- // Überprüfen ob der entsprechende Bereich noch frei ist.
- Found := False;
-
- while TempManaged <> nil do begin
- if (TempManaged^.Start <= StartPos) and (TempManaged^.Start + TempManaged^.Count >= EndPos) then
- Found := True;
-
- TempManaged := TempManaged^.NextEntry;
- end;
-
- if not Found then
- Exit;
- end;
-
- Result := True;
- end;
-
-
-begin
- Result := False;
-
- NeedX := Image.Width shr 1;
- if (Image.Width and 1) > 0 then
- Inc(NeedX);
-
- NeedY := Image.Height shr 1;
- if (Image.Height and 1) > 0 then
- Inc(NeedY);
-
- // scan for free space
- for Y := Low(Texture^.Lines) to High(Texture^.Lines) - NeedY do begin
- Managed := Texture^.Lines[Y];
-
- while Managed <> nil do begin
- if Managed^.Count >= NeedX then begin
- if CheckVertical(Managed^.Start, Managed^.Start + NeedX) then begin
- Start := Managed^.Start;
-
- // allocating space
- for Y2 := Y to Y + NeedY -1 do
- AllocSpace(Texture^.Lines[Y2], Start, NeedX);
-
- // setting texturecoordinates values
- TextureID := Texture^.ID;
-
- Coordinates.Left := Start shl 1;
- Coordinates.Top := Y shl 1;
- Coordinates.Right := Coordinates.Left + Image.Width;
- Coordinates.Bottom := Coordinates.Top + Image.Height;
-
- Texture^.Usage := Texture^.Usage + NeedX * NeedY;
-
- // copy charimage
- with Texture^.Texture^ do begin
- glBindTexture(GL_TEXTURE_2D, Texture^.Texture^.glTextureID);
- glTexSubImage2D(GL_TEXTURE_2D, 0, Coordinates.Left, Coordinates.Top, Image.Width, Image.Height, GL_RGBA, GL_UNSIGNED_BYTE, Image.Data);
- end;
-
- Result := True;
- Exit;
- end;
- end;
-
- Managed := Managed^.NextEntry;
- end;
- end;
-end;
-
-
-procedure TtsRendererOpenGL.AfterConstruction;
-begin
- inherited;
-
- fTextures := TList.Create;
- fTextureSize := 256;
-end;
-
-
-procedure TtsRendererOpenGL.AllocSpace(var FirstManaged: PtsRendererOpenGLManagedEntry; Start, Count: Word);
-var
- Managed, TempManaged: PtsRendererOpenGLManagedEntry;
-
-
- procedure RemoveManagedItem(pItem: PtsRendererOpenGLManagedEntry);
- var
- pTemp, pTemp2: PtsRendererOpenGLManagedEntry;
- begin
- pTemp := FirstManaged;
-
- while pTemp <> nil do begin
- pTemp2 := pTemp^.NextEntry;
-
- if pTemp2 = pItem then begin
- pTemp^.NextEntry := pItem^.NextEntry;
-
- Break;
- end;
-
- pTemp := pTemp2;
- end;
- end;
-
-
-begin
- // complete remove of the FIRST item (spezial handling for first item removal.)
- if (Start = FirstManaged^.Start) and (Count = FirstManaged^.Count) then begin
- TempManaged := FirstManaged;
-
- FirstManaged := FirstManaged^.NextEntry;
-
- Dispose(TempManaged);
- end else
-
- // look for matching item
- begin
- Managed := FirstManaged;
-
- while Managed <> nil do begin
- // matched item?
- if (Start >= Managed^.Start) and ((Start + Count) <= (Managed^.Start + Managed^.Count)) then begin
-
- // cut at start
- if (Start = Managed^.Start) then begin
-
- // remove the whole item
- if (Count = Managed^.Count) then begin
- RemoveManagedItem(Managed);
-
- // no need to preserve Managed because we leaving the loop
- Dispose(Managed);
- end else
-
- // cut at start
- begin
- Managed^.Start := Managed^.Start + Count;
- Managed^.Count := Managed^.Count - Count;
- end;
- end else
-
- // cut at end
- if (Start + Count) = (Managed^.Start + Managed^.Count) then begin
- Managed^.Count := Managed^.Count - Count;
- end else
-
- // cut in the middle
- begin
- New(TempManaged);
- TempManaged^.NextEntry := Managed^.NextEntry;
- Managed^.NextEntry := TempManaged;
-
- TempManaged^.Start := Start + Count;
- TempManaged^.Count := (Managed^.Start + Managed^.Count) - TempManaged^.Start;
-
- Managed^.Count := Start - Managed^.Start;
- end;
-
- // we found an item so leave the loop
- Break;
- end;
-
- Managed := Managed^.NextEntry;
- end;
- end;
-end;
-
-
-procedure TtsRendererOpenGL.BeforeDestruction;
-begin
- ClearTextures;
- fTextures.Free;
-
- inherited;
-end;
-
-
-procedure TtsRendererOpenGL.BeginBlock(Left, Top, Width, Height: Integer; Flags: tsBitmask);
-begin
- fPos.X := 0;
- fPos.Y := 0;
-
- inherited;
-end;
-
-
-procedure TtsRendererOpenGL.ClearTextures;
-var
- Idx: Integer;
-begin
- // Disposing items
- for Idx := fTextures.Count - 1 downto 0 do
- DeleteTexture(Idx);
-
- // Clear list
- fTextures.Clear;
-end;
-
-
-function TtsRendererOpenGL.CreateNewTexture: PtsRendererOpenGLTextureEntry;
-var
- Idx: Integer;
-begin
- New (Result);
- with Result^ do begin
- ID := fTextures.Add(Result);
- Usage := 0;
-
- // create opengl texture
- New(Texture);
- with Texture^ do begin
- Width := TextureSize;
- Height := TextureSize;
-
- glGenTextures(1, @glTextureID);
- glBindTexture(GL_TEXTURE_2D, glTextureID);
-
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
-
- glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, TextureSize, TextureSize, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
- end;
-
- // initiale memory manager value
- SetLength(Lines, Texture^.Height shr 1);
-
- for Idx := Low(Lines) to High(Lines) do begin
- New(Lines[Idx]);
- Lines[Idx]^.NextEntry := nil;
- Lines[Idx]^.Start := 0;
- Lines[Idx]^.Count := Texture^.Width shr 1;
- end;
- end;
-end;
-
-
-procedure TtsRendererOpenGL.DeleteTexture(Idx: Integer);
-var
- pItem: PtsRendererOpenGLTextureEntry;
-
- LineIdx: Integer;
- pManaged, pTempManaged: PtsRendererOpenGLManagedEntry;
-begin
- pItem := fTextures[Idx];
-
- fTextures.Delete(Idx);
-
- if pItem <> nil then begin
- with pItem^ do begin
- // Free opengl texture
- if Texture <> nil then begin
- glDeleteTextures(1, @(Texture^.glTextureID));
-
- Dispose(Texture);
- end;
-
- // free lines
- for LineIdx := Low(Lines) to High(Lines) do begin
- pManaged := Lines[LineIdx];
- Lines[LineIdx] := nil;
-
- while pManaged <> nil do begin
- pTempManaged := pManaged;
- pManaged := pManaged^.NextEntry;
-
- Dispose(pTempManaged);
- end;
- end;
-
- SetLength(Lines, 0);
- end;
-
- Dispose(pItem);
- end;
-end;
-
-
-procedure TtsRendererOpenGL.DrawChar(Font: TtsFont; Char: TtsChar);
-var
- Texture: PtsRendererOpenGLTexture;
- TempVertex: tsQuadFloat;
-begin
- if Char.RendererImageReference <> nil then begin
- with Char.RendererImageReference as TtsRendererOpenGLImageReference do begin
- Texture := GetTextureByID(TexID);
-
- if Texture <> nil then begin
- glBindTexture(GL_TEXTURE_2D, Texture^.glTextureID);
- glEnable(GL_TEXTURE_2D);
-
- // calculate new quad
- TranslateQuad(TempVertex, Vertex, fPos);
-
- glBegin(GL_QUADS);
- glTexCoord2fv(@TexCoords[0]);
- glVertex2fv(@TempVertex[0]);
-
- glTexCoord2fv(@TexCoords[1]);
- glVertex2fv(@TempVertex[1]);
-
- glTexCoord2fv(@TexCoords[2]);
- glVertex2fv(@TempVertex[2]);
-
- glTexCoord2fv(@TexCoords[3]);
- glVertex2fv(@TempVertex[3]);
- glEnd;
-
- // if debug is enabled
- if fContext.gDebugDrawCharRects then begin
- glDisable(GL_TEXTURE_2D);
-
- // image Rect
- glColor4f(0, 1, 0, 0.1);
- glBegin(GL_QUADS);
- glVertex2fv(@TempVertex[0]);
- glVertex2fv(@TempVertex[1]);
- glVertex2fv(@TempVertex[2]);
- glVertex2fv(@TempVertex[3]);
- glEnd;
-
- // glyph rect
- glColor4f(1, 0, 0, 0.1);
- glBegin(GL_QUADS);
- glVertex2f(TempVertex[0].X + Char.GlyphRect.Left, TempVertex[0].Y + Char.GlyphRect.Top);
- glVertex2f(TempVertex[0].X + Char.GlyphRect.Left, TempVertex[0].Y + Char.GlyphRect.Bottom);
- glVertex2f(TempVertex[0].X + Char.GlyphRect.Right, TempVertex[0].Y + Char.GlyphRect.Bottom);
- glVertex2f(TempVertex[0].X + Char.GlyphRect.Right, TempVertex[0].Y + Char.GlyphRect.Top);
- glEnd;
-
- // baseline
- glColor4f(0, 0, 1, 0.25);
- glBegin(GL_LINES);
- glVertex2f(TempVertex[0].X, 0);
- glVertex2f(TempVertex[2].X, 0);
- glEnd;
-
- glColor4f(1, 1, 1, 1);
- end;
- end;
- end;
- end;
-end;
-
-
-procedure TtsRendererOpenGL.DrawSetColor(Red, Green, Blue, Alpha: Single);
-begin
- glColor4f(Red, Green, Blue, Alpha);
-end;
-
-
-procedure TtsRendererOpenGL.DrawSetPosition(X, Y: Integer);
-begin
- fPos.X := X;
- fPos.Y := Y;
-end;
-
-
-procedure TtsRendererOpenGL.DrawSetPositionRelative(X, Y: Integer);
-begin
- DrawSetPosition(fPos.X + X, fPos.Y + Y);
-end;
-
-
-procedure TtsRendererOpenGL.FreeSpace(var FirstManaged: PtsRendererOpenGLManagedEntry; Start, Count: Word);
-var
- Last, Managed, Temp: PtsRendererOpenGLManagedEntry;
- AddItem: Boolean;
-begin
- // if we have no space we can add item directly
- if FirstManaged = nil then begin
- New(Temp);
- Temp^.Start := Start;
- Temp^.Count := Count;
- Temp^.NextEntry := nil;
-
- FirstManaged := Temp;
- end else
-
- // Special handling for first Item
- if Start + Count < FirstManaged^.Start then begin
- New(Temp);
- Temp^.Start := Start;
- Temp^.Count := Count;
- Temp^.NextEntry := FirstManaged;
-
- FirstManaged := Temp;
- end else
-
- begin
- Managed := FirstManaged;
- Last := nil;
-
- while Managed <> nil do begin
- // block is in front of another
- if Start + Count = Managed^.Start then begin
- Managed^.Start := Managed^.Start - Count;
- Managed^.Count := Managed^.Count + Count;
-
- if Last <> nil then begin
- if Last^.Start + Last^.Count = Managed^.Start then begin
- // Remove Item
- Last^.Count := Last^.Count + Managed^.Count;
- Last^.NextEntry := Managed^.NextEntry;
-
- Dispose(Managed);
- end;
- end;
-
- Break;
- end else
-
- // block is behind another
- if Start = Managed^.Start + Managed^.Count then begin
- Managed^.Count := Managed^.Count + Count;
-
- Temp := Managed^.NextEntry;
- if Temp <> nil then begin
- if Managed^.Start + Managed^.Count = Temp^.Start then begin
- // Remove Item
- Managed^.Count := Managed^.Count + Temp^.Count;
- Managed^.NextEntry := Temp^.NextEntry;
-
- Dispose(Temp);
- end;
- end;
-
- Break;
- end else
-
- // the block dosn't border an other so we must create some other
- begin
- AddItem := False;
-
- if not (Managed^.NextEntry <> nil) then
- AddItem := True
- else
-
- if (Managed^.Start + Managed^.Count < Start) and (Managed^.NextEntry^.Start > Start + Count) then
- AddItem := True;
-
- if AddItem then begin
- New(Temp);
- Temp^.Start := Start;
- Temp^.Count := Count;
- Temp^.NextEntry := Managed^.NextEntry;
- Managed^.NextEntry := Temp;
-
- Break;
- end;
- end;
-
- Last := Managed;
- Managed := Managed^.NextEntry;
- end;
- end;
-end;
-
-
-function TtsRendererOpenGL.GetTextureByID(ID: Integer): PtsRendererOpenGLTexture;
-var
- Idx: Integer;
- pTexture: PtsRendererOpenGLTextureEntry;
-begin
- Result := nil;
-
- for Idx := 0 to fTextures.Count - 1 do begin
- pTexture := fTextures[Idx];
-
- if pTexture <> nil then
- if pTexture^.ID = ID then begin
- Result := pTexture^.Texture;
- Break;
- end;
- end;
-end;
-
-
-
-procedure TtsRendererOpenGL.RemoveImageReference(ImageReference: TtsRendererImageReference);
-var
- OpenGLRef: TtsRendererOpenGLImageReference;
- pItem: PtsRendererOpenGLTextureEntry;
-
- Idx, TempIdx: Integer;
- TempWidth, TempHeight: Integer;
- NeedX, NeedY: Integer;
- LinesY, TempX, TempY: Integer;
-begin
- OpenGLRef := TtsRendererOpenGLImageReference(ImageReference);
-
- // freeing texture
- for Idx := 0 to fTextures.Count - 1 do begin
- pItem := fTextures[Idx];
-
- if pItem <> nil then begin
- if pItem^.ID = OpenGLRef.TexID then begin
- TempWidth := OpenGLRef.Coordinates.Right - OpenGLRef.Coordinates.Left;
- TempHeight := OpenGLRef.Coordinates.Bottom - OpenGLRef.Coordinates.Top;
-
- with pItem^ do begin
- // calc size
- NeedX := TempWidth shr 1;
- if (TempWidth and 1) > 0 then
- Inc(NeedX);
-
- NeedY := TempHeight shr 1;
- if (TempHeight and 1) > 0 then
- Inc(NeedY);
-
- TempY := OpenGLRef.Coordinates.Top shr 1;
- TempX := OpenGLRef.Coordinates.Left shr 1;
-
- Usage := Usage - NeedX * NeedY;
-
- Assert(Usage >= 0);
-
- // Points
- for LinesY := 0 to NeedY - 1 do
- FreeSpace(Lines[TempY + LinesY], TempX, NeedX);
-
- // freeing opengltexture
- if Usage = 0 then begin
- for TempIdx := 0 to fTextures.Count - 1 do begin
- if PtsRendererOpenGLTextureEntry(fTextures[TempIdx])^.ID = pItem^.ID then begin
- DeleteTexture(TempIdx);
-
- Break;
- end;
- end;
- end;
- end;
-
- Break;
- end;
- end;
- end;
-end;
-
-
-{ TtsContext }
-
-function TtsContext.AnsiToWide(pText: pAnsiChar): pWideChar;
-
- function GetDefaultChar: WideChar;
- begin
- Result := #0;
-
- if tsGetParameteri(TS_EMPTY_CP_ENTRY) = TS_EMPTY_CP_ENTRY_USE_DEFAULT then
- if ActiveFont <> nil then
- Result := ActiveFont.DefaultChar;
- end;
-
-begin
- Result := nil;
-
- // UTF-8
- if gCodePage = TS_CODEPAGE_UTF8 then begin
- Result := tsStrAlloc(Length(pText));
- tsAnsiUTF8ToWide(Result, pText, GetDefaultChar);
- end else
-
- // ISO 8859-1
- if gCodePage = TS_CODEPAGE_8859_1 then begin
- Result := tsStrAlloc(Length(pText));
- tsAnsiISO_8859_1_ToWide(Result, pText);
- end else
-
- // single or double byte CodePage
- begin
- if (Addr(gCodePageFunc) <> nil) and (gCodePagePtr <> nil) then begin
- Result := tsStrAlloc(Length(pText));
- gCodePageFunc(Result, pText, gCodePagePtr, GetDefaultChar);
- end;
- end;
-end;
-
-
-procedure TtsContext.ClearFonts;
-var
- List: TList;
- Idx: Integer;
- pItem: PtsContextFontEntry;
-begin
- List := TList.Create;
- try
- fFonts.GetValues(List);
- fFonts.Clear;
-
- for Idx := 0 to List.Count - 1 do begin
- pItem := List[Idx];
-
- pItem^.Font.Free;
- Dispose(pItem);
- end;
- finally
- List.Free;
- end;
-end;
-
-
-procedure TtsContext.ClearImages;
-var
- List: TList;
- Idx: Integer;
- pItem: PtsContextImageEntry;
-begin
- List := TList.Create;
- try
- fImages.GetValues(List);
- fImages.Clear;
-
- for Idx := 0 to List.Count - 1 do begin
- pItem := List[Idx];
-
- pItem^.Image.Free;
- Dispose(pItem);
- end;
- finally
- List.Free;
- end;
-end;
-
-
-constructor TtsContext.Create;
-begin
- inherited;
-
- Inc(gLastContextID);
- fContextID := gLastContextID;
-
- // hashes
- fFonts := TtsHash.Create(127);
- fImages := TtsHash.Create(127);
-
- // defaults
- gEmptyCodePageEntry := TS_EMPTY_CP_ENTRY_USE_DEFAULT;
- gCodePage := TS_CODEPAGE_8859_1;
- gCodePagePtr := nil; //@CP_8859_1;
- gCodePageFunc := nil; //tsAnsiSBCDToWide;
-
- gGlobalFormat := TS_FORMAT_RGBA8;
- gGlobalAntiAliasing := TS_ANTIALIASING_NORMAL;
-
- gSingleLine := TS_SINGLE_LINE_BASELINE;
- gAlign := TS_ALIGN_LEFT;
- gVAlign := TS_VALIGN_TOP;
- gClip := TS_CLIP_COMPLETE;
-
- gImageMode[tsModeRed] := TS_MODE_REPLACE;
- gImageMode[tsModeGreen] := TS_MODE_REPLACE;
- gImageMode[tsModeBlue] := TS_MODE_REPLACE;
- gImageMode[tsModeAlpha] := TS_MODE_MODULATE;
- gImageMode[tsModeLuminance] := TS_MODE_REPLACE;
-
- gImageLibrary := 0;
-end;
-
-
-destructor TtsContext.Destroy;
-begin
- ClearFonts;
- fFonts.Free;
-
- ClearImages;
- fImages.Free;
-
- if Renderer <> nil then
- Renderer.Free;
-
- inherited;
-end;
-
-
-function TtsContext.FontAdd(Font: TtsFont): Cardinal;
-var
- Entry: PtsContextFontEntry;
-begin
- New(Entry);
-
- Inc(fLastFontID);
-
- Entry^.FontID := fLastFontID;
- Entry^.Font := Font;
-
- fFonts.Add(fLastFontID, Entry);
-
- Result := fLastFontID;
-end;
-
-
-function TtsContext.FontCount: Cardinal;
-begin
- Result := fFonts.Count;
-end;
-
-
-procedure TtsContext.FontDelete(Font: Cardinal);
-var
- Entry: PtsContextFontEntry;
-begin
- if fLastFontID = Font then
- Renderer.FontActivate(0);
-
- Entry := fFonts.Get(Font);
-
- if Entry <> nil then begin
- fFonts.Delete(Entry^.FontID);
-
- Dispose(Entry);
- end;
-end;
-
-
-function TtsContext.FontGet(Font: Cardinal): TtsFont;
-var
- Entry: PtsContextFontEntry;
-begin
- Entry := fFonts.Get(Font);
-
- if Entry <> nil then
- Result := Entry^.Font
- else
- Result := nil;
-end;
-
-
-function TtsContext.GetActiveFont: TtsFont;
-begin
- Result := nil;
-
- if Renderer <> nil then
- Result := Renderer.ActiveFont;
-end;
-
-
-function TtsContext.GetIsLocked: boolean;
-begin
- if Renderer <> nil then
- Result := Renderer.isBlock
- else
- Result := False;
-end;
-
-
-function TtsContext.ImageAdd(Image: TtsImage): Cardinal;
-var
- Entry: PtsContextImageEntry;
-begin
- New(Entry);
-
- Inc(fLastImageID);
-
- Entry^.ImageID := fLastImageID;
- Entry^.Image := Image;
-
- fImages.Add(fLastImageID, Entry);
-
- Result := fLastImageID;
-end;
-
-
-function TtsContext.ImageCount: Cardinal;
-begin
- Result := fImages.Count;
-end;
-
-
-procedure TtsContext.ImageDelete(Image: Cardinal);
-var
- Entry: PtsContextImageEntry;
-begin
- Entry := fImages.Get(Image);
-
- if Entry <> nil then begin
- fImages.Delete(Entry^.ImageID);
-
- Dispose(Entry);
- end;
-end;
-
-
-function TtsContext.ImageGet(Image: Cardinal): TtsImage;
-var
- Entry: PtsContextImageEntry;
-begin
- Entry := fImages.Get(Image);
-
- if Entry <> nil then
- Result := Entry^.Image
- else
- Result := nil;
-end;
-
-end.
diff --git a/old/TextSuiteImports.pas b/old/TextSuiteImports.pas
deleted file mode 100644
index f071897..0000000
--- a/old/TextSuiteImports.pas
+++ /dev/null
@@ -1,867 +0,0 @@
-{
-TextSuite (C) Steffen Xonna (aka Lossy eX)
-http://www.opengl24.de/
------------------------------------------------------------------------
-For copyright informations see file copyright.txt.
-}
-
-{$I TextSuiteOptions.inc}
-
-unit TextSuiteImports;
-
-interface
-
-uses
- TextSuite;
-
-type
- DWORD = Cardinal;
- PDWORD = ^DWORD;
-
-
-// *** Global Functions ***
-{$IFDEF WINDOWS}
-const
- Kernel32 = 'kernel32.dll';
-
- function LoadLibrary(lpFileName: pAnsiChar): Pointer; stdcall; external Kernel32 name 'LoadLibraryA';
- function FreeLibrary(hModule: Pointer): Pointer; stdcall; external Kernel32 name 'FreeLibrary';
- function GetProcAddress(hModule: Pointer; lpProcName: pAnsiChar): Pointer; stdcall; external Kernel32 name 'GetProcAddress';
-{$ELSE}
-const
- LibraryLib = {$IFDEF Linux} 'libdl.so.2'{$ELSE} 'c'{$ENDIF};
-
- RTLD_LAZY = $001;
-
- function dlopen(Name: pAnsiChar; Flags: LongInt): Pointer; cdecl; external LibraryLib name 'dlopen';
- function dlclose(Lib: Pointer): LongInt; cdecl; external LibraryLib name 'dlclose';
- function dlsym(Lib: Pointer; Name: pAnsiChar): Pointer; cdecl; external LibraryLib name 'dlsym';
-{$ENDIF}
-
-
-{$IFDEF WINDOWS}
- function GetCurrentThreadId: DWORD; stdcall; external Kernel32 name 'GetCurrentThreadId';
-{$ENDIF}
-
-
-
-// *** OpenGL ***
-function Init_OpenGL: Boolean;
-procedure Quit_OpenGL;
-
-const
- {$IFDEF WINDOWS}
- LIB_OPENGL = 'opengl32.dll';
- {$ELSE}
- LIB_OPENGL = 'libGL.so.1';
- {$ENDIF}
-
- GL_TEXTURE_2D = $0DE1;
- GL_RGBA = $1908;
- GL_UNSIGNED_BYTE = $1401;
- GL_NEAREST = $2600;
- GL_LINEAR = $2601;
- GL_TEXTURE_MAG_FILTER = $2800;
- GL_TEXTURE_MIN_FILTER = $2801;
-
- GL_LINES = $0001;
- GL_QUADS = $0007;
-
- GL_COMPILE = $1300;
-
-
-var
- OpenGL_initialized: Boolean;
- Library_OpenGL: Pointer;
-
- glEnable: procedure(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glDisable: procedure(cap: Cardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
-
- glColor4f: procedure(red, green, blue, alpha: Single); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
-
- glGenTextures: procedure(n: Integer; textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glDeleteTextures: procedure(n: Integer; const textures: PCardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glBindTexture: procedure(target: Cardinal; texture: Cardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glTexParameteri: procedure(target: Cardinal; pname: Cardinal; param: Integer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glTexImage2D: procedure(target: Cardinal; level: Integer; internalformat: Integer; width: Integer; height: Integer; border: Integer; format: Cardinal; _type: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glTexSubImage2D: procedure(target: Cardinal; level: Integer; xoffset: Integer; yoffset: Integer; width: Integer; height: Integer; format: Cardinal; _type: Cardinal; const pixels: Pointer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
-
- glBegin: procedure(mode: Cardinal); {$IFNDEF CLR}{$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}{$ENDIF}
- glEnd: procedure(); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glTexCoord2f: procedure(s: Single; t: Single); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glTexCoord2fv: procedure(v: Pointer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glVertex2f: procedure(x: Single; y: Single); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glVertex2fv: procedure(v: Pointer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glVertex2iv: procedure(v: Pointer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
-
- glGenLists: function(range: Integer): Cardinal; {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glDeleteLists: procedure(list: Cardinal; range: Integer); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glCallList: procedure(list: Cardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glNewList: procedure(list: Cardinal; mode: Cardinal); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
- glEndList: procedure(); {$IFDEF WINDOWS}stdcall; {$ELSE}cdecl; {$ENDIF}
-
-
-
-// *** Windows GDI ***
-function Init_GDI: Boolean;
-procedure Quit_GDI;
-
-type
- HDC = Cardinal;
- HFONT = Cardinal;
- HGDIOBJ = Cardinal;
-
- {$IFDEF CPU64}
- {$PACKRECORDS 8}
- {$ENDIF}
-
- TFixed = packed record
- fract: Word;
- value: Smallint;
- end;
-
- TMat2 = packed record
- eM11: TFixed;
- eM12: TFixed;
- eM21: TFixed;
- eM22: TFixed;
- end;
- PMat2 = ^TMat2;
-
- TLogFontA = record
- lfHeight: Longint;
- lfWidth: Longint;
- lfEscapement: Longint;
- lfOrientation: Longint;
- lfWeight: Longint;
- lfItalic: Byte;
- lfUnderline: Byte;
- lfStrikeOut: Byte;
- lfCharSet: Byte;
- lfOutPrecision: Byte;
- lfClipPrecision: Byte;
- lfQuality: Byte;
- lfPitchAndFamily: Byte;
- lfFaceName: array[0..31] of AnsiChar;
- end;
- PLogFontA = ^TLogFontA;
-
- TTextMetricW = record
- tmHeight: Longint;
- tmAscent: Longint;
- tmDescent: Longint;
- tmInternalLeading: Longint;
- tmExternalLeading: Longint;
- tmAveCharWidth: Longint;
- tmMaxCharWidth: Longint;
- tmWeight: Longint;
- tmOverhang: Longint;
- tmDigitizedAspectX: Longint;
- tmDigitizedAspectY: Longint;
- tmFirstChar: WideChar;
- tmLastChar: WideChar;
- tmDefaultChar: WideChar;
- tmBreakChar: WideChar;
- tmItalic: Byte;
- tmUnderlined: Byte;
- tmStruckOut: Byte;
- tmPitchAndFamily: Byte;
- tmCharSet: Byte;
- end;
- PTextMetricW = ^TTextMetricW;
-
- TGlyphMetrics = record
- gmBlackBoxX: Cardinal;
- gmBlackBoxY: Cardinal;
- gmptGlyphOrigin: tsPoint;
- gmCellIncX: Smallint;
- gmCellIncY: Smallint;
- end;
- PGlyphMetrics = ^TGlyphMetrics;
-
- TGCPResultsW = record
- lStructSize: DWORD;
- lpOutString: PWideChar;
- lpOrder: PDWORD;
- lpDx: PInteger;
- lpCaretPos: PInteger;
- lpClass: PChar;
- lpGlyphs: PCardinal;
- nGlyphs: Cardinal;
- nMaxFit: Cardinal;
- end;
- PGCPResultsW = ^TGCPResultsW;
-
- TPanose = record
- bFamilyType: Byte;
- bSerifStyle: Byte;
- bWeight: Byte;
- bProportion: Byte;
- bContrast: Byte;
- bStrokeVariation: Byte;
- bArmStyle: Byte;
- bLetterform: Byte;
- bMidline: Byte;
- bXHeight: Byte;
- end;
- PPanose = ^TPanose;
-
- TOutlineTextmetricW = record
- otmSize: LongWord;
- otmTextMetrics: TTextMetricW;
- otmFiller: Byte;
- otmPanoseNumber: TPanose;
- otmfsSelection: LongWord;
- otmfsType: LongWord;
- otmsCharSlopeRise: Integer;
- otmsCharSlopeRun: Integer;
- otmItalicAngle: Integer;
- otmEMSquare: LongWord;
- otmAscent: Integer;
- otmDescent: Integer;
- otmLineGap: LongWord;
- otmsCapEmHeight: LongWord;
- otmsXHeight: LongWord;
- otmrcFontBox: tsRect;
- otmMacAscent: Integer;
- otmMacDescent: Integer;
- otmMacLineGap: LongWord;
- otmusMinimumPPEM: LongWord;
- otmptSubscriptSize: tsPoint;
- otmptSubscriptOffset: tsPoint;
- otmptSuperscriptSize: tsPoint;
- otmptSuperscriptOffset: tsPoint;
- otmsStrikeoutSize: LongWord;
- otmsStrikeoutPosition: Integer;
- otmsUnderscoreSize: Integer;
- otmsUnderscorePosition: Integer;
- otmpFamilyName: PWideChar;
- otmpFaceName: PWideChar;
- otmpStyleName: PWideChar;
- otmpFullName: PWideChar;
- end;
- POutlineTextmetricW = ^TOutlineTextmetricW;
-
- {$IFDEF CPU64}
- {$PACKRECORDS 4}
- {$ENDIF}
-
-const
- LIB_GDI32 = 'gdi32.dll';
- LIB_KERNEL32 = 'kernel32.dll';
-
- GDI_ERROR = DWORD($FFFFFFFF);
-
- FW_NORMAL = 400;
- FW_BOLD = 700;
-
- DEFAULT_CHARSET = 1;
-
- NONANTIALIASED_QUALITY = 3;
- ANTIALIASED_QUALITY = 4;
-
- GGO_METRICS = 0;
- GGO_BITMAP = 1;
- GGO_GRAY8_BITMAP = 6;
- GGO_GLYPH_INDEX = $80;
-
- FR_PRIVATE = $10;
- FR_NOT_ENUM = $20;
-
- LOCALE_USER_DEFAULT = $0400;
- LOCALE_ILANGUAGE = $1;
-
- GCP_MAXEXTENT = $100000;
-
- TMPF_FIXED_PITCH = 1;
-
-
-var
- GDI_initialized: Boolean;
- Library_GDI32: Pointer;
- Library_KERNEL32: Pointer;
-
- CreateFontIndirectA: function (const p1: TLogFontA): HFONT; stdcall;
-
- AddFontResourceA: function(Filename: PAnsiChar): Integer; stdcall;
- AddFontResourceExA: function(Filename: PAnsiChar; Flag: DWORD; pdv: Pointer): Integer; stdcall;
- AddFontMemResourceEx: function(pbFont: Pointer; cbFont: DWORD; pdv: Pointer; pcFonts: PDWORD): THandle; stdcall;
- RemoveFontResourceA: function(Filename: PAnsiChar): Boolean; stdcall;
- RemoveFontResourceExA: function(filename: PAnsiChar; Flag: DWORD; pdv: Pointer): Boolean; stdcall;
- RemoveFontMemResourceEx: function(fh: THandle): Boolean; stdcall;
-
- GetTextMetricsW: function(DC: HDC; var TM: TTextMetricW): Boolean; stdcall;
- //GetGlyphOutlineA: function(DC: HDC; uChar, uFormat: Word; const lpgm: TGlyphMetrics; cbBuffer: DWORD; lpvBuffer: Pointer; const lpmat2: TMat2): DWORD; stdcall;
- GetGlyphOutlineA: function(DC: HDC; uChar, uFormat: Cardinal; lpgm: PGlyphMetrics; cbBuffer: DWORD; lpvBuffer: Pointer; lpmat2: PMat2): DWORD; stdcall;
-
- GetCharacterPlacementW: function(DC: HDC; Str: PWideChar; Count, MaxExtent: Integer; Result: PGCPResultsW; Flags: DWORD): DWORD; stdcall;
- GetFontData: function(DC: HDC; TableName, Offset: DWORD; Buffer: Pointer; Data: DWORD): DWORD; stdcall;
-
- CreateCompatibleDC: function(DC: HDC): HDC; stdcall;
- DeleteDC: function(DC: HDC): Boolean; stdcall;
- SelectObject: function(DC: HDC; p2: HGDIOBJ): HGDIOBJ; stdcall;
- DeleteObject: function(p1: HGDIOBJ): Boolean; stdcall;
-
- GetLocaleInfoA: function(Locale: DWORD; LCType: DWORD; lpLCData: pAnsiChar; cchData: Integer): Integer; stdcall;
-
- GetOutlineTextMetricsW: function(DC: HDC; p2: LongWord; var OTMetricStructs: TOutlineTextmetricW): LongWord; stdcall;
-
-
-// *** SDL globals ***
-function Init_SDL: Boolean;
-procedure Quit_SDL;
-
-type
- PSDL_Color = ^TSDL_Color;
- TSDL_Color = record
- r: Byte;
- g: Byte;
- b: Byte;
- unused: Byte;
- end;
-
- TSDL_Rect = record
- X: Smallint;
- Y: Smallint;
- Width: Word;
- Height: Word;
- end;
-
- PSDL_ColorArray = ^TSDL_ColorArray;
- TSDL_ColorArray = array[0..65000] of TSDL_Color;
-
- PSDL_Palette = ^TSDL_Palette;
- TSDL_Palette = record
- ncolors: Integer;
- colors: PSDL_ColorArray;
- end;
-
- PSDL_PixelFormat = ^TSDL_PixelFormat;
- TSDL_PixelFormat = record
- Palette: PSDL_Palette;
- BitsPerPixel: Byte;
- BytesPerPixel: Byte;
- Rloss: Byte;
- Gloss: Byte;
- Bloss: Byte;
- Aloss: Byte;
- Rshift: Byte;
- Gshift: Byte;
- Bshift: Byte;
- Ashift: Byte;
- RMask: Cardinal;
- GMask: Cardinal;
- BMask: Cardinal;
- AMask: Cardinal;
- Colorkey: Cardinal;
- Alpha: Byte;
- end;
-
-
- PSDL_Surface = ^TSDL_Surface;
- TSDL_Surface = record
- Flags: Cardinal;
- Format: PSDL_PixelFormat;
- Width: Integer;
- Height: Integer;
- Pitch: Word;
- Pixels: Pointer;
- Offset: Integer;
- HWDdata: Pointer;
- ClipRect: TSDL_Rect;
- Unused1: Cardinal;
- Locked: Cardinal;
- Blitmap: Pointer;
- FormatVersion: Cardinal;
- RefCount: Integer;
- end;
-
-
-const
- {$IFDEF WINDOWS}
- LIB_SDL = 'SDL.dll';
- {$ELSE}
- LIB_SDL = 'libSDL.so';
- LIB_SDL_VERSION = 'libSDL-1.2.so.0';
- {$ENDIF}
-
- SDL_SWSURFACE = $00000000;
-
-var
- Library_SDL: Pointer;
-
- SDL_FreeSurface: procedure(surface: PSDL_Surface); cdecl;
- SDL_ConvertSurface: function(Source: PSDL_Surface; Format: PSDL_PixelFormat; flags: Cardinal): PSDL_Surface; cdecl;
-
-
-
-// *** SDL_TTF ***
-function Init_SDL_TTF: Boolean;
-procedure Quit_SDL_TTF;
-
-type
- PTTF_Font = ^TTTF_font;
- TTTF_Font = record end;
-
-
-const
- {$IFDEF WINDOWS}
- LIB_SDL_TTF = 'SDL_ttf.dll';
- {$ELSE}
- LIB_SDL_TTF = 'libSDL_ttf.so';
- LIB_SDL_TTF_VERSION = 'libSDL_ttf-2.0.so.0';
- {$ENDIF}
-
- TTF_STYLE_NORMAL = $00;
- TTF_STYLE_BOLD = $01;
- TTF_STYLE_ITALIC = $02;
-// TTF_STYLE_UNDERLINE = $04;
-
-// ZERO WIDTH NO-BREAKSPACE (Unicode byte order mark)
-// UNICODE_BOM_NATIVE = $FEFF;
-// UNICODE_BOM_SWAPPED = $FFFE;
-
-var
- SDL_TTF_initialized: Boolean;
- Library_SDL_TTF: Pointer;
-
- TTF_Init: function: Integer; cdecl;
- TTF_WasInit: function: Integer; cdecl;
- TTF_OpenFont: function(const Filename: pAnsiChar; PTSize: Integer): PTTF_Font; cdecl;
- TTF_CloseFont: procedure(Font: PTTF_Font); cdecl;
-
- TTF_GetFontStyle: function(Font: PTTF_Font): Integer; cdecl;
- TTF_SetFontStyle: procedure(Font: PTTF_Font; Style: Integer); cdecl;
-
- TTF_FontAscent: function(Font: PTTF_Font) : Integer; cdecl;
- TTF_FontDescent: function(Font: PTTF_Font) : Integer; cdecl;
- TTF_FontLineSkip: function(Font: PTTF_Font): Integer; cdecl;
- TTF_FontFaceIsFixedWidth: function(Font: PTTF_Font): Integer; cdecl;
- TTF_FontFaceFamilyName: function(Font: PTTF_Font): pAnsiChar; cdecl;
- TTF_FontFaceStyleName: function(Font : PTTF_Font): pAnsiChar; cdecl;
- TTF_GlyphMetrics: function(Font: PTTF_Font; CharCode: WORD; var MinX: Integer; var MaxX: Integer; var MinY: Integer; var MaxY: Integer; var Advance: Integer): Integer; cdecl;
-
- TTF_RenderGlyph_Solid: function(Font: PTTF_Font; Char: WORD; const ForeGround: TSDL_Color): PSDL_Surface; cdecl;
- TTF_RenderGlyph_Shaded: function(Font: PTTF_Font; Char: WORD; const ForeGround: TSDL_Color; const BackGround: TSDL_Color): PSDL_Surface; cdecl;
-
-
-
-// *** SDL_IMAGE ***
-function Init_SDL_IMAGE: Boolean;
-procedure Quit_SDL_IMAGE;
-
-const
- {$IFDEF WINDOWS}
- LIB_SDL_IMAGE = 'SDL_Image.dll';
- {$ELSE}
- LIB_SDL_IMAGE = 'libSDL_image.so';
- LIB_SDL_IMAGE_VERSION = 'libSDL_image-1.2.so.0';
- {$ENDIF}
-
-var
- SDL_IMAGE_initialized: Boolean;
- Library_SDL_IMAGE: Pointer;
-
- IMG_Load: function(const _file: PAnsiChar): PSDL_Surface; cdecl;
-
-
-implementation
-
-
-function GetLibraryProc(hLibrary: Pointer; ProcName: pAnsiChar): Pointer;
-begin
- {$IFDEF WINDOWS}
- Result := GetProcAddress(hLibrary, ProcName);
- {$ELSE}
- Result := dlsym(hLibrary, ProcName);
- {$ENDIF}
-end;
-
-
-function GetOpenGLLibraryProc(hLibrary: Pointer; ProcName: pAnsiChar): Pointer;
-begin
- Result := GetLibraryProc(hLibrary, ProcName);
-end;
-
-
-// *** OpenGL ***
-
-function Init_OpenGL: Boolean;
-begin
- if Library_OpenGL = nil then begin
- {$IFDEF WINDOWS}
- Library_OpenGL := LoadLibrary(LIB_OPENGL);
- {$ELSE}
- Library_OpenGL := dlopen(LIB_OPENGL, RTLD_LAZY);
- {$ENDIF}
- end;
-
- if Library_OpenGL <> nil then begin
- glEnable := GetOpenGLLibraryProc(Library_OpenGL, 'glEnable');
- glDisable := GetOpenGLLibraryProc(Library_OpenGL, 'glDisable');
- glColor4f := GetOpenGLLibraryProc(Library_OpenGL, 'glColor4f');
- glGenTextures := GetOpenGLLibraryProc(Library_OpenGL, 'glGenTextures');
- glDeleteTextures := GetOpenGLLibraryProc(Library_OpenGL, 'glDeleteTextures');
- glBindTexture := GetOpenGLLibraryProc(Library_OpenGL, 'glBindTexture');
- glTexParameteri := GetOpenGLLibraryProc(Library_OpenGL, 'glTexParameteri');
- glTexImage2D := GetOpenGLLibraryProc(Library_OpenGL, 'glTexImage2D');
- glTexSubImage2D := GetOpenGLLibraryProc(Library_OpenGL, 'glTexSubImage2D');
- glBegin := GetOpenGLLibraryProc(Library_OpenGL, 'glBegin');
- glEnd := GetOpenGLLibraryProc(Library_OpenGL, 'glEnd');
- glTexCoord2f := GetOpenGLLibraryProc(Library_OpenGL, 'glTexCoord2f');
- glTexCoord2fv := GetOpenGLLibraryProc(Library_OpenGL, 'glTexCoord2fv');
- glVertex2f := GetOpenGLLibraryProc(Library_OpenGL, 'glVertex2f');
- glVertex2fv := GetOpenGLLibraryProc(Library_OpenGL, 'glVertex2fv');
- glVertex2iv := GetOpenGLLibraryProc(Library_OpenGL, 'glVertex2iv');
- glGenLists := GetOpenGLLibraryProc(Library_OpenGL, 'glGenLists');
- glDeleteLists := GetOpenGLLibraryProc(Library_OpenGL, 'glDeleteLists');
- glCallList := GetOpenGLLibraryProc(Library_OpenGL, 'glCallList');
- glNewList := GetOpenGLLibraryProc(Library_OpenGL, 'glNewList');
- glEndList := GetOpenGLLibraryProc(Library_OpenGL, 'glEndList');
- end;
-
- OpenGL_initialized :=
- (Addr(glEnable) <> nil) and
- (Addr(glDisable) <> nil) and
- (Addr(glColor4f) <> nil) and
- (Addr(glGenTextures) <> nil) and
- (Addr(glDeleteTextures) <> nil) and
- (Addr(glBindTexture) <> nil) and
- (Addr(glTexParameteri) <> nil) and
- (Addr(glTexImage2D) <> nil) and
- (Addr(glTexSubImage2D) <> nil) and
- (Addr(glBegin) <> nil) and
- (Addr(glEnd) <> nil) and
- (Addr(glTexCoord2f) <> nil) and
- (Addr(glTexCoord2fv) <> nil) and
- (Addr(glVertex2f) <> nil) and
- (Addr(glVertex2fv) <> nil) and
- (Addr(glVertex2iv) <> nil) and
- (Addr(glGenLists) <> nil) and
- (Addr(glDeleteLists) <> nil) and
- (Addr(glCallList) <> nil) and
- (Addr(glNewList) <> nil) and
- (Addr(glEndList) <> nil);
-
- Result := OpenGL_initialized;
-end;
-
-
-procedure Quit_OpenGL;
-begin
- glEnable := nil;
- glDisable := nil;
- glColor4f := nil;
- glGenTextures := nil;
- glDeleteTextures := nil;
- glBindTexture := nil;
- glTexParameteri := nil;
- glTexImage2D := nil;
- glTexSubImage2D := nil;
- glBegin := nil;
- glEnd := nil;
- glTexCoord2f := nil;
- glTexCoord2fv := nil;
- glVertex2f := nil;
- glVertex2fv := nil;
- glVertex2iv := nil;
- glGenLists := nil;
- glDeleteLists := nil;
- glCallList := nil;
- glNewList := nil;
- glEndList := nil;
-
- if Library_OpenGL <> nil then begin
- {$IFDEF WINDOWS}
- FreeLibrary(Library_OpenGL);
- Library_OpenGL := nil;
- {$ELSE}
- dlclose(Library_OpenGL);
- Library_OpenGL := nil;
- {$ENDIF}
- end;
-
- OpenGL_initialized := False;
-end;
-
-
-// *** Windows GDI globals ***
-function Init_GDI: Boolean;
-begin
- if Library_GDI32 = nil then begin
- {$IFDEF WINDOWS}
- Library_GDI32 := LoadLibrary(LIB_GDI32);
-// {$ELSE}
-// Library_GDI32 := nil; //dlopen(LIB_GDI, RTLD_LAZY);
- {$ENDIF}
- end;
-
- if Library_GDI32 <> nil then begin
- CreateFontIndirectA := GetLibraryProc(Library_GDI32, 'CreateFontIndirectA');
-
- AddFontResourceA := GetLibraryProc(Library_GDI32, 'AddFontResourceA');
- AddFontResourceExA := GetLibraryProc(Library_GDI32, 'AddFontResourceExA');
- AddFontMemResourceEx := GetLibraryProc(Library_GDI32, 'AddFontMemResourceEx');
- RemoveFontResourceA := GetLibraryProc(Library_GDI32, 'RemoveFontResourceA');
- RemoveFontResourceExA := GetLibraryProc(Library_GDI32, 'RemoveFontResourceExA');
- RemoveFontMemResourceEx := GetLibraryProc(Library_GDI32, 'RemoveFontMemResourceEx');
-
- GetTextMetricsW := GetLibraryProc(Library_GDI32, 'GetTextMetricsW');
- GetGlyphOutlineA := GetLibraryProc(Library_GDI32, 'GetGlyphOutlineA');
-
- GetCharacterPlacementW := GetLibraryProc(Library_GDI32, 'GetCharacterPlacementW');
- GetFontData := GetLibraryProc(Library_GDI32, 'GetFontData');
-
- CreateCompatibleDC := GetLibraryProc(Library_GDI32, 'CreateCompatibleDC');
- DeleteDC := GetLibraryProc(Library_GDI32, 'DeleteDC');
- SelectObject := GetLibraryProc(Library_GDI32, 'SelectObject');
- DeleteObject := GetLibraryProc(Library_GDI32, 'DeleteObject');
-
- GetOutlineTextMetricsW := GetLibraryProc(Library_GDI32, 'GetOutlineTextMetricsW');
- end;
-
- if Library_KERNEL32 = nil then begin
- {$IFDEF WINDOWS}
- Library_KERNEL32 := LoadLibrary(LIB_KERNEL32);
- {$ENDIF}
- end;
-
- if Library_KERNEL32 <> nil then begin
- GetLocaleInfoA := GetLibraryProc(Library_KERNEL32, 'GetLocaleInfoA');
- end;
-
- GDI_initialized :=
- (Addr(CreateFontIndirectA) <> nil) and
-
- ((Addr(AddFontResourceA) <> nil) or
- (Addr(AddFontResourceExA) <> nil)) and
-
- ((Addr(RemoveFontResourceA) <> nil) or
- (Addr(RemoveFontResourceExA) <> nil)) and
-
- (Addr(GetTextMetricsW) <> nil) and
- (Addr(GetGlyphOutlineA) <> nil) and
-
-// under 9x GetCharacterPlacementW dosn't exist
- (Addr(GetCharacterPlacementW) <> nil) and
- (Addr(GetFontData) <> nil) and
-
- (Addr(CreateCompatibleDC) <> nil) and
- (Addr(DeleteDC) <> nil) and
- (Addr(SelectObject) <> nil) and
- (Addr(DeleteObject) <> nil) and
-
- (Addr(GetLocaleInfoA) <> nil) and
-
- (Addr(GetOutlineTextMetricsW) <> nil);
-
- Result := GDI_initialized;
-end;
-
-
-procedure Quit_GDI;
-begin
- CreateFontIndirectA := nil;
- AddFontResourceA := nil;
- AddFontResourceExA := nil;
- RemoveFontResourceA := nil;
- RemoveFontResourceExA := nil;
- GetTextMetricsW := nil;
- GetGlyphOutlineA := nil;
- GetCharacterPlacementW := nil;
- GetFontData := nil;
- CreateCompatibleDC := nil;
- DeleteDC := nil;
- SelectObject := nil;
- DeleteObject := nil;
-
- if Library_GDI32 <> nil then begin
- {$IFDEF WINDOWS}
- FreeLibrary(Library_GDI32);
- Library_GDI32 := nil;
- {$ENDIF}
- end;
-
- GetLocaleInfoA := nil;
-
- if Library_KERNEL32 <> nil then begin
- {$IFDEF WINDOWS}
- FreeLibrary(Library_KERNEL32);
- Library_KERNEL32 := nil;
- {$ENDIF}
- end;
-
- GDI_initialized := False;
-end;
-
-
-// *** SDL globals ***
-function Init_SDL: Boolean;
-begin
- if Library_SDL = nil then begin
- {$IFDEF WINDOWS}
- Library_SDL := LoadLibrary(LIB_SDL);
- {$ELSE}
- Library_SDL := dlopen(LIB_SDL, RTLD_LAZY);
-
- if Library_SDL = nil then
- Library_SDL := dlopen(LIB_SDL_VERSION, RTLD_LAZY);
- {$ENDIF}
- end;
-
- if Library_SDL <> nil then begin
- SDL_FreeSurface := GetLibraryProc(Library_SDL, 'SDL_FreeSurface');
- SDL_ConvertSurface := GetLibraryProc(Library_SDL, 'SDL_ConvertSurface');
- end;
-
- Result :=
- (Addr(SDL_FreeSurface) <> nil) and
- (Addr(SDL_ConvertSurface) <> nil);
-end;
-
-
-procedure Quit_SDL;
-begin
- SDL_FreeSurface := nil;
- SDL_ConvertSurface := nil;
-
- if Library_SDL <> nil then begin
- {$IFDEF WINDOWS}
- FreeLibrary(Library_SDL);
- Library_SDL := nil;
- {$ELSE}
- dlclose(Library_SDL);
- Library_SDL := nil;
- {$ENDIF}
- end;
-end;
-
-
-// *** SDL_TTF ***
-function Init_SDL_TTF: Boolean;
-begin
- if Library_SDL_TTF = nil then begin
- {$IFDEF WINDOWS}
- Library_SDL_TTF := LoadLibrary(LIB_SDL_TTF);
- {$ELSE}
- Library_SDL_TTF := dlopen(LIB_SDL_TTF, RTLD_LAZY);
-
- if Library_SDL_TTF = nil then
- Library_SDL_TTF := dlopen(LIB_SDL_TTF_VERSION, RTLD_LAZY);
- {$ENDIF}
- end;
-
- if Library_SDL_TTF <> nil then begin
- TTF_Init := GetLibraryProc(Library_SDL_TTF, 'TTF_Init');
- TTF_WasInit := GetLibraryProc(Library_SDL_TTF, 'TTF_WasInit');
- TTF_OpenFont := GetLibraryProc(Library_SDL_TTF, 'TTF_OpenFont');
- TTF_CloseFont := GetLibraryProc(Library_SDL_TTF, 'TTF_CloseFont');
- TTF_GetFontStyle := GetLibraryProc(Library_SDL_TTF, 'TTF_GetFontStyle');
- TTF_SetFontStyle := GetLibraryProc(Library_SDL_TTF, 'TTF_SetFontStyle');
- TTF_FontAscent := GetLibraryProc(Library_SDL_TTF, 'TTF_FontAscent');
- TTF_FontDescent := GetLibraryProc(Library_SDL_TTF, 'TTF_FontDescent');
- TTF_FontLineSkip := GetLibraryProc(Library_SDL_TTF, 'TTF_FontLineSkip');
- TTF_FontFaceIsFixedWidth := GetLibraryProc(Library_SDL_TTF, 'TTF_FontFaceIsFixedWidth');
- TTF_FontFaceFamilyName := GetLibraryProc(Library_SDL_TTF, 'TTF_FontFaceFamilyName');
- TTF_FontFaceStyleName := GetLibraryProc(Library_SDL_TTF, 'TTF_FontFaceStyleName');
- TTF_GlyphMetrics := GetLibraryProc(Library_SDL_TTF, 'TTF_GlyphMetrics');
- TTF_RenderGlyph_Solid := GetLibraryProc(Library_SDL_TTF, 'TTF_RenderGlyph_Solid');
- TTF_RenderGlyph_Shaded := GetLibraryProc(Library_SDL_TTF, 'TTF_RenderGlyph_Shaded');
- end;
-
- SDL_TTF_initialized :=
- Init_SDL and
- (Addr(TTF_Init) <> nil) and
- (Addr(TTF_WasInit) <> nil) and
- (Addr(TTF_OpenFont) <> nil) and
- (Addr(TTF_CloseFont) <> nil) and
- (Addr(TTF_GetFontStyle) <> nil) and
- (Addr(TTF_SetFontStyle) <> nil) and
- (Addr(TTF_FontAscent) <> nil) and
- (Addr(TTF_FontDescent) <> nil) and
- (Addr(TTF_FontLineSkip) <> nil) and
- (Addr(TTF_FontFaceIsFixedWidth) <> nil) and
- (Addr(TTF_FontFaceFamilyName) <> nil) and
- (Addr(TTF_FontFaceStyleName) <> nil) and
- (Addr(TTF_GlyphMetrics) <> nil) and
- (Addr(TTF_RenderGlyph_Solid) <> nil) and
- (Addr(TTF_RenderGlyph_Shaded) <> nil);
-
- Result := SDL_TTF_initialized;
-end;
-
-
-procedure Quit_SDL_TTF;
-begin
- TTF_Init := nil;
- TTF_WasInit := nil;
- TTF_OpenFont := nil;
- TTF_CloseFont := nil;
- TTF_GetFontStyle := nil;
- TTF_SetFontStyle := nil;
- TTF_FontAscent := nil;
- TTF_FontDescent := nil;
- TTF_FontLineSkip := nil;
- TTF_FontFaceIsFixedWidth := nil;
- TTF_FontFaceFamilyName := nil;
- TTF_FontFaceStyleName := nil;
- TTF_GlyphMetrics := nil;
- TTF_RenderGlyph_Solid := nil;
- TTF_RenderGlyph_Shaded := nil;
-
- if Library_SDL_TTF <> nil then begin
- {$IFDEF WINDOWS}
- FreeLibrary(Library_SDL_TTF);
- Library_SDL_TTF := nil;
- {$ELSE}
- dlclose(Library_SDl_TTF);
- Library_SDL_TTF := nil;
- {$ENDIF}
- end;
-
- SDL_TTF_initialized := False;
-end;
-
-
-// *** SDL_IMAGE ***
-function Init_SDL_IMAGE: Boolean;
-begin
- if Library_SDL_IMAGE = nil then begin
- {$IFDEF WINDOWS}
- Library_SDL_IMAGE := LoadLibrary(LIB_SDL_IMAGE);
- {$ELSE}
- Library_SDL_IMAGE := dlopen(LIB_SDL_IMAGE, RTLD_LAZY);
-
- if Library_SDL_IMAGE = nil then
- Library_SDL_IMAGE := dlopen(LIB_SDL_IMAGE_VERSION, RTLD_LAZY);
- {$ENDIF}
- end;
-
- if Library_SDL_IMAGE <> nil then begin
- IMG_Load := GetLibraryProc(Library_SDL_IMAGE, 'IMG_Load');
- end;
-
- SDL_IMAGE_initialized :=
- Init_SDL and
- (Addr(IMG_load) <> nil);
-
- Result := SDL_IMAGE_initialized;
-end;
-
-
-procedure Quit_SDL_IMAGE;
-begin
- IMG_Load := nil;
-
- if Library_SDL_IMAGE <> nil then begin
- {$IFDEF WINDOWS}
- FreeLibrary(Library_SDL_IMAGE);
- Library_SDL_IMAGE := nil;
- {$ELSE}
- dlclose(Library_SDL_IMAGE);
- Library_SDL_IMAGE := nil;
- {$ENDIF}
- end;
-end;
-
-end.
diff --git a/old/TextSuiteOptions.inc b/old/TextSuiteOptions.inc
deleted file mode 100644
index fe761ca..0000000
--- a/old/TextSuiteOptions.inc
+++ /dev/null
@@ -1,46 +0,0 @@
-
-{ *** options *** }
-
-{ to use the external library }
-{.$define TS_EXTERN_STATIC}
-
-
-{ to disable the assembler code and use pure pascal code instead.
- if you have problem with some older compiler or runtime errors.
- But. This can decrease the speed of some operations. }
-{.$define TS_PURE_PASCAL}
-
-
-
-{ *** important seetings. Don't touch it! *** }
-{$IFDEF FPC}
- {$MODE Delphi}
-
- {$SMARTLINK ON}
-
- {$IFDEF CPUI386}
- {$DEFINE CPU386}
- {$ASMMODE INTEL}
- {$ELSE}
- {$define TS_PURE_PASCAL}
- {$ENDIF}
-
- {$IFNDEF WINDOWS}
- {$LINKLIB c}
- {$ENDIF}
-{$ENDIF}
-
-
-{$BOOLEVAL OFF} // short boolean eval
-{$LONGSTRINGS ON} // huge strings
-{$EXTENDEDSYNTAX ON} // extended syntax
-{$ALIGN ON} // Alignment
-{$TYPEDADDRESS OFF} // Typed addresses with @
-
-{$IFNDEF FPC}
- {$OPTIMIZATION ON} // O+ Optimizations
- { $ASSERTIONS OFF} // C-
- { $RANGECHECKS OFF} // R-
- { $STACKFRAMES OFF} // W-
- { $OVERFLOWCHECKS OFF} // Q-
-{$ENDIF}
diff --git a/old/TextSuitePostProcess.pas b/old/TextSuitePostProcess.pas
deleted file mode 100644
index 2486265..0000000
--- a/old/TextSuitePostProcess.pas
+++ /dev/null
@@ -1,398 +0,0 @@
-{
-TextSuite (C) Steffen Xonna (aka Lossy eX)
-http://www.opengl24.de/
------------------------------------------------------------------------
-For copyright informations see file copyright.txt.
-}
-
-{$I TextSuiteOptions.inc}
-
-unit TextSuitePostProcess;
-
-interface
-
-uses
- TextSuite,
- TextSuiteClasses;
-
-
-type
- // ** Post Processing FillColor **
- TtsPostFillColor = class(TtsPostProcessStep)
- protected
- fRed: Single;
- fGreen: Single;
- fBlue: Single;
- fAlpha: Single;
- fLuminance: Single;
- fChannelMask: tsBitmask;
-
- fModes: TtsImageModes;
-
- procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
- public
- constructor Create(Red, Green, Blue, Alpha: Single; ChannelMask: tsBitmask; Modes: TtsImageModes);
- end;
-
-
- // ** Post Processing FillPattern **
- TtsPostFillPattern = class(TtsPostProcessStep)
- protected
- fPattern: TtsImage;
- fX: Integer;
- fY: Integer;
- fChannelMask: tsBitmask;
- fModes: TtsImageModes;
-
- procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
- public
- constructor Create(Pattern: TtsImage; X, Y: Integer; ChannelMask: tsBitmask; Modes: TtsImageModes);
- end;
-
-
- // ** Post Processing Border **
- TtsPostBorderLookupFuncData = record
- Kernel: TtsKernel2D;
- XPos, YPos, XMax, YMax: Integer;
-
- pData: pByte;
- end;
-
-
- TtsPostBorder = class(TtsPostProcessStep)
- protected
- fKernel: TtsKernel2D;
-
- fRed: Single;
- fGreen: Single;
- fBlue: Single;
- fAlpha: Single;
-
- procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
- public
- constructor Create(Width, Strength: Single; Red, Green, Blue, Alpha: Single);
- destructor Destroy; override;
- end;
-
- // ** Post Processing Kerning **
- TtsPostKerning = class(TtsPostProcessStep)
- protected
- procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
- end;
-
-
- // ** Post Processing Shadow **
- TtsPostShadow = class(TtsPostProcessStep)
- protected
- fKernel: TtsKernel1D;
-
- fX: Integer;
- fY: Integer;
-
- fRed: Single;
- fGreen: Single;
- fBlue: Single;
- fAlpha: Single;
-
- procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
- public
- constructor Create(Radius: Single; X, Y: Integer; Red, Green, Blue, Alpha: Single);
- destructor Destroy; override;
- end;
-
-
- // ** Post Processing Custom **
- TtsPostCustom = class(TtsPostProcessStep)
- protected
- fContext: TtsContext;
- fPostProcessProc: tsPostProcessProc;
- fData: Pointer;
-
- procedure PostProcess(const CharImage: TtsImage; const Char: TtsChar); override;
- public
- constructor Create(Context: TtsContext; PostProcessProc: tsPostProcessProc; Data: Pointer);
- end;
-
-
-implementation
-
-//uses
-// TextSuiteImageUtils;
-
-
-{ TtsPostFillColor }
-
-constructor TtsPostFillColor.Create(Red, Green, Blue, Alpha: Single; ChannelMask: tsBitmask; Modes: TtsImageModes);
-begin
- inherited Create;
-
- fRed := Red;
- fGreen := Green;
- fBlue := Blue;
- fAlpha := Alpha;
- fChannelMask := ChannelMask;
- fModes := Modes;
-end;
-
-
-procedure TtsPostFillColor.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
-begin
- if CharImage <> nil then
- CharImage.FillColor(fRed, fGreen, fBlue, fAlpha, fChannelMask, fModes);
-end;
-
-
-{ TtsPostFillPattern }
-
-constructor TtsPostFillPattern.Create(Pattern: TtsImage; X, Y: Integer; ChannelMask: tsBitmask; Modes: TtsImageModes);
-begin
- inherited Create;
-
- fPattern := Pattern;
- fX := X;
- fY := Y;
- fChannelMask := ChannelMask;
- fModes := Modes;
-end;
-
-
-procedure TtsPostFillPattern.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
-begin
- if CharImage <> nil then
- CharImage.FillPattern(fPattern, fX, fY, fChannelMask, fModes);
-end;
-
-
-
-{ TtsPostBorder }
-
-constructor TtsPostBorder.Create(Width, Strength, Red, Green, Blue, Alpha: Single);
-begin
- inherited Create;
-
- fKernel := TtsKernel2D.Create(Width, Strength);
-
- fRed := Red;
- fGreen := Green;
- fBlue := Blue;
- fAlpha := Alpha;
-end;
-
-
-function BorderLookupMax(var Data: TtsPostBorderLookupFuncData): Byte;
-var
- Idx: Integer;
- Temp, TempValue: Single;
- pTempData: pByte;
-begin
- TempValue := 0;
-
- with Data, Data.Kernel do begin
- for Idx := 0 to ItemCount - 1 do
- with Items[Idx] do
- if ((XPos + OffsetX >= 0) and (XPos + OffsetX < XMax) and
- (YPos + OffsetY >= 0) and (YPos + OffsetY < YMax)) then begin
- pTempData := pData;
-
- Inc(pTempData, DataOffset);
-
- // there is no value
- if pTempData^ = $00 then
- Continue;
-
- // calculate pixel
- Temp := pTempData^ * Value;
- if (Temp > TempValue) then
- TempValue := Temp;
-
- // there is nothing greater than this
- if pTempData^ = $FF then
- Break;
- end;
- end;
-
- Result := Round(TempValue);
-end;
-
-
-destructor TtsPostBorder.Destroy;
-begin
- fKernel.Free;
-
- inherited;
-end;
-
-
-procedure TtsPostBorder.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
-var
- OriginalImage: TtsImage;
-
- X, Y: Integer;
- pSource, pDest: ptsColor;
-
- Data: TtsPostBorderLookupFuncData;
-begin
- if CharImage <> nil then begin
- // Make image geater
- CharImage.Resize(CharImage.Width + fKernel.SizeX * 2, CharImage.Height + fKernel.SizeY * 2, fKernel.SizeX, fKernel.SizeY);
-
- // Create copy of Image
- OriginalImage := TtsImage.Create;
- try
- OriginalImage.AssignFrom(CharImage);
- CharImage.FillColor(fRed, fGreen, fBlue, fAlpha, TS_CHANNELS_RGBA, cModesReplace);
-
- fKernel.UpdateDataOffset(4, OriginalImage.Width * 4);
-
- Data.Kernel := fKernel;
- Data.XMax := OriginalImage.Width;
- Data.YMax := OriginalImage.Height;
-
- for Y := 0 to OriginalImage.Height - 1 do begin
- pSource := OriginalImage.ScanLine[Y];
- pDest := CharImage.ScanLine[Y];
-
- Data.pData := @(pSource^.Alpha);
- Data.YPos := Y;
-
- for X := 0 to OriginalImage.Width - 1 do begin
- Data.XPos := X;
-
- pDest^.Alpha := Round(fAlpha * BorderLookupMax(Data));
-
- Inc(Data.pData, 4);
- Inc(pDest);
- end;
- end;
-
- // Blend OriginalImage over CharImage (shadow)
- CharImage.BlendImage(OriginalImage, 0, 0);
- finally
- OriginalImage.Free;
- end;
- end;
-
- // Set Char Data
- Char.GlyphRect.Left := Char.GlyphRect.Left + fKernel.SizeX - fKernel.MidSizeX;
- Char.GlyphRect.Right := Char.GlyphRect.Right + fKernel.SizeX + fKernel.MidSizeX;
-
- Char.GlyphRect.Top := Char.GlyphRect.Top + fKernel.SizeY - fKernel.MidSizeY;
- Char.GlyphRect.Bottom := Char.GlyphRect.Bottom + fKernel.SizeY + fKernel.MidSizeY;
-
- Char.GlyphOriginY := Char.GlyphOriginY + fKernel.MidSizeY;
- Char.Advance := Char.Advance + fKernel.MidSizeX;
-end;
-
-
-{ TtsPostKerning }
-
-procedure TtsPostKerning.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
-begin
-// if CharImage <> nil then
-// Char.CalculateKerningData(CharImage);
-end;
-
-
-{ TtsPostShadow }
-
-constructor TtsPostShadow.Create(Radius: Single; X, Y: Integer; Red, Green, Blue, Alpha: Single);
-begin
- inherited Create;
-
- fKernel := TtsKernel1D.Create(Radius, 0);
-
- fX := X;
- fY := Y;
- fRed := Red;
- fGreen := Green;
- fBlue := Blue;
- fAlpha := Alpha;
-end;
-
-
-destructor TtsPostShadow.Destroy;
-begin
- fKernel.Free;
-
- inherited;
-end;
-
-
-procedure TtsPostShadow.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
-var
- OriginalImage: TtsImage;
- TempX, TempY: Integer;
-begin
- if CharImage <> nil then begin
- OriginalImage := TtsImage.Create;
- try
- // backup to original
- OriginalImage.AssignFrom(CharImage);
-
- // Resizing image
- CharImage.Resize(CharImage.Width + fKernel.Size * 2, CharImage.Height + fKernel.Size * 2, fKernel.Size, fKernel.Size);
-
- // fill char image with color
- CharImage.FillColor(fRed, fGreen, fBlue, fAlpha, TS_CHANNELS_RGBA, cModesNormal);
-
- // blur charimage
- CharImage.Blur(fKernel, fKernel, TS_CHANNEL_ALPHA);
-
- TempX := fKernel.Size - fX;
- TempY := fKernel.Size - fY;
-
- // Blend OriginalImage over CharImage (shadow)
- CharImage.BlendImage(OriginalImage, TempX, TempY);
-
- // Set Chardimension
- with Char.GlyphRect do begin
- if TempX > 0 then begin
- Left := Left + TempX;
- Right := Right + TempX;
- end;
-
- if TempY > 0 then begin
- Top := Top + TempY;
- Bottom := Bottom + TempY;
- end;
- end;
- finally
- OriginalImage.Free;
- end;
- end;
-end;
-
-
-{ TtsPostCustom }
-
-constructor TtsPostCustom.Create(Context: TtsContext; PostProcessProc: tsPostProcessProc; Data: Pointer);
-begin
- inherited Create;
-
- fContext := Context;
- fPostProcessProc := PostProcessProc;
- fData := Data;
-end;
-
-
-procedure TtsPostCustom.PostProcess(const CharImage: TtsImage; const Char: TtsChar);
-var
- ImageID: tsImageID;
-begin
- if CharImage <> nil then begin
- if fContext <> nil then begin
- // temporary Add Image
- ImageID := fContext.ImageAdd(CharImage);
- try
- fPostProcessProc(ImageID, Char.CharCode, fData);
- finally
- fContext.ImageDelete(ImageID);
- end;
- end;
- end
- // call without an ImageID
- else fPostProcessProc(0, Char.CharCode, fData);
-end;
-
-
-end.
diff --git a/old/TextSuiteTTFUtils.pas b/old/TextSuiteTTFUtils.pas
deleted file mode 100644
index a7253b0..0000000
--- a/old/TextSuiteTTFUtils.pas
+++ /dev/null
@@ -1,367 +0,0 @@
-{
-TextSuite (C) Steffen Xonna (aka Lossy eX)
-http://www.opengl24.de/
------------------------------------------------------------------------
-For copyright informations see file copyright.txt.
-}
-
-{$WARNINGS OFF}
-{$HINTS OFF}
-
-{$I TextSuiteOptions.inc}
-
-unit TextSuiteTTFUtils;
-
-interface
-
-uses Classes;
-
-const
- NAME_ID_COPYRIGHT = 0;
- NAME_ID_FACE_NAME = 1;
- NAME_ID_STYLE_NAME = 2;
- NAME_ID_FULL_NAME = 4;
-
-
-
- function MakeTTTableName(ch1, ch2, ch3, ch4: Char): Cardinal;
- function GetTTString(pBuffer: Pointer; BufferSize: Integer; NameID, LanguageID: Cardinal; var Text: AnsiString): Boolean;
-
- function GetTTFontFullNameFromStream(Stream: TStream; LanguageID: Cardinal): AnsiString;
- function GetTTFontFullNameFromFile(Filename: AnsiString; LanguageID: Cardinal): AnsiString;
-
-(*
- function GetTTUnicodeGlyphIndex(DC: Cardinal; ch: Word): Word;
- function GetTTUnicodeCharCount(DC: Cardinal): Word;
-*)
-
-implementation
-
-
-uses
- SysUtils,
- TextSuiteWideUtils,
- TextSuiteImports;
-
-
-function SWAPWORD(x: Word): Word;
-{$ifdef TS_PURE_PASCAL}
-begin
- Result := x and $FF;
- Result := Result shl 8;
- Result := Result or (x shr 8);
-{$else}
-asm
- mov dl, al
- mov al, ah
- mov ah, dl
-{$endif}
-end;
-
-
-function SWAPLONG(x: Cardinal): Cardinal;
-{$ifdef TS_PURE_PASCAL}
-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;
-{$else}
-asm
- mov dx, ax
- shr eax, 16
- mov cx, ax
- mov al, dh
- mov ah, dl
- shl eax, 16
- mov al, ch
- mov ah, cl
-{$endif}
-end;
-
-
-function MakeTTTableName(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;
-
-
-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 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, 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, 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 GetTTString(pBuffer: Pointer; BufferSize: Integer; NameID, LanguageID: Cardinal; var Text: AnsiString): 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, 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): AnsiString;
-var
- TableName: Cardinal;
- Buffer: Pointer;
- BufferSize: Integer;
-begin
- TableName := MakeTTTableName('n', 'a', 'm', 'e');
-
- 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(Filename: AnsiString; LanguageID: Cardinal): AnsiString;
-var
- fs: TFileStream;
-begin
- fs := TFileStream.Create(String(Filename), fmOpenRead or fmShareDenyWrite);
- try
- result := GetTTFontFullNameFromStream(fs, LanguageID);
- finally
- fs.Free;
- end;
-end;
-
-end.
diff --git a/old/TextSuiteVersion.pas b/old/TextSuiteVersion.pas
deleted file mode 100644
index a27d1b5..0000000
--- a/old/TextSuiteVersion.pas
+++ /dev/null
@@ -1,13 +0,0 @@
-unit TextSuiteVersion;
-
-interface
-
-const
- TS_MAYOR_VERSION = 0;
- TS_MINOR_VERSION = 8;
- TS_BUILD_NUMBER = 1;
- TS_VERSION_STR = '0.8.1';
-
-implementation
-
-end.
\ No newline at end of file
diff --git a/old/TextSuiteWideUtils.pas b/old/TextSuiteWideUtils.pas
deleted file mode 100644
index af51fdc..0000000
--- a/old/TextSuiteWideUtils.pas
+++ /dev/null
@@ -1,1394 +0,0 @@
-{
-TextSuite (C) Steffen Xonna (aka Lossy eX)
-http://www.opengl24.de/
------------------------------------------------------------------------
-For copyright informations see file copyright.txt.
-}
-
-{$I TextSuiteOptions.inc}
-
-
-unit TextSuiteWideUtils;
-
-interface
-
-type
- PtsCodePage = ^TtsCodePage;
- TtsCodePage = array [AnsiChar] of word;
-
- TtsAnsiToWideCharFunc = procedure(pDest: pWideChar; pSource: pAnsiChar; pCodePage: PtsCodePage; DefaultChar: WideChar);
-
-
- // creates an new empty widesting with size +1
- function tsStrAlloc(Size: Cardinal): pWideChar;
- // disposes an existing widestring
- procedure tsStrDispose(pText: pWideChar);
-
- // returns the length of an widestring
- function tsStrLength(pText: pWideChar): Cardinal;
- // copy source until #0 is reached
- function tsStrCopy(pDest, pSource: pWideChar): pWideChar;
-
- // creates an copy from Text but maximum size is the size of the data not
- // of the previous stringsize
- function tsStrNew(pText: pWideChar): pWideChar;
-
- // Anso to WideChat converting functions
- procedure tsAnsiUTF8ToWide(pDest: pWideChar; pSource: pAnsiChar; DefaultChar: WideChar);
-
- procedure tsAnsiISO_8859_1_ToWide(pDest: pWideChar; pSource: pAnsiChar);
-
- procedure tsAnsiSBCDToWide(pDest: pWideChar; pSource: pAnsiChar; pCodePage: PtsCodePage; DefaultChar: WideChar);
- procedure tsAnsiDBCDToWide(pDest: pWideChar; pSource: pAnsiChar; pCodePage: PtsCodePage; DefaultChar: WideChar);
-
-
-
-{ *** Start of code pages *** }
-const
- CP_8859_2 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $0104, $02D8, $0141, $00A4, $013D, $015A, $00A7, $00A8, $0160, $015E, $0164, $0179, $00AD, $017D, $017B,
- $00B0, $0105, $02DB, $0142, $00B4, $013E, $015B, $02C7, $00B8, $0161, $015F, $0165, $017A, $02DD, $017E, $017C,
- $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7, $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E,
- $0110, $0143, $0147, $00D3, $00D4, $0150, $00D6, $00D7, $0158, $016E, $00DA, $0170, $00DC, $00DD, $0162, $00DF,
- $0155, $00E1, $00E2, $0103, $00E4, $013A, $0107, $00E7, $010D, $00E9, $0119, $00EB, $011B, $00ED, $00EE, $010F,
- $0111, $0144, $0148, $00F3, $00F4, $0151, $00F6, $00F7, $0159, $016F, $00FA, $0171, $00FC, $00FD, $0163, $02D9
- );
-
-const
- CP_8859_3 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $0126, $02D8, $00A3, $00A4, $0000, $0124, $00A7, $00A8, $0130, $015E, $011E, $0134, $00AD, $0000, $017B,
- $00B0, $0127, $00B2, $00B3, $00B4, $00B5, $0125, $00B7, $00B8, $0131, $015F, $011F, $0135, $00BD, $0000, $017C,
- $00C0, $00C1, $00C2, $0000, $00C4, $010A, $0108, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
- $0000, $00D1, $00D2, $00D3, $00D4, $0120, $00D6, $00D7, $011C, $00D9, $00DA, $00DB, $00DC, $016C, $015C, $00DF,
- $00E0, $00E1, $00E2, $0000, $00E4, $010B, $0109, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
- $0000, $00F1, $00F2, $00F3, $00F4, $0121, $00F6, $00F7, $011D, $00F9, $00FA, $00FB, $00FC, $016D, $015D, $02D9
- );
-
-const
- CP_8859_4 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $0104, $0138, $0156, $00A4, $0128, $013B, $00A7, $00A8, $0160, $0112, $0122, $0166, $00AD, $017D, $00AF,
- $00B0, $0105, $02DB, $0157, $00B4, $0129, $013C, $02C7, $00B8, $0161, $0113, $0123, $0167, $014A, $017E, $014B,
- $0100, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $012E, $010C, $00C9, $0118, $00CB, $0116, $00CD, $00CE, $012A,
- $0110, $0145, $014C, $0136, $00D4, $00D5, $00D6, $00D7, $00D8, $0172, $00DA, $00DB, $00DC, $0168, $016A, $00DF,
- $0101, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $012F, $010D, $00E9, $0119, $00EB, $0117, $00ED, $00EE, $012B,
- $0111, $0146, $014D, $0137, $00F4, $00F5, $00F6, $00F7, $00F8, $0173, $00FA, $00FB, $00FC, $0169, $016B, $02D9
- );
-
-const
- CP_8859_5 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $0401, $0402, $0403, $0404, $0405, $0406, $0407, $0408, $0409, $040A, $040B, $040C, $00AD, $040E, $040F,
- $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417, $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F,
- $0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427, $0428, $0429, $042A, $042B, $042C, $042D, $042E, $042F,
- $0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437, $0438, $0439, $043A, $043B, $043C, $043D, $043E, $043F,
- $0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447, $0448, $0449, $044A, $044B, $044C, $044D, $044E, $044F,
- $2116, $0451, $0452, $0453, $0454, $0455, $0456, $0457, $0458, $0459, $045A, $045B, $045C, $00A7, $045E, $045F
- );
-
-const
- CP_8859_6 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $0000, $0000, $0000, $00A4, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $060C, $00AD, $0000, $0000,
- $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $061B, $0000, $0000, $0000, $061F,
- $0000, $0621, $0622, $0623, $0624, $0625, $0626, $0627, $0628, $0629, $062A, $062B, $062C, $062D, $062E, $062F,
- $0630, $0631, $0632, $0633, $0634, $0635, $0636, $0637, $0638, $0639, $063A, $0000, $0000, $0000, $0000, $0000,
- $0640, $0641, $0642, $0643, $0644, $0645, $0646, $0647, $0648, $0649, $064A, $064B, $064C, $064D, $064E, $064F,
- $0650, $0651, $0652, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000
- );
-
-const
- CP_8859_7 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $2018, $2019, $00A3, $20AC, $20AF, $00A6, $00A7, $00A8, $00A9, $037A, $00AB, $00AC, $00AD, $0000, $2015,
- $00B0, $00B1, $00B2, $00B3, $0384, $0385, $0386, $00B7, $0388, $0389, $038A, $00BB, $038C, $00BD, $038E, $038F,
- $0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397, $0398, $0399, $039A, $039B, $039C, $039D, $039E, $039F,
- $03A0, $03A1, $0000, $03A3, $03A4, $03A5, $03A6, $03A7, $03A8, $03A9, $03AA, $03AB, $03AC, $03AD, $03AE, $03AF,
- $03B0, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7, $03B8, $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF,
- $03C0, $03C1, $03C2, $03C3, $03C4, $03C5, $03C6, $03C7, $03C8, $03C9, $03CA, $03CB, $03CC, $03CD, $03CE, $0000
- );
-
-const
- CP_8859_8 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $0000, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, $00A8, $00A9, $00D7, $00AB, $00AC, $00AD, $00AE, $00AF,
- $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00F7, $00BB, $00BC, $00BD, $00BE, $0000,
- $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
- $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $2017,
- $05D0, $05D1, $05D2, $05D3, $05D4, $05D5, $05D6, $05D7, $05D8, $05D9, $05DA, $05DB, $05DC, $05DD, $05DE, $05DF,
- $05E0, $05E1, $05E2, $05E3, $05E4, $05E5, $05E6, $05E7, $05E8, $05E9, $05EA, $0000, $0000, $200E, $200F, $0000
- );
-
-const
- CP_8859_9 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
- $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
- $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
- $011E, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9, $00DA, $00DB, $00DC, $0130, $015E, $00DF,
- $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
- $011F, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, $00F8, $00F9, $00FA, $00FB, $00FC, $0131, $015F, $00FF
- );
-
-const
- CP_8859_10 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $0104, $0112, $0122, $012A, $0128, $0136, $00A7, $013B, $0110, $0160, $0166, $017D, $00AD, $016A, $014A,
- $00B0, $0105, $0113, $0123, $012B, $0129, $0137, $00B7, $013C, $0111, $0161, $0167, $017E, $2015, $016B, $014B,
- $0100, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $012E, $010C, $00C9, $0118, $00CB, $0116, $00CD, $00CE, $00CF,
- $00D0, $0145, $014C, $00D3, $00D4, $00D5, $00D6, $0168, $00D8, $0172, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
- $0101, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $012F, $010D, $00E9, $0119, $00EB, $0117, $00ED, $00EE, $00EF,
- $00F0, $0146, $014D, $00F3, $00F4, $00F5, $00F6, $0169, $00F8, $0173, $00FA, $00FB, $00FC, $00FD, $00FE, $0138
- );
-
-const
- CP_8859_11 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $0E01, $0E02, $0E03, $0E04, $0E05, $0E06, $0E07, $0E08, $0E09, $0E0A, $0E0B, $0E0C, $0E0D, $0E0E, $0E0F,
- $0E10, $0E11, $0E12, $0E13, $0E14, $0E15, $0E16, $0E17, $0E18, $0E19, $0E1A, $0E1B, $0E1C, $0E1D, $0E1E, $0E1F,
- $0E20, $0E21, $0E22, $0E23, $0E24, $0E25, $0E26, $0E27, $0E28, $0E29, $0E2A, $0E2B, $0E2C, $0E2D, $0E2E, $0E2F,
- $0E30, $0E31, $0E32, $0E33, $0E34, $0E35, $0E36, $0E37, $0E38, $0E39, $0E3A, $0000, $0000, $0000, $0000, $0E3F,
- $0E40, $0E41, $0E42, $0E43, $0E44, $0E45, $0E46, $0E47, $0E48, $0E49, $0E4A, $0E4B, $0E4C, $0E4D, $0E4E, $0E4F,
- $0E50, $0E51, $0E52, $0E53, $0E54, $0E55, $0E56, $0E57, $0E58, $0E59, $0E5A, $0E5B, $0000, $0000, $0000, $0000
- );
-
-const
- CP_8859_13 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $201D, $00A2, $00A3, $00A4, $201E, $00A6, $00A7, $00D8, $00A9, $0156, $00AB, $00AC, $00AD, $00AE, $00C6,
- $00B0, $00B1, $00B2, $00B3, $201C, $00B5, $00B6, $00B7, $00F8, $00B9, $0157, $00BB, $00BC, $00BD, $00BE, $00E6,
- $0104, $012E, $0100, $0106, $00C4, $00C5, $0118, $0112, $010C, $00C9, $0179, $0116, $0122, $0136, $012A, $013B,
- $0160, $0143, $0145, $00D3, $014C, $00D5, $00D6, $00D7, $0172, $0141, $015A, $016A, $00DC, $017B, $017D, $00DF,
- $0105, $012F, $0101, $0107, $00E4, $00E5, $0119, $0113, $010D, $00E9, $017A, $0117, $0123, $0137, $012B, $013C,
- $0161, $0144, $0146, $00F3, $014D, $00F5, $00F6, $00F7, $0173, $0142, $015B, $016B, $00FC, $017C, $017E, $2019
- );
-
-const
- CP_8859_14 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $1E02, $1E03, $00A3, $010A, $010B, $1E0A, $00A7, $1E80, $00A9, $1E82, $1E0B, $1EF2, $00AD, $00AE, $0178,
- $1E1E, $1E1F, $0120, $0121, $1E40, $1E41, $00B6, $1E56, $1E81, $1E57, $1E83, $1E60, $1EF3, $1E84, $1E85, $1E61,
- $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
- $0174, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $1E6A, $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $0176, $00DF,
- $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
- $0175, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $1E6B, $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $0177, $00FF
- );
-
-const
- CP_8859_15 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $00A1, $00A2, $00A3, $20AC, $00A5, $0160, $00A7, $0161, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
- $00B0, $00B1, $00B2, $00B3, $017D, $00B5, $00B6, $00B7, $017E, $00B9, $00BA, $00BB, $0152, $0153, $0178, $00BF,
- $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
- $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
- $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
- $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
- );
-
-const
- CP_8859_16 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0080, $0081, $0082, $0083, $0084, $0085, $0086, $0087, $0088, $0089, $008A, $008B, $008C, $008D, $008E, $008F,
- $0090, $0091, $0092, $0093, $0094, $0095, $0096, $0097, $0098, $0099, $009A, $009B, $009C, $009D, $009E, $009F,
- $00A0, $0104, $0105, $0141, $20AC, $201E, $0160, $00A7, $0161, $00A9, $0218, $00AB, $0179, $00AD, $017A, $017B,
- $00B0, $00B1, $010C, $0142, $017D, $201D, $00B6, $00B7, $017E, $010D, $0219, $00BB, $0152, $0153, $0178, $017C,
- $00C0, $00C1, $00C2, $0102, $00C4, $0106, $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
- $0110, $0143, $00D2, $00D3, $00D4, $0150, $00D6, $015A, $0170, $00D9, $00DA, $00DB, $00DC, $0118, $021A, $00DF,
- $00E0, $00E1, $00E2, $0103, $00E4, $0107, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
- $0111, $0144, $00F2, $00F3, $00F4, $0151, $00F6, $015B, $0171, $00F9, $00FA, $00FB, $00FC, $0119, $021B, $00FF
- );
-
-const
- CP_037 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $009C, $0009, $0086, $007F, $0097, $008D, $008E, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $009D, $0085, $0008, $0087, $0018, $0019, $0092, $008F, $001C, $001D, $001E, $001F,
- $0080, $0081, $0082, $0083, $0084, $000A, $0017, $001B, $0088, $0089, $008A, $008B, $008C, $0005, $0006, $0007,
- $0090, $0091, $0016, $0093, $0094, $0095, $0096, $0004, $0098, $0099, $009A, $009B, $0014, $0015, $009E, $001A,
- $0020, $00A0, $00E2, $00E4, $00E0, $00E1, $00E3, $00E5, $00E7, $00F1, $00A2, $002E, $003C, $0028, $002B, $007C,
- $0026, $00E9, $00EA, $00EB, $00E8, $00ED, $00EE, $00EF, $00EC, $00DF, $0021, $0024, $002A, $0029, $003B, $00AC,
- $002D, $002F, $00C2, $00C4, $00C0, $00C1, $00C3, $00C5, $00C7, $00D1, $00A6, $002C, $0025, $005F, $003E, $003F,
- $00F8, $00C9, $00CA, $00CB, $00C8, $00CD, $00CE, $00CF, $00CC, $0060, $003A, $0023, $0040, $0027, $003D, $0022,
- $00D8, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $00AB, $00BB, $00F0, $00FD, $00FE, $00B1,
- $00B0, $006A, $006B, $006C, $006D, $006E, $006F, $0070, $0071, $0072, $00AA, $00BA, $00E6, $00B8, $00C6, $00A4,
- $00B5, $007E, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $00A1, $00BF, $00D0, $00DD, $00DE, $00AE,
- $005E, $00A3, $00A5, $00B7, $00A9, $00A7, $00B6, $00BC, $00BD, $00BE, $005B, $005D, $00AF, $00A8, $00B4, $00D7,
- $007B, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $00AD, $00F4, $00F6, $00F2, $00F3, $00F5,
- $007D, $004A, $004B, $004C, $004D, $004E, $004F, $0050, $0051, $0052, $00B9, $00FB, $00FC, $00F9, $00FA, $00FF,
- $005C, $00F7, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $00B2, $00D4, $00D6, $00D2, $00D3, $00D5,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $00B3, $00DB, $00DC, $00D9, $00DA, $009F
- );
-
-const
- CP_437 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $00C7, $00FC, $00E9, $00E2, $00E4, $00E0, $00E5, $00E7, $00EA, $00EB, $00E8, $00EF, $00EE, $00EC, $00C4, $00C5,
- $00C9, $00E6, $00C6, $00F4, $00F6, $00F2, $00FB, $00F9, $00FF, $00D6, $00DC, $00A2, $00A3, $00A5, $20A7, $0192,
- $00E1, $00ED, $00F3, $00FA, $00F1, $00D1, $00AA, $00BA, $00BF, $2310, $00AC, $00BD, $00BC, $00A1, $00AB, $00BB,
- $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556, $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
- $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B, $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
- $03B1, $00DF, $0393, $03C0, $03A3, $03C3, $00B5, $03C4, $03A6, $0398, $03A9, $03B4, $221E, $03C6, $03B5, $2229,
- $2261, $00B1, $2265, $2264, $2320, $2321, $00F7, $2248, $00B0, $2219, $00B7, $221A, $207F, $00B2, $25A0, $00A0
- );
-
-const
- CP_500 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $009C, $0009, $0086, $007F, $0097, $008D, $008E, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $009D, $0085, $0008, $0087, $0018, $0019, $0092, $008F, $001C, $001D, $001E, $001F,
- $0080, $0081, $0082, $0083, $0084, $000A, $0017, $001B, $0088, $0089, $008A, $008B, $008C, $0005, $0006, $0007,
- $0090, $0091, $0016, $0093, $0094, $0095, $0096, $0004, $0098, $0099, $009A, $009B, $0014, $0015, $009E, $001A,
- $0020, $00A0, $00E2, $00E4, $00E0, $00E1, $00E3, $00E5, $00E7, $00F1, $005B, $002E, $003C, $0028, $002B, $0021,
- $0026, $00E9, $00EA, $00EB, $00E8, $00ED, $00EE, $00EF, $00EC, $00DF, $005D, $0024, $002A, $0029, $003B, $005E,
- $002D, $002F, $00C2, $00C4, $00C0, $00C1, $00C3, $00C5, $00C7, $00D1, $00A6, $002C, $0025, $005F, $003E, $003F,
- $00F8, $00C9, $00CA, $00CB, $00C8, $00CD, $00CE, $00CF, $00CC, $0060, $003A, $0023, $0040, $0027, $003D, $0022,
- $00D8, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $00AB, $00BB, $00F0, $00FD, $00FE, $00B1,
- $00B0, $006A, $006B, $006C, $006D, $006E, $006F, $0070, $0071, $0072, $00AA, $00BA, $00E6, $00B8, $00C6, $00A4,
- $00B5, $007E, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $00A1, $00BF, $00D0, $00DD, $00DE, $00AE,
- $00A2, $00A3, $00A5, $00B7, $00A9, $00A7, $00B6, $00BC, $00BD, $00BE, $00AC, $007C, $00AF, $00A8, $00B4, $00D7,
- $007B, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $00AD, $00F4, $00F6, $00F2, $00F3, $00F5,
- $007D, $004A, $004B, $004C, $004D, $004E, $004F, $0050, $0051, $0052, $00B9, $00FB, $00FC, $00F9, $00FA, $00FF,
- $005C, $00F7, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $00B2, $00D4, $00D6, $00D2, $00D3, $00D5,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $00B3, $00DB, $00DC, $00D9, $00DA, $009F
- );
-
-const
- CP_737 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0391, $0392, $0393, $0394, $0395, $0396, $0397, $0398, $0399, $039A, $039B, $039C, $039D, $039E, $039F, $03A0,
- $03A1, $03A3, $03A4, $03A5, $03A6, $03A7, $03A8, $03A9, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7, $03B8,
- $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF, $03C0, $03C1, $03C3, $03C2, $03C4, $03C5, $03C6, $03C7, $03C8,
- $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556, $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
- $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B, $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
- $03C9, $03AC, $03AD, $03AE, $03CA, $03AF, $03CC, $03CD, $03CB, $03CE, $0386, $0388, $0389, $038A, $038C, $038E,
- $038F, $00B1, $2265, $2264, $03AA, $03AB, $00F7, $2248, $00B0, $2219, $00B7, $221A, $207F, $00B2, $25A0, $00A0
- );
-
-const
- CP_775 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0106, $00FC, $00E9, $0101, $00E4, $0123, $00E5, $0107, $0142, $0113, $0156, $0157, $012B, $0179, $00C4, $00C5,
- $00C9, $00E6, $00C6, $014D, $00F6, $0122, $00A2, $015A, $015B, $00D6, $00DC, $00F8, $00A3, $00D8, $00D7, $00A4,
- $0100, $012A, $00F3, $017B, $017C, $017A, $201D, $00A6, $00A9, $00AE, $00AC, $00BD, $00BC, $0141, $00AB, $00BB,
- $2591, $2592, $2593, $2502, $2524, $0104, $010C, $0118, $0116, $2563, $2551, $2557, $255D, $012E, $0160, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $0172, $016A, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $017D,
- $0105, $010D, $0119, $0117, $012F, $0161, $0173, $016B, $017E, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
- $00D3, $00DF, $014C, $0143, $00F5, $00D5, $00B5, $0144, $0136, $0137, $013B, $013C, $0146, $0112, $0145, $2019,
- $00AD, $00B1, $201C, $00BE, $00B6, $00A7, $00F7, $201E, $00B0, $2219, $00B7, $00B9, $00B3, $00B2, $25A0, $00A0
- );
-
-const
- CP_850 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $00C7, $00FC, $00E9, $00E2, $00E4, $00E0, $00E5, $00E7, $00EA, $00EB, $00E8, $00EF, $00EE, $00EC, $00C4, $00C5,
- $00C9, $00E6, $00C6, $00F4, $00F6, $00F2, $00FB, $00F9, $00FF, $00D6, $00DC, $00F8, $00A3, $00D8, $00D7, $0192,
- $00E1, $00ED, $00F3, $00FA, $00F1, $00D1, $00AA, $00BA, $00BF, $00AE, $00AC, $00BD, $00BC, $00A1, $00AB, $00BB,
- $2591, $2592, $2593, $2502, $2524, $00C1, $00C2, $00C0, $00A9, $2563, $2551, $2557, $255D, $00A2, $00A5, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $00E3, $00C3, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $00A4,
- $00F0, $00D0, $00CA, $00CB, $00C8, $0131, $00CD, $00CE, $00CF, $2518, $250C, $2588, $2584, $00A6, $00CC, $2580,
- $00D3, $00DF, $00D4, $00D2, $00F5, $00D5, $00B5, $00FE, $00DE, $00DA, $00DB, $00D9, $00FD, $00DD, $00AF, $00B4,
- $00AD, $00B1, $2017, $00BE, $00B6, $00A7, $00F7, $00B8, $00B0, $00A8, $00B7, $00B9, $00B3, $00B2, $25A0, $00A0
- );
-
-const
- CP_852 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $00C7, $00FC, $00E9, $00E2, $00E4, $016F, $0107, $00E7, $0142, $00EB, $0150, $0151, $00EE, $0179, $00C4, $0106,
- $00C9, $0139, $013A, $00F4, $00F6, $013D, $013E, $015A, $015B, $00D6, $00DC, $0164, $0165, $0141, $00D7, $010D,
- $00E1, $00ED, $00F3, $00FA, $0104, $0105, $017D, $017E, $0118, $0119, $00AC, $017A, $010C, $015F, $00AB, $00BB,
- $2591, $2592, $2593, $2502, $2524, $00C1, $00C2, $011A, $015E, $2563, $2551, $2557, $255D, $017B, $017C, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $0102, $0103, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $00A4,
- $0111, $0110, $010E, $00CB, $010F, $0147, $00CD, $00CE, $011B, $2518, $250C, $2588, $2584, $0162, $016E, $2580,
- $00D3, $00DF, $00D4, $0143, $0144, $0148, $0160, $0161, $0154, $00DA, $0155, $0170, $00FD, $00DD, $0163, $00B4,
- $00AD, $02DD, $02DB, $02C7, $02D8, $00A7, $00F7, $00B8, $00B0, $00A8, $02D9, $0171, $0158, $0159, $25A0, $00A0
- );
-
-const
- CP_855 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0452, $0402, $0453, $0403, $0451, $0401, $0454, $0404, $0455, $0405, $0456, $0406, $0457, $0407, $0458, $0408,
- $0459, $0409, $045A, $040A, $045B, $040B, $045C, $040C, $045E, $040E, $045F, $040F, $044E, $042E, $044A, $042A,
- $0430, $0410, $0431, $0411, $0446, $0426, $0434, $0414, $0435, $0415, $0444, $0424, $0433, $0413, $00AB, $00BB,
- $2591, $2592, $2593, $2502, $2524, $0445, $0425, $0438, $0418, $2563, $2551, $2557, $255D, $0439, $0419, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $043A, $041A, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $00A4,
- $043B, $041B, $043C, $041C, $043D, $041D, $043E, $041E, $043F, $2518, $250C, $2588, $2584, $041F, $044F, $2580,
- $042F, $0440, $0420, $0441, $0421, $0442, $0422, $0443, $0423, $0436, $0416, $0432, $0412, $044C, $042C, $2116,
- $00AD, $044B, $042B, $0437, $0417, $0448, $0428, $044D, $042D, $0449, $0429, $0447, $0427, $00A7, $25A0, $00A0
- );
-
-const
- CP_857 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $00C7, $00FC, $00E9, $00E2, $00E4, $00E0, $00E5, $00E7, $00EA, $00EB, $00E8, $00EF, $00EE, $0131, $00C4, $00C5,
- $00C9, $00E6, $00C6, $00F4, $00F6, $00F2, $00FB, $00F9, $0130, $00D6, $00DC, $00F8, $00A3, $00D8, $015E, $015F,
- $00E1, $00ED, $00F3, $00FA, $00F1, $00D1, $011E, $011F, $00BF, $00AE, $00AC, $00BD, $00BC, $00A1, $00AB, $00BB,
- $2591, $2592, $2593, $2502, $2524, $00C1, $00C2, $00C0, $00A9, $2563, $2551, $2557, $255D, $00A2, $00A5, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $00E3, $00C3, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $00A4,
- $00BA, $00AA, $00CA, $00CB, $00C8, $0000, $00CD, $00CE, $00CF, $2518, $250C, $2588, $2584, $00A6, $00CC, $2580,
- $00D3, $00DF, $00D4, $00D2, $00F5, $00D5, $00B5, $0000, $00D7, $00DA, $00DB, $00D9, $00EC, $00FF, $00AF, $00B4,
- $00AD, $00B1, $0000, $00BE, $00B6, $00A7, $00F7, $00B8, $00B0, $00A8, $00B7, $00B9, $00B3, $00B2, $25A0, $00A0
- );
-
-const
- CP_860 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $00C7, $00FC, $00E9, $00E2, $00E3, $00E0, $00C1, $00E7, $00EA, $00CA, $00E8, $00CD, $00D4, $00EC, $00C3, $00C2,
- $00C9, $00C0, $00C8, $00F4, $00F5, $00F2, $00DA, $00F9, $00CC, $00D5, $00DC, $00A2, $00A3, $00D9, $20A7, $00D3,
- $00E1, $00ED, $00F3, $00FA, $00F1, $00D1, $00AA, $00BA, $00BF, $00D2, $00AC, $00BD, $00BC, $00A1, $00AB, $00BB,
- $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556, $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
- $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B, $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
- $03B1, $00DF, $0393, $03C0, $03A3, $03C3, $00B5, $03C4, $03A6, $0398, $03A9, $03B4, $221E, $03C6, $03B5, $2229,
- $2261, $00B1, $2265, $2264, $2320, $2321, $00F7, $2248, $00B0, $2219, $00B7, $221A, $207F, $00B2, $25A0, $00A0
- );
-
-const
- CP_861 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $00C7, $00FC, $00E9, $00E2, $00E4, $00E0, $00E5, $00E7, $00EA, $00EB, $00E8, $00D0, $00F0, $00DE, $00C4, $00C5,
- $00C9, $00E6, $00C6, $00F4, $00F6, $00FE, $00FB, $00DD, $00FD, $00D6, $00DC, $00F8, $00A3, $00D8, $20A7, $0192,
- $00E1, $00ED, $00F3, $00FA, $00C1, $00CD, $00D3, $00DA, $00BF, $2310, $00AC, $00BD, $00BC, $00A1, $00AB, $00BB,
- $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556, $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
- $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B, $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
- $03B1, $00DF, $0393, $03C0, $03A3, $03C3, $00B5, $03C4, $03A6, $0398, $03A9, $03B4, $221E, $03C6, $03B5, $2229,
- $2261, $00B1, $2265, $2264, $2320, $2321, $00F7, $2248, $00B0, $2219, $00B7, $221A, $207F, $00B2, $25A0, $00A0
- );
-
-const
- CP_862 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $05D0, $05D1, $05D2, $05D3, $05D4, $05D5, $05D6, $05D7, $05D8, $05D9, $05DA, $05DB, $05DC, $05DD, $05DE, $05DF,
- $05E0, $05E1, $05E2, $05E3, $05E4, $05E5, $05E6, $05E7, $05E8, $05E9, $05EA, $00A2, $00A3, $00A5, $20A7, $0192,
- $00E1, $00ED, $00F3, $00FA, $00F1, $00D1, $00AA, $00BA, $00BF, $2310, $00AC, $00BD, $00BC, $00A1, $00AB, $00BB,
- $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556, $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
- $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B, $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
- $03B1, $00DF, $0393, $03C0, $03A3, $03C3, $00B5, $03C4, $03A6, $0398, $03A9, $03B4, $221E, $03C6, $03B5, $2229,
- $2261, $00B1, $2265, $2264, $2320, $2321, $00F7, $2248, $00B0, $2219, $00B7, $221A, $207F, $00B2, $25A0, $00A0
- );
-
-const
- CP_863 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $00C7, $00FC, $00E9, $00E2, $00C2, $00E0, $00B6, $00E7, $00EA, $00EB, $00E8, $00EF, $00EE, $2017, $00C0, $00A7,
- $00C9, $00C8, $00CA, $00F4, $00CB, $00CF, $00FB, $00F9, $00A4, $00D4, $00DC, $00A2, $00A3, $00D9, $00DB, $0192,
- $00A6, $00B4, $00F3, $00FA, $00A8, $00B8, $00B3, $00AF, $00CE, $2310, $00AC, $00BD, $00BC, $00BE, $00AB, $00BB,
- $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556, $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
- $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B, $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
- $03B1, $00DF, $0393, $03C0, $03A3, $03C3, $00B5, $03C4, $03A6, $0398, $03A9, $03B4, $221E, $03C6, $03B5, $2229,
- $2261, $00B1, $2265, $2264, $2320, $2321, $00F7, $2248, $00B0, $2219, $00B7, $221A, $207F, $00B2, $25A0, $00A0
- );
-
-const
- CP_864 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $066A, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $00B0, $00B7, $2219, $221A, $2592, $2500, $2502, $253C, $2524, $252C, $251C, $2534, $2510, $250C, $2514, $2518,
- $03B2, $221E, $03C6, $00B1, $00BD, $00BC, $2248, $00AB, $00BB, $FEF7, $FEF8, $0000, $0000, $FEFB, $FEFC, $0000,
- $00A0, $00AD, $FE82, $00A3, $00A4, $FE84, $0000, $0000, $FE8E, $FE8F, $FE95, $FE99, $060C, $FE9D, $FEA1, $FEA5,
- $0660, $0661, $0662, $0663, $0664, $0665, $0666, $0667, $0668, $0669, $FED1, $061B, $FEB1, $FEB5, $FEB9, $061F,
- $00A2, $FE80, $FE81, $FE83, $FE85, $FECA, $FE8B, $FE8D, $FE91, $FE93, $FE97, $FE9B, $FE9F, $FEA3, $FEA7, $FEA9,
- $FEAB, $FEAD, $FEAF, $FEB3, $FEB7, $FEBB, $FEBF, $FEC1, $FEC5, $FECB, $FECF, $00A6, $00AC, $00F7, $00D7, $FEC9,
- $0640, $FED3, $FED7, $FEDB, $FEDF, $FEE3, $FEE7, $FEEB, $FEED, $FEEF, $FEF3, $FEBD, $FECC, $FECE, $FECD, $FEE1,
- $FE7D, $0651, $FEE5, $FEE9, $FEEC, $FEF0, $FEF2, $FED0, $FED5, $FEF5, $FEF6, $FEDD, $FED9, $FEF1, $25A0, $0000
- );
-
-const
- CP_865 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $00C7, $00FC, $00E9, $00E2, $00E4, $00E0, $00E5, $00E7, $00EA, $00EB, $00E8, $00EF, $00EE, $00EC, $00C4, $00C5,
- $00C9, $00E6, $00C6, $00F4, $00F6, $00F2, $00FB, $00F9, $00FF, $00D6, $00DC, $00F8, $00A3, $00D8, $20A7, $0192,
- $00E1, $00ED, $00F3, $00FA, $00F1, $00D1, $00AA, $00BA, $00BF, $2310, $00AC, $00BD, $00BC, $00A1, $00AB, $00A4,
- $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556, $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
- $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B, $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
- $03B1, $00DF, $0393, $03C0, $03A3, $03C3, $00B5, $03C4, $03A6, $0398, $03A9, $03B4, $221E, $03C6, $03B5, $2229,
- $2261, $00B1, $2265, $2264, $2320, $2321, $00F7, $2248, $00B0, $2219, $00B7, $221A, $207F, $00B2, $25A0, $00A0
- );
-
-const
- CP_866 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417, $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F,
- $0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427, $0428, $0429, $042A, $042B, $042C, $042D, $042E, $042F,
- $0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437, $0438, $0439, $043A, $043B, $043C, $043D, $043E, $043F,
- $2591, $2592, $2593, $2502, $2524, $2561, $2562, $2556, $2555, $2563, $2551, $2557, $255D, $255C, $255B, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $255E, $255F, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $2567,
- $2568, $2564, $2565, $2559, $2558, $2552, $2553, $256B, $256A, $2518, $250C, $2588, $2584, $258C, $2590, $2580,
- $0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447, $0448, $0449, $044A, $044B, $044C, $044D, $044E, $044F,
- $0401, $0451, $0404, $0454, $0407, $0457, $040E, $045E, $00B0, $2219, $00B7, $221A, $2116, $00A4, $25A0, $00A0
- );
-
-const
- CP_869 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0000, $0000, $0000, $0000, $0000, $0000, $0386, $0000, $00B7, $00AC, $00A6, $2018, $2019, $0388, $2015, $0389,
- $038A, $03AA, $038C, $0000, $0000, $038E, $03AB, $00A9, $038F, $00B2, $00B3, $03AC, $00A3, $03AD, $03AE, $03AF,
- $03CA, $0390, $03CC, $03CD, $0391, $0392, $0393, $0394, $0395, $0396, $0397, $00BD, $0398, $0399, $00AB, $00BB,
- $2591, $2592, $2593, $2502, $2524, $039A, $039B, $039C, $039D, $2563, $2551, $2557, $255D, $039E, $039F, $2510,
- $2514, $2534, $252C, $251C, $2500, $253C, $03A0, $03A1, $255A, $2554, $2569, $2566, $2560, $2550, $256C, $03A3,
- $03A4, $03A5, $03A6, $03A7, $03A8, $03A9, $03B1, $03B2, $03B3, $2518, $250C, $2588, $2584, $03B4, $03B5, $2580,
- $03B6, $03B7, $03B8, $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF, $03C0, $03C1, $03C3, $03C2, $03C4, $0384,
- $00AD, $00B1, $03C5, $03C6, $03C7, $00A7, $03C8, $0385, $00B0, $00A8, $03C9, $03CB, $03B0, $03CE, $25A0, $00A0
- );
-
-const
- CP_874 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $20AC, $0000, $0000, $0000, $0000, $2026, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
- $0000, $2018, $2019, $201C, $201D, $2022, $2013, $2014, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
- $00A0, $0E01, $0E02, $0E03, $0E04, $0E05, $0E06, $0E07, $0E08, $0E09, $0E0A, $0E0B, $0E0C, $0E0D, $0E0E, $0E0F,
- $0E10, $0E11, $0E12, $0E13, $0E14, $0E15, $0E16, $0E17, $0E18, $0E19, $0E1A, $0E1B, $0E1C, $0E1D, $0E1E, $0E1F,
- $0E20, $0E21, $0E22, $0E23, $0E24, $0E25, $0E26, $0E27, $0E28, $0E29, $0E2A, $0E2B, $0E2C, $0E2D, $0E2E, $0E2F,
- $0E30, $0E31, $0E32, $0E33, $0E34, $0E35, $0E36, $0E37, $0E38, $0E39, $0E3A, $0000, $0000, $0000, $0000, $0E3F,
- $0E40, $0E41, $0E42, $0E43, $0E44, $0E45, $0E46, $0E47, $0E48, $0E49, $0E4A, $0E4B, $0E4C, $0E4D, $0E4E, $0E4F,
- $0E50, $0E51, $0E52, $0E53, $0E54, $0E55, $0E56, $0E57, $0E58, $0E59, $0E5A, $0E5B, $0000, $0000, $0000, $0000
- );
-
-const
- CP_875 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $009C, $0009, $0086, $007F, $0097, $008D, $008E, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $009D, $0085, $0008, $0087, $0018, $0019, $0092, $008F, $001C, $001D, $001E, $001F,
- $0080, $0081, $0082, $0083, $0084, $000A, $0017, $001B, $0088, $0089, $008A, $008B, $008C, $0005, $0006, $0007,
- $0090, $0091, $0016, $0093, $0094, $0095, $0096, $0004, $0098, $0099, $009A, $009B, $0014, $0015, $009E, $001A,
- $0020, $0391, $0392, $0393, $0394, $0395, $0396, $0397, $0398, $0399, $005B, $002E, $003C, $0028, $002B, $0021,
- $0026, $039A, $039B, $039C, $039D, $039E, $039F, $03A0, $03A1, $03A3, $005D, $0024, $002A, $0029, $003B, $005E,
- $002D, $002F, $03A4, $03A5, $03A6, $03A7, $03A8, $03A9, $03AA, $03AB, $007C, $002C, $0025, $005F, $003E, $003F,
- $00A8, $0386, $0388, $0389, $00A0, $038A, $038C, $038E, $038F, $0060, $003A, $0023, $0040, $0027, $003D, $0022,
- $0385, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6,
- $00B0, $006A, $006B, $006C, $006D, $006E, $006F, $0070, $0071, $0072, $03B7, $03B8, $03B9, $03BA, $03BB, $03BC,
- $00B4, $007E, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $03BD, $03BE, $03BF, $03C0, $03C1, $03C3,
- $00A3, $03AC, $03AD, $03AE, $03CA, $03AF, $03CC, $03CD, $03CB, $03CE, $03C2, $03C4, $03C5, $03C6, $03C7, $03C8,
- $007B, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $00AD, $03C9, $0390, $03B0, $2018, $2015,
- $007D, $004A, $004B, $004C, $004D, $004E, $004F, $0050, $0051, $0052, $00B1, $00BD, $001A, $0387, $2019, $00A6,
- $005C, $001A, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $00B2, $00A7, $001A, $001A, $00AB, $00AC,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $00B3, $00A9, $001A, $001A, $00BB, $009F
- );
-
-const
- CP_932 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
- $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
- $0000, $FF61, $FF62, $FF63, $FF64, $FF65, $FF66, $FF67, $FF68, $FF69, $FF6A, $FF6B, $FF6C, $FF6D, $FF6E, $FF6F,
- $FF70, $FF71, $FF72, $FF73, $FF74, $FF75, $FF76, $FF77, $FF78, $FF79, $FF7A, $FF7B, $FF7C, $FF7D, $FF7E, $FF7F,
- $FF80, $FF81, $FF82, $FF83, $FF84, $FF85, $FF86, $FF87, $FF88, $FF89, $FF8A, $FF8B, $FF8C, $FF8D, $FF8E, $FF8F,
- $FF90, $FF91, $FF92, $FF93, $FF94, $FF95, $FF96, $FF97, $FF98, $FF99, $FF9A, $FF9B, $FF9C, $FF9D, $FF9E, $FF9F,
- $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
- $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000
- );
-
-const
- CP_1026 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $009C, $0009, $0086, $007F, $0097, $008D, $008E, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $009D, $0085, $0008, $0087, $0018, $0019, $0092, $008F, $001C, $001D, $001E, $001F,
- $0080, $0081, $0082, $0083, $0084, $000A, $0017, $001B, $0088, $0089, $008A, $008B, $008C, $0005, $0006, $0007,
- $0090, $0091, $0016, $0093, $0094, $0095, $0096, $0004, $0098, $0099, $009A, $009B, $0014, $0015, $009E, $001A,
- $0020, $00A0, $00E2, $00E4, $00E0, $00E1, $00E3, $00E5, $007B, $00F1, $00C7, $002E, $003C, $0028, $002B, $0021,
- $0026, $00E9, $00EA, $00EB, $00E8, $00ED, $00EE, $00EF, $00EC, $00DF, $011E, $0130, $002A, $0029, $003B, $005E,
- $002D, $002F, $00C2, $00C4, $00C0, $00C1, $00C3, $00C5, $005B, $00D1, $015F, $002C, $0025, $005F, $003E, $003F,
- $00F8, $00C9, $00CA, $00CB, $00C8, $00CD, $00CE, $00CF, $00CC, $0131, $003A, $00D6, $015E, $0027, $003D, $00DC,
- $00D8, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $00AB, $00BB, $007D, $0060, $00A6, $00B1,
- $00B0, $006A, $006B, $006C, $006D, $006E, $006F, $0070, $0071, $0072, $00AA, $00BA, $00E6, $00B8, $00C6, $00A4,
- $00B5, $00F6, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $00A1, $00BF, $005D, $0024, $0040, $00AE,
- $00A2, $00A3, $00A5, $00B7, $00A9, $00A7, $00B6, $00BC, $00BD, $00BE, $00AC, $007C, $00AF, $00A8, $00B4, $00D7,
- $00E7, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $00AD, $00F4, $007E, $00F2, $00F3, $00F5,
- $011F, $004A, $004B, $004C, $004D, $004E, $004F, $0050, $0051, $0052, $00B9, $00FB, $005C, $00F9, $00FA, $00FF,
- $00FC, $00F7, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $00B2, $00D4, $0023, $00D2, $00D3, $00D5,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $00B3, $00DB, $0022, $00D9, $00DA, $009F
- );
-
-const
- CP_1250 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $20AC, $0000, $201A, $0000, $201E, $2026, $2020, $2021, $0000, $2030, $0160, $2039, $015A, $0164, $017D, $0179,
- $0000, $2018, $2019, $201C, $201D, $2022, $2013, $2014, $0000, $2122, $0161, $203A, $015B, $0165, $017E, $017A,
- $00A0, $02C7, $02D8, $0141, $00A4, $0104, $00A6, $00A7, $00A8, $00A9, $015E, $00AB, $00AC, $00AD, $00AE, $017B,
- $00B0, $00B1, $02DB, $0142, $00B4, $00B5, $00B6, $00B7, $00B8, $0105, $015F, $00BB, $013D, $02DD, $013E, $017C,
- $0154, $00C1, $00C2, $0102, $00C4, $0139, $0106, $00C7, $010C, $00C9, $0118, $00CB, $011A, $00CD, $00CE, $010E,
- $0110, $0143, $0147, $00D3, $00D4, $0150, $00D6, $00D7, $0158, $016E, $00DA, $0170, $00DC, $00DD, $0162, $00DF,
- $0155, $00E1, $00E2, $0103, $00E4, $013A, $0107, $00E7, $010D, $00E9, $0119, $00EB, $011B, $00ED, $00EE, $010F,
- $0111, $0144, $0148, $00F3, $00F4, $0151, $00F6, $00F7, $0159, $016F, $00FA, $0171, $00FC, $00FD, $0163, $02D9
- );
-
-const
- CP_1251 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $0402, $0403, $201A, $0453, $201E, $2026, $2020, $2021, $20AC, $2030, $0409, $2039, $040A, $040C, $040B, $040F,
- $0452, $2018, $2019, $201C, $201D, $2022, $2013, $2014, $0000, $2122, $0459, $203A, $045A, $045C, $045B, $045F,
- $00A0, $040E, $045E, $0408, $00A4, $0490, $00A6, $00A7, $0401, $00A9, $0404, $00AB, $00AC, $00AD, $00AE, $0407,
- $00B0, $00B1, $0406, $0456, $0491, $00B5, $00B6, $00B7, $0451, $2116, $0454, $00BB, $0458, $0405, $0455, $0457,
- $0410, $0411, $0412, $0413, $0414, $0415, $0416, $0417, $0418, $0419, $041A, $041B, $041C, $041D, $041E, $041F,
- $0420, $0421, $0422, $0423, $0424, $0425, $0426, $0427, $0428, $0429, $042A, $042B, $042C, $042D, $042E, $042F,
- $0430, $0431, $0432, $0433, $0434, $0435, $0436, $0437, $0438, $0439, $043A, $043B, $043C, $043D, $043E, $043F,
- $0440, $0441, $0442, $0443, $0444, $0445, $0446, $0447, $0448, $0449, $044A, $044B, $044C, $044D, $044E, $044F
- );
-
-const
- CP_1252 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $20AC, $0000, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030, $0160, $2039, $0152, $0000, $017D, $0000,
- $0000, $2018, $2019, $201C, $201D, $2022, $2013, $2014, $02DC, $2122, $0161, $203A, $0153, $0000, $017E, $0178,
- $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
- $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
- $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
- $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9, $00DA, $00DB, $00DC, $00DD, $00DE, $00DF,
- $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
- $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF
- );
-
-const
- CP_1253 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $20AC, $0000, $201A, $0192, $201E, $2026, $2020, $2021, $0000, $2030, $0000, $2039, $0000, $0000, $0000, $0000,
- $0000, $2018, $2019, $201C, $201D, $2022, $2013, $2014, $0000, $2122, $0000, $203A, $0000, $0000, $0000, $0000,
- $00A0, $0385, $0386, $00A3, $00A4, $00A5, $00A6, $00A7, $00A8, $00A9, $0000, $00AB, $00AC, $00AD, $00AE, $2015,
- $00B0, $00B1, $00B2, $00B3, $0384, $00B5, $00B6, $00B7, $0388, $0389, $038A, $00BB, $038C, $00BD, $038E, $038F,
- $0390, $0391, $0392, $0393, $0394, $0395, $0396, $0397, $0398, $0399, $039A, $039B, $039C, $039D, $039E, $039F,
- $03A0, $03A1, $0000, $03A3, $03A4, $03A5, $03A6, $03A7, $03A8, $03A9, $03AA, $03AB, $03AC, $03AD, $03AE, $03AF,
- $03B0, $03B1, $03B2, $03B3, $03B4, $03B5, $03B6, $03B7, $03B8, $03B9, $03BA, $03BB, $03BC, $03BD, $03BE, $03BF,
- $03C0, $03C1, $03C2, $03C3, $03C4, $03C5, $03C6, $03C7, $03C8, $03C9, $03CA, $03CB, $03CC, $03CD, $03CE, $0000
- );
-
-const
- CP_1254 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $20AC, $0000, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030, $0160, $2039, $0152, $0000, $0000, $0000,
- $0000, $2018, $2019, $201C, $201D, $2022, $2013, $2014, $02DC, $2122, $0161, $203A, $0153, $0000, $0000, $0178,
- $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
- $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
- $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF,
- $011E, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9, $00DA, $00DB, $00DC, $0130, $015E, $00DF,
- $00E0, $00E1, $00E2, $00E3, $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, $00EE, $00EF,
- $011F, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, $00F8, $00F9, $00FA, $00FB, $00FC, $0131, $015F, $00FF
- );
-
-const
- CP_1255 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $20AC, $0000, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030, $0000, $2039, $0000, $0000, $0000, $0000,
- $0000, $2018, $2019, $201C, $201D, $2022, $2013, $2014, $02DC, $2122, $0000, $203A, $0000, $0000, $0000, $0000,
- $00A0, $00A1, $00A2, $00A3, $20AA, $00A5, $00A6, $00A7, $00A8, $00A9, $00D7, $00AB, $00AC, $00AD, $00AE, $00AF,
- $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00F7, $00BB, $00BC, $00BD, $00BE, $00BF,
- $05B0, $05B1, $05B2, $05B3, $05B4, $05B5, $05B6, $05B7, $05B8, $05B9, $0000, $05BB, $05BC, $05BD, $05BE, $05BF,
- $05C0, $05C1, $05C2, $05C3, $05F0, $05F1, $05F2, $05F3, $05F4, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
- $05D0, $05D1, $05D2, $05D3, $05D4, $05D5, $05D6, $05D7, $05D8, $05D9, $05DA, $05DB, $05DC, $05DD, $05DE, $05DF,
- $05E0, $05E1, $05E2, $05E3, $05E4, $05E5, $05E6, $05E7, $05E8, $05E9, $05EA, $0000, $0000, $200E, $200F, $0000
- );
-
-const
- CP_1256 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $20AC, $067E, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030, $0679, $2039, $0152, $0686, $0698, $0688,
- $06AF, $2018, $2019, $201C, $201D, $2022, $2013, $2014, $06A9, $2122, $0691, $203A, $0153, $200C, $200D, $06BA,
- $00A0, $060C, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, $00A8, $00A9, $06BE, $00AB, $00AC, $00AD, $00AE, $00AF,
- $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $061B, $00BB, $00BC, $00BD, $00BE, $061F,
- $06C1, $0621, $0622, $0623, $0624, $0625, $0626, $0627, $0628, $0629, $062A, $062B, $062C, $062D, $062E, $062F,
- $0630, $0631, $0632, $0633, $0634, $0635, $0636, $00D7, $0637, $0638, $0639, $063A, $0640, $0641, $0642, $0643,
- $00E0, $0644, $00E2, $0645, $0646, $0647, $0648, $00E7, $00E8, $00E9, $00EA, $00EB, $0649, $064A, $00EE, $00EF,
- $064B, $064C, $064D, $064E, $00F4, $064F, $0650, $00F7, $0651, $00F9, $0652, $00FB, $00FC, $200E, $200F, $06D2
- );
-
-const
- CP_1257 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $20AC, $0000, $201A, $0000, $201E, $2026, $2020, $2021, $0000, $2030, $0000, $2039, $0000, $00A8, $02C7, $00B8,
- $0000, $2018, $2019, $201C, $201D, $2022, $2013, $2014, $0000, $2122, $0000, $203A, $0000, $00AF, $02DB, $0000,
- $00A0, $0000, $00A2, $00A3, $00A4, $0000, $00A6, $00A7, $00D8, $00A9, $0156, $00AB, $00AC, $00AD, $00AE, $00C6,
- $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00F8, $00B9, $0157, $00BB, $00BC, $00BD, $00BE, $00E6,
- $0104, $012E, $0100, $0106, $00C4, $00C5, $0118, $0112, $010C, $00C9, $0179, $0116, $0122, $0136, $012A, $013B,
- $0160, $0143, $0145, $00D3, $014C, $00D5, $00D6, $00D7, $0172, $0141, $015A, $016A, $00DC, $017B, $017D, $00DF,
- $0105, $012F, $0101, $0107, $00E4, $00E5, $0119, $0113, $010D, $00E9, $017A, $0117, $0123, $0137, $012B, $013C,
- $0161, $0144, $0146, $00F3, $014D, $00F5, $00F6, $00F7, $0173, $0142, $015B, $016B, $00FC, $017C, $017E, $02D9
- );
-
-const
- CP_1258 : TtsCodePage = (
- $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, $000A, $000B, $000C, $000D, $000E, $000F,
- $0010, $0011, $0012, $0013, $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, $001E, $001F,
- $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F,
- $0030, $0031, $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, $003C, $003D, $003E, $003F,
- $0040, $0041, $0042, $0043, $0044, $0045, $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F,
- $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, $005A, $005B, $005C, $005D, $005E, $005F,
- $0060, $0061, $0062, $0063, $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, $006E, $006F,
- $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F,
- $20AC, $0000, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030, $0000, $2039, $0152, $0000, $0000, $0000,
- $0000, $2018, $2019, $201C, $201D, $2022, $2013, $2014, $02DC, $2122, $0000, $203A, $0153, $0000, $0000, $0178,
- $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF,
- $00B0, $00B1, $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB, $00BC, $00BD, $00BE, $00BF,
- $00C0, $00C1, $00C2, $0102, $00C4, $00C5, $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $0300, $00CD, $00CE, $00CF,
- $0110, $00D1, $0309, $00D3, $00D4, $01A0, $00D6, $00D7, $00D8, $00D9, $00DA, $00DB, $00DC, $01AF, $0303, $00DF,
- $00E0, $00E1, $00E2, $0103, $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $0301, $00ED, $00EE, $00EF,
- $0111, $00F1, $0323, $00F3, $00F4, $01A1, $00F6, $00F7, $00F8, $00F9, $00FA, $00FB, $00FC, $01B0, $20AB, $00FF
- );
-
-
-
-implementation
-
-
-
-function tsStrAlloc(Size: Cardinal): pWideChar;
-begin
- Size := (Size +1) shl 1;
-
- GetMem(Result, Size);
- FillChar(Result^, Size, 0);
-end;
-
-
-function tsStrNew(pText: pWideChar): pWideChar;
-begin
- Result := tsStrAlloc(tsStrLength(pText));
-
- tsStrCopy(Result, pText);
-end;
-
-
-procedure tsStrDispose(pText: pWideChar);
-begin
- FreeMem(pText);
-end;
-
-
-function tsStrLength(pText: pWideChar): Cardinal;
-{$IFDEF TS_PURE_PASCAL}
-begin
- Result := 0;
-
- if pText <> nil then
- while ord(pText^) <> 0 do begin
- inc(Result);
- inc(pText);
- end;
-{$ELSE}
-asm
- test eax, eax // test if addr is nil
- je @@end // jump to end (no need to set length. allready 0)
-
- mov ecx, eax // copy pointer to ecx
- xor eax, eax // clear eax
-
- xor edx, edx // clear edx
-
- jmp @@loopfoot
-
-@@loop:
-
- inc eax // inc counter in eax
- add ecx, 2 // inc pointer in edx by 2
-
-@@loopfoot:
-
- cmp word ptr [ecx], 0 // compare word with 0
- jnz @@loop
-
-@@end:
-
-{$ENDIF}
-end;
-
-
-function tsStrCopy(pDest, pSource: pWideChar): pWideChar;
-{$IFDEF TS_PURE_PASCAL}
-begin
- Result := pDest;
-
- if pDest <> nil then
- if pSource <> nil then
- while ord(pSource^) <> 0 do begin
- pDest^ := pSource^;
-
- inc(pDest);
- inc(pSource);
- end;
-{$ELSE}
-asm
- test eax, eax
- jz @@end
-
- test edx, eax
- jz @@end
-
- push eax // save pointer of dest
-
- xor ecx, ecx // clear ecx
-
- jmp @@loopfoot
-
-@@loop:
-
- mov word ptr [eax], cx // copy cx to dest
-
-// add eax, 2 // inc dest pointer
-// add edx, 2 // inc source pointer
- inc eax // inc dest pointer
- inc eax // inc dest pointer
- inc edx // inc source pointer
- inc edx // inc source pointer
-
-@@loopfoot:
-
- mov cx, word ptr [edx] // copy source word to cx
- test ecx, ecx // have we reached the end
- jnz @@loop // jump to end
-
- pop eax // restore dest pointer to eax
-
-@@end:
-
-{$ENDIF}
-end;
-
-
-const
-{* Index into the table below with the first byte of a UTF-8 sequence to
- * get the number of trailing bytes that are supposed to follow it.
- * Note that *legal* UTF-8 values can't have 4 or 5-bytes. The table is
- * left as-is for anyone who may want to do such conversion, which was
- * allowed in earlier algorithms. }
- trailingBytesForUTF8: array [AnsiChar] of byte = (
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
- 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5
- );
-
-{* Magic values subtracted from a buffer value during UTF8 conversion.
- * This table contains as many values as there might be trailing bytes
- * in a UTF-8 sequence. }
- offsetsFromUTF8 : array [0..5] of Cardinal = ($00000000, $00003080, $000E2080, $03C82080, $FA082080, $82082080);
-
-
-procedure tsAnsiUTF8ToWide(pDest: pWideChar; pSource: pAnsiChar; DefaultChar: WideChar);
-{$IFDEF TS_PURE_PASCAL}
-var
- ExtractBytes: Byte;
- StrPos, StrLen, CharCode, Idx: Cardinal;
-begin
- // es ist möglich einen BufferOverflow zu erzeugen.
- if (pSource <> nil) and (pDest <> nil) then begin
- StrLen := Length(pSource);
- StrPos := 0;
-
- while StrPos < StrLen do begin
- //
- ExtractBytes := trailingBytesForUTF8[pSource^];
-
- if StrPos + ExtractBytes > StrLen then
- Exit;
-
- // extract first byte
- CharCode := Ord(pSource^);
- Inc(pSource);
- Inc(StrPos);
-
- // extract all other
- for Idx := ExtractBytes downto 1 do begin
- CharCode := CharCode shl 6;
- CharCode := CharCode + Ord(pSource^);
- Inc(pSource);
- Inc(StrPos);
- end;
-
- // decreasing by magic numbers
- CharCode := CharCode - offsetsFromUTF8[ExtractBytes];
-
- // if its not to large so use it
- if CharCode > $FFFF then
- CharCode := Ord(DefaultChar);
-
- if CharCode <= $FFFF then begin
- pWord(pDest)^ := CharCode;
- Inc(pDest);
- end;
- end;
- end;
-{$ELSE}
-asm
- test eax, eax // test pDest to nil
- jnz @@param1 // jump to end
- ret
-
-@@param1:
-
- test edx, edx // test pSource to nil
- jnz @@param2 // jump to end
- ret
-
-@@param2:
-
- push cx // save defaultchar
-
- // getting length of pSource into ecx
- mov ecx, edx // mov pSource into ecx
- jmp @@ansilenloopfoot
-
-@@ansilenloop:
-
- inc ecx // increase pointer
-
-@@ansilenloopfoot:
-
- cmp byte ptr [ecx], 0 // check if pointer^ is #0
- jnz @@ansilenloop
-
- sub ecx, edx // substract endpointer from begining.
-
- // preparing for conversion
- push ebx // save register
- push esi // save register
- push edi // save register
-
- mov edi, eax // copy pSource to esi
- mov esi, edx // copy pDest to edi
-
- // while ecx > 0
- jmp @@uftloopfoot
-
-@@uftloop:
-
- movzx ebx, byte ptr [trailingBytesForUTF8 + eax] // copy count to ebx
-
- test ebx, ebx // utf char
- jz @@chardone // process utf
-
- // utf 8 char
-
- sub ecx, ebx // decrease char count
- js @@finished // jump im signed (lower 0)
-
- jmp dword ptr [ebx * 4 + @@casemap1]
-
-@@case5: // trailingBytesForUTF8 = 5
- shl eax, 6
- inc esi
- movzx edx, byte ptr [esi]
- add eax, edx
-
-@@case4: // trailingBytesForUTF8 = 4
- shl eax, 6
- inc esi
- movzx edx, byte ptr [esi]
- add eax, edx
-
-@@case3: // trailingBytesForUTF8 = 3
- shl eax, 6
- inc esi
- movzx edx, byte ptr [esi]
- add eax, edx
-
-@@case2: // trailingBytesForUTF8 = 2
- shl eax, 6
- inc esi
- movzx edx, byte ptr [esi]
- add eax, edx
-
-@@case1: // trailingBytesForUTF8 = 1
- shl eax, 6
- inc esi
- movzx edx, byte ptr [esi]
- add eax, edx
-
-@@case0:
- // substract magic number
- mov edx, dword ptr [offsetsFromUTF8 + ebx * 4]
- sub eax, edx
-
- // check out of range
- cmp eax, $FFFF
- jl @@chardone
-
- // move default char
- movzx eax, word ptr [esp + $C]
-
- // skip if 0
- test eax, eax
- jz @@nextchar
-
-@@chardone:
-
- mov word ptr [edi], ax // copy char into pDest^
-// add edi, 2 // inc pDest by 2
- inc edi // inc pDest by 2
- inc edi // inc pDest by 2
-
-@@nextchar:
-
- inc esi // inc pSource
-
-@@uftloopfoot:
- dec ecx
-
- movzx eax, byte ptr [esi] // copy actual char into eax
- test eax, eax // check if #0
- jnz @@uftloop // if not zero process it
-
-@@finished:
-
- // cleaning up
- pop edi
- pop esi
- pop ebx
- pop cx
-
-@@end:
- ret
-
-@@casemap1:
- dd @@end
- dd @@case1
- dd @@case2
- dd @@case3
- dd @@case4
- dd @@case5
-{$ENDIF}
-end;
-
-
-procedure tsAnsiISO_8859_1_ToWide(pDest: pWideChar; pSource: pAnsiChar);
-{$IFDEF TS_PURE_PASCAL}
-begin
- if pDest <> nil then
- if pSource <> nil then
- while ord(pSource^) <> 0 do begin
- pDest^ := WideChar(pSource^);
-
- inc(pDest);
- inc(pSource);
- end;
-{$ELSE}
-asm
- test eax, eax // test pDest to nil
- jz @@end
-
- test edx, edx // test pSource to nil
- jz @@end
-
- xor ecx, ecx // clear ecx
-
- jmp @@loopfoot // jump to loop footer
-
-@@loop:
-
- mov word ptr [eax], cx // copy cx to dest
-
-// add eax, 2 // inc dest by 2
- inc eax // inc source pointer
- inc eax // inc source pointer
- inc edx // inc source pointer
-
-@@loopfoot:
-
- mov cl, byte ptr [edx] // copy source byte to cl
-
- test ecx, ecx // have we reached the end?
- jnz @@loop // if not processchar
-
-@@end:
-
-{$ENDIF}
-end;
-
-
-procedure tsAnsiSBCDToWide(pDest: pWideChar; pSource: pAnsiChar; pCodePage: PtsCodePage; DefaultChar: WideChar);
-{$IFDEF TS_PURE_PASCAL}
-var
- Temp: WideChar;
-begin
- if pDest <> nil then
- if pSource <> nil then
- while Ord(pSource^) <> 0 do begin
- // copy char to temp
- Temp := WideChar(pCodePage^[pSource^]);
-
- // copy defaultchar?
- if ord(Temp) = 0 then begin
- if ord(DefaultChar) <> 0 then begin
- pDest^ := DefaultChar;
- Inc(pDest);
- end;
- end else
-
- // copy normal char
- begin
- pDest^ := Temp;
- Inc(pDest);
- end;
-
- Inc(pSource);
- end;
-{$ELSE}
-asm
- test eax, eax // test if pDest is nil
- jz @@end
-
- test edx, edx // test if pSource is nil
- jz @@end
-
- push eax // save eax (pDest)
- push edi // save edi
- push esi // save esi
-
- mov edi, eax // copy eax to dsi
- mov esi, edx // copy edx to esi
-
- movzx eax, word ptr [ebp + $08] // save defaultchar into eax
-
- jmp @@loopfoot
-
-@@loop:
-
- movzx edx, word ptr [ecx + edx * 2] // copy codepageentry to dx
-
- test edx, edx // is edx zero
- jnz @@notempty // no empty char
-
- test eax, eax // is eax (defaultchar) zero
- jz @@nextchar // if yes goto next char
-
- mov word ptr [edi], ax // copy defaultchar to dest
- jmp @@donechar // goto donechar
-
-@@notempty:
-
- mov word ptr [edi], dx // copy widechar to dest
-
-@@donechar:
-
- add edi, 2 // increment the edi (pDest) by 2
-
-@@nextchar:
-
- inc esi // increment the source index
-
-@@loopfoot:
-
- movzx edx, byte ptr [esi] // copy source byte to edx
-
- test edx, edx // have we reached the end?
- jnz @@loop // jump down
-
- pop esi // restore esi
- pop edi // restore edi
- pop eax // restore eax (pDest)
-
-@@end:
-
-{$ENDIF}
-end;
-
-
-procedure tsAnsiDBCDToWide(pDest: pWideChar; pSource: pAnsiChar; pCodePage: PtsCodePage; DefaultChar: WideChar);
-begin
-
-end;
-
-
-end.
diff --git a/utsFontCreatorFreeType.pas b/utsFontCreatorFreeType.pas
index 4789631..4278cb7 100644
--- a/utsFontCreatorFreeType.pas
+++ b/utsFontCreatorFreeType.pas
@@ -35,6 +35,8 @@ type
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;
@@ -43,6 +45,8 @@ type
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;
constructor Create(const aContext: TtsContext);
destructor Destroy; override;
@@ -170,6 +174,57 @@ begin
end;
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorFreeType.CreateFont(const aFace: FT_Face; const aRenderer: TtsRenderer; const aSize: Integer;
+ const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
+var
+ face: FT_Face;
+ err: FT_Error;
+ prop: TtsFontProperties;
+ os2: PTT_OS2;
+ hz: PTT_HoriHeader;
+begin
+ err := FT_Set_Char_Size(aFace, 0, aSize * FT_SIZE_FACTOR, FT_SIZE_RES, FT_SIZE_RES);
+ 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);
+
+ prop.Size := aSize;
+ prop.AntiAliasing := aAntiAliasing;
+ prop.DefaultChar := '?';
+ prop.Style := aStyle + [tsStyleBold, tsStyleItalic];
+ if ((aFace^.style_flags and FT_STYLE_FLAG_BOLD) = 0) then
+ Exclude(prop.Style, tsStyleBold);
+ if ((aFace^.style_flags and FT_STYLE_FLAG_ITALIC) = 0) then
+ Exclude(prop.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;
+
+ prop.UnderlinePos := aFace^.underline_position div FT_SIZE_FACTOR;
+ prop.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;
+ 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
@@ -303,53 +358,36 @@ function TtsFontGeneratorFreeType.GetFontByFile(const aFilename: String; const a
var
face: FT_Face;
err: FT_Error;
- prop: TtsFontProperties;
- os2: PTT_OS2;
- hz: PTT_HoriHeader;
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);
+end;
- err := FT_Set_Char_Size(face, 0, aSize * FT_SIZE_FACTOR, FT_SIZE_RES, FT_SIZE_RES);
- 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 := face^.family_name;
- prop.StyleName := face^.style_name;
- LoadNames(face, prop);
-
- prop.Size := aSize;
- prop.AntiAliasing := aAntiAliasing;
- prop.DefaultChar := '?';
- prop.Style := aStyle + [tsStyleBold, tsStyleItalic];
- if ((face^.style_flags and FT_STYLE_FLAG_BOLD) = 0) then
- Exclude(prop.Style, tsStyleBold);
- if ((face^.style_flags and FT_STYLE_FLAG_ITALIC) = 0) then
- Exclude(prop.Style, tsStyleItalic);
-
- prop.Ascent := face^.size^.metrics.ascender div FT_SIZE_FACTOR;
- prop.Descent := -face^.size^.metrics.descender div FT_SIZE_FACTOR;
- prop.ExternalLeading := 0;
- prop.BaseLineOffset := 0;
-
- prop.UnderlinePos := face^.underline_position div FT_SIZE_FACTOR;
- prop.UnderlineSize := face^.underline_thickness div FT_SIZE_FACTOR;
-
- os2 := PTT_OS2(FT_Get_Sfnt_Table(face, 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;
- end;
-
- hz := PTT_HoriHeader(FT_Get_Sfnt_Table(face, FT_SFNT_HHEA));
- if Assigned(hz) then begin
- prop.ExternalLeading := hz^.Line_Gap div FT_SIZE_FACTOR;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorFreeType.GetFontByStream(const aStream: TStream; const aRenderer: TtsRenderer;
+ const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
+var
+ face: FT_Face;
+ err: FT_Error;
+ ms: TMemoryStream;
+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);
+ end else begin
+ ms := TMemoryStream.Create;
+ try
+ ms.CopyFrom(aStream, aStream.Size - aStream.Position);
+ err := FT_New_Memory_Face(fHandle, PByte(ms.Memory), ms.Size, 0, @face);
+ finally
+ FreeAndNil(ms);
+ end;
end;
-
- result := TtsFontFreeType.Create(TtsFreeTypeFaceHandle.Create(face), aRenderer, self, prop);
+ 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);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
diff --git a/utsFontCreatorGDI.pas b/utsFontCreatorGDI.pas
index 301deb9..17d8931 100644
--- a/utsFontCreatorGDI.pas
+++ b/utsFontCreatorGDI.pas
@@ -505,11 +505,11 @@ begin
Size := GetGlyphOutlineA(DC, GlyphIndex, GGO_METRICS or GGO_GLYPH_INDEX, @Metric, 0, nil, @font.fMat2);
if (Size <> GDI_ERROR) then begin
- aGlyphOrigin.x := Round(Metric.gmptGlyphOrigin.x / font.fMat2.eM11.value);
+ aGlyphOrigin.x := Metric.gmptGlyphOrigin.x;
aGlyphOrigin.y := Metric.gmptGlyphOrigin.y;
- aGlyphSize.x := Round(Metric.gmBlackBoxX / font.fMat2.eM11.value);
+ aGlyphSize.x := Metric.gmBlackBoxX;
aGlyphSize.y := Metric.gmBlackBoxY;
- aAdvance := Round(Metric.gmCellIncX / font.fMat2.eM11.value);
+ aAdvance := Metric.gmCellIncX;
result := true;
end;
finally
diff --git a/utsFreeType.pas b/utsFreeType.pas
index 040ed21..e15371c 100644
--- a/utsFreeType.pas
+++ b/utsFreeType.pas
@@ -326,10 +326,11 @@ type
short_metrics: Pointer;
end;
- TFT_Init_FreeType = function(aLibrary: PFT_Library): FT_Error;
- TFT_Done_FreeType = function(aLibrary: FT_Library): FT_Error;
- TFT_New_Face = function(aLibrary: FT_Library; const aFilename: PAnsiChar; aFaceIndex: FT_Long; aFace: PFT_Face): FT_Error;
- TFT_Done_Face = function(aFace: FT_Face): FT_Error;
+ TFT_Init_FreeType = function(aLibrary: PFT_Library): FT_Error;
+ TFT_Done_FreeType = function(aLibrary: FT_Library): FT_Error;
+ TFT_New_Face = function(aLibrary: FT_Library; const aFilename: PAnsiChar; aFaceIndex: FT_Long; aFace: PFT_Face): FT_Error;
+ TFT_New_Memory_Face = function(aLibrary: FT_Library; aData: PByte; aSize: FT_Long; aFaceIndex: FT_Long; aFace: PFT_Face): FT_Error;
+ TFT_Done_Face = function(aFace: FT_Face): FT_Error;
TFT_Get_Sfnt_Name_Count = function(aFace: FT_Face): FT_UInt;
TFT_Get_Sfnt_Name = function(aFace: FT_Face; aIndex: FT_UInt; aName: PFT_SfntName): FT_Error;
@@ -339,10 +340,11 @@ type
TFT_Get_Sfnt_Table = function(aFace: FT_Face; aTag: Integer): Pointer;
var
- FT_Init_FreeType: TFT_Init_FreeType;
- FT_Done_FreeType: TFT_Done_FreeType;
- FT_New_Face: TFT_New_Face;
- FT_Done_Face: TFT_Done_Face;
+ FT_Init_FreeType: TFT_Init_FreeType;
+ FT_Done_FreeType: TFT_Done_FreeType;
+ FT_New_Face: TFT_New_Face;
+ FT_New_Memory_Face: TFT_New_Memory_Face;
+ FT_Done_Face: TFT_Done_Face;
FT_Get_Sfnt_Name_Count: TFT_Get_Sfnt_Name_Count;
FT_Get_Sfnt_Name: TFT_Get_Sfnt_Name;
@@ -648,10 +650,11 @@ begin
raise EtsException.Create('unable to load free type lib: ' + LIB_FREE_TYPE + ' error=' + IntToStr(GetLastOSError));
end;
- FT_Init_FreeType := TFT_Init_FreeType(GetProcAddr('FT_Init_FreeType'));
- FT_Done_FreeType := TFT_Done_FreeType(GetProcAddr('FT_Done_FreeType'));
- FT_New_Face := TFT_New_Face( GetProcAddr('FT_New_Face'));
- FT_Done_Face := TFT_Done_Face( GetProcAddr('FT_Done_Face'));
+ FT_Init_FreeType := TFT_Init_FreeType( GetProcAddr('FT_Init_FreeType'));
+ FT_Done_FreeType := TFT_Done_FreeType( GetProcAddr('FT_Done_FreeType'));
+ FT_New_Face := TFT_New_Face( GetProcAddr('FT_New_Face'));
+ FT_New_Memory_Face := TFT_New_Memory_Face(GetProcAddr('FT_New_Memory_Face'));
+ FT_Done_Face := TFT_Done_Face( GetProcAddr('FT_Done_Face'));
FT_Get_Sfnt_Name_Count := TFT_Get_Sfnt_Name_Count(GetProcAddr('FT_Get_Sfnt_Name_Count'));
FT_Get_Sfnt_Name := TFT_Get_Sfnt_Name( GetProcAddr('FT_Get_Sfnt_Name'));
@@ -684,8 +687,18 @@ begin
FT_Done_FreeType(ftLibrary);
- FT_Init_FreeType := nil;
- FT_Done_FreeType := nil;
+ FT_Init_FreeType := nil;
+ FT_Done_FreeType := nil;
+ FT_New_Face := nil;
+ FT_New_Memory_Face := nil;
+ FT_Done_Face := nil;
+
+ FT_Get_Sfnt_Name_Count := nil;
+ FT_Get_Sfnt_Name := nil;
+
+ FT_Set_Char_Size := nil;
+ FT_Load_Char := nil;
+ FT_Get_Sfnt_Table := nil;
if (FreeTypeLibHandle <> 0) then begin
FreeLibrary(FreeTypeLibHandle);
diff --git a/utsOpenGLUtils.pas b/utsOpenGLUtils.pas
index 39bd380..92bcb2c 100644
--- a/utsOpenGLUtils.pas
+++ b/utsOpenGLUtils.pas
@@ -199,7 +199,7 @@ var
function AddToTexture(const aTexture: PtsFontTexture): TtsCharRenderRefOpenGL;
var
- x, y: Integer;
+ x, y, wChar, hChar, l, t: Integer;
item: PtsTextureTreeItem;
begin
item := InsertToTree(aTexture^.Usage, 0, 0, aTexture^.Size, aTexture^.Size, x, y);
@@ -209,18 +209,22 @@ var
item^.ref := TtsCharRenderRefOpenGL.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;
result.TextureID := aTexture^.ID;
result.Size := tsPosition(aCharImage.Width, aCharImage.Height);
result.TexMat := tsMatrix4f(
- tsVector4f(aCharImage.Width / aTexture^.Size, 0.0, 0.0, 0.0),
- tsVector4f(0.0, aCharImage.Height / aTexture^.Size, 0.0, 0.0),
+ tsVector4f(wChar / aTexture^.Size, 0.0, 0.0, 0.0),
+ tsVector4f(0.0, hChar / aTexture^.Size, 0.0, 0.0),
tsVector4f(0.0, 0.0, 1.0, 0.0),
- tsVector4f(x / aTexture^.Size, y / aTexture^.Size, 0.0, 1.0));
+ tsVector4f(l / aTexture^.Size, t / aTexture^.Size, 0.0, 1.0));
result.VertMat := tsMatrix4f(
- tsVector4f(aCharImage.Width, 0.0, 0.0, 0.0),
- tsVector4f(0.0, aCharImage.Height, 0.0, 0.0),
+ 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.GlyphRect.Left, -aChar.GlyphRect.Top - aChar.GlyphOrigin.y, 0.0, 1.0));
+ tsVector4f(aChar.GlyphOrigin.x, -aChar.GlyphOrigin.y, 0.0, 1.0));
UploadTexData(result, aCharImage, x, y);
end;
diff --git a/utsPostProcess.pas b/utsPostProcess.pas
index 04d7cfa..ed6e706 100644
--- a/utsPostProcess.pas
+++ b/utsPostProcess.pas
@@ -42,12 +42,12 @@ type
private
fKernel: TtsKernel2D;
fColor: TtsColor4f;
- fUpdateCharSize: Boolean;
+ fKeepCharSize: Boolean;
public
procedure Execute(const aChar: TtsChar; const aCharImage: TtsImage); override;
public
constructor Create(const aWidth, aStrength: Single; const aColor: TtsColor4f;
- const aUpdateCharSize: Boolean = false);
+ const aKeepCharSize: Boolean = false);
destructor Destroy; override;
end;
@@ -184,27 +184,31 @@ begin
FreeAndNil(orig);
end;
- if fUpdateCharSize then begin
- aChar.GlyphRect := tsRect(
- aChar.GlyphRect.Left + fKernel.SizeX - fKernel.MidSizeX,
- aChar.GlyphRect.Top + fKernel.SizeY - fKernel.MidSizeY,
- aChar.GlyphRect.Right + fKernel.SizeX + fKernel.MidSizeX,
- aChar.GlyphRect.Bottom + fKernel.SizeY + fKernel.MidSizeY);
+ 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.MidSizeX,
- aChar.GlyphOrigin.y + fKernel.MidSizeY);
- aChar.Advance := aChar.Advance + fKernel.MidSizeX ;
+ 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 aUpdateCharSize: Boolean);
+constructor TtsPostProcessBorder.Create(const aWidth, aStrength: Single; const aColor: TtsColor4f; const aKeepCharSize: Boolean);
begin
inherited Create;
- fKernel := TtsKernel2D.Create(aWidth, aStrength);
- fColor := aColor;
- fUpdateCharSize := aUpdateCharSize;
+ fKernel := TtsKernel2D.Create(aWidth, aStrength);
+ fColor := aColor;
+ fKeepCharSize := aKeepCharSize;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -236,9 +240,14 @@ begin
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);
+ aChar.GlyphOrigin.y + tmpX);
finally
FreeAndNil(orig);
end;
diff --git a/utsRendererOpenGL.pas b/utsRendererOpenGL.pas
index 2087a04..01a4e23 100644
--- a/utsRendererOpenGL.pas
+++ b/utsRendererOpenGL.pas
@@ -25,7 +25,7 @@ type
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); override;
+ procedure Render(const aCharRef: TtsCharRenderRef; const aForcedWidth: Integer); override;
public
constructor Create(const aContext: TtsContext; const aFormat: TtsFormat);
destructor Destroy; override;
@@ -171,9 +171,10 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGL.Render(const aCharRef: TtsCharRenderRef);
+procedure TtsRendererOpenGL.Render(const aCharRef: TtsCharRenderRef; const aForcedWidth: Integer);
var
ref: TtsCharRenderRefOpenGL;
+ m: TtsMatrix4f;
begin
if Assigned(aCharRef) and (aCharRef is TtsCharRenderRefOpenGL) then begin
ref := (aCharRef as TtsCharRenderRefOpenGL);
@@ -188,7 +189,12 @@ begin
glMatrixMode(GL_MODELVIEW);
glPushMatrix;
- glMultMatrixf(@ref.VertMat[0, 0]);
+ if (aForcedWidth > 0) then begin
+ m := ref.VertMat;
+ m[0] := tsVector4f(aForcedWidth, 0, 0, 0);
+ glMultMatrixf(@m[0, 0]);
+ end else
+ glMultMatrixf(@ref.VertMat[0, 0]);
glBindBuffer(GL_ARRAY_BUFFER, fVBO);
glEnableClientState(GL_VERTEX_ARRAY);
diff --git a/utsRendererOpenGLES.pas b/utsRendererOpenGLES.pas
index 4fadc57..40b1c5d 100644
--- a/utsRendererOpenGLES.pas
+++ b/utsRendererOpenGLES.pas
@@ -42,7 +42,7 @@ type
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); override;
+ procedure Render(const aCharRef: TtsCharRenderRef; const aForcedWidth: Integer); override;
public
property ShaderProgram: GLuint read fShaderProgram write SetShaderProgram;
property ProjectionMatrix: TtsMatrix4f read fProjMatrix write SetProjectionMatrix;
@@ -354,9 +354,10 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsRendererOpenGLES.Render(const aCharRef: TtsCharRenderRef);
+procedure TtsRendererOpenGLES.Render(const aCharRef: TtsCharRenderRef; const aForcedWidth: Integer);
var
ref: TtsCharRenderRefOpenGL;
+ m: TtsMatrix4f;
begin
if Assigned(aCharRef) and (aCharRef is TtsCharRenderRefOpenGL) then begin
ref := (aCharRef as TtsCharRenderRefOpenGL);
@@ -369,8 +370,14 @@ begin
glVertexAttribPointer(ATTRIB_LOCATION_TEXCOORD, 2, GL_FLOAT, false, SizeOf(TVertex), Pointer(8));
glUseProgram(fShaderProgram);
- if (fCharPosLocation >= 0) then
- glUniformMatrix4fv(fCharPosLocation, 1, false, @ref.VertMat);
+ if (fCharPosLocation >= 0) then begin
+ if (aForcedWidth > 0) then begin
+ m := ref.VertMat;
+ m[0] := tsVector4f(aForcedWidth, 0, 0, 0);
+ glUniformMatrix4fv(fCharPosLocation, 1, false, @m[0, 0]);
+ end else
+ glUniformMatrix4fv(fCharPosLocation, 1, false, @ref.VertMat[0, 0]);
+ end;
if (fCharTexPosLocation >= 0) then
glUniformMatrix4fv(fCharTexPosLocation, 1, false, @ref.TexMat);
diff --git a/utsTextSuite.pas b/utsTextSuite.pas
index ca68dd7..2f47ec2 100644
--- a/utsTextSuite.pas
+++ b/utsTextSuite.pas
@@ -384,7 +384,7 @@ type
function GetDrawPos: TtsPosition; virtual; abstract;
procedure MoveDrawPos(const X, Y: Integer); virtual; abstract;
procedure SetColor(const aColor: TtsColor4f); virtual; abstract;
- procedure Render(const aCharRef: TtsCharRenderRef); virtual; abstract;
+ procedure Render(const aCharRef: TtsCharRenderRef; const aForcedWidth: Integer = 0); virtual; abstract;
public
property Context: TtsContext read fContext;
property Format: TtsFormat read fFormat;
@@ -1287,7 +1287,8 @@ end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TtsFontGenerator.DrawLine(const aChar: TtsChar; const aCharImage: TtsImage; aLinePosition, aLineSize: Integer);
var
- NewSize, NewPos: TtsPosition;
+ ImgSize, ImgPos, Origin: TtsPosition;
+ Rect: TtsRect;
YOffset, y: Integer;
procedure FillLine(aData: PByte);
@@ -1296,7 +1297,7 @@ var
c: TtsColor4f;
tmp: PByte;
begin
- w := NewSize.x;
+ w := aCharImage.Width;
while (w > 0) do begin
tmp := aData;
tsFormatUnmap(aCharImage.Format, tmp, c);
@@ -1314,47 +1315,56 @@ begin
aLinePosition := aLinePosition - aLineSize;
// calculate width and height
- NewPos.x := 0;
- NewPos.y := 0;
- NewSize.x := aCharImage.Width;
- NewSize.y := aCharImage.Height;
+ ImgPos := tsPosition(0, 0);
+ ImgSize := tsPosition(aCharImage.Width, aCharImage.Height);
+ Origin := aChar.GlyphOrigin;
+ Rect := aChar.GlyphRect;
- // expand image to the full advance
- if aChar.Advance > aCharImage.Width then
- NewSize.x := aChar.Advance;
+ // expand left rect border to origin
+ if (Origin.x > 0) then begin
+ dec(Rect.Left, Origin.x);
+ Origin.x := 0;
+ end;
- // add glyph position to image width and set position
- if aChar.GlyphOrigin.x > aChar.GlyphRect.Left then begin
- NewSize.x := NewSize.x + aChar.GlyphOrigin.x;
- NewPos.x := aChar.GlyphOrigin.x;
+ // expand right rect border to advanced
+ if (Rect.Right - Rect.Left < aChar.Advance) then begin
+ Rect.Right := Rect.Left + aChar.Advance;
end;
- if (aChar.GlyphOrigin.x < 0) then
- NewSize.x := NewSize.x - aChar.GlyphOrigin.x;
- // line is under the image
- if aLinePosition < (aChar.GlyphOrigin.y - aCharImage.Height) then
- NewSize.y := NewSize.y + (aChar.GlyphOrigin.y - aCharImage.Height - aLinePosition);
+ // expand bottom rect border
+ if (Origin.y - aLinePosition > Rect.Bottom) then begin
+ Rect.Bottom := Origin.y - aLinePosition;
+ end;
- // line is above the image
- if aLinePosition + aLineSize > aChar.GlyphOrigin.y then begin
- NewPos.y := ((aLinePosition + aLineSize) - aChar.GlyphOrigin.y);
- NewSize.y := NewSize.y + NewPos.y;
+ // expand top rect border
+ if (Origin.y - aLinePosition - aLineSize < Rect.Top) then begin
+ Rect.Top := Origin.y - aLinePosition - aLineSize;
+ Origin.y := aLinePosition + aLineSize;
end;
- // resize
- aCharImage.Resize(NewSize.x, NewSize.y, NewPos.x, NewPos.y);
+ // 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;
+ aCharImage.Resize(ImgSize.x, ImgSize.y, ImgPos.x, ImgPos.y);
// draw lines
- YOffset := (aChar.GlyphOrigin.y + NewPos.y) - aLinePosition;
+ YOffset := Rect.Top + Origin.y - aLinePosition;
for y := 1 to aLineSize do
FillLine(aCharImage.ScanLine[YOffset - y]);
// move glyph rect
- aChar.GlyphRect := tsRect(
- aChar.GlyphRect.Left + NewPos.x,
- aChar.GlyphRect.Top + NewPos.y,
- aChar.GlyphRect.Right + NewPos.x,
- aChar.GlyphRect.Bottom + NewPos.y);
+ aChar.GlyphOrigin := Origin;
+ aChar.GlyphRect := Rect;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1393,14 +1403,19 @@ var
CharImage: TtsImage;
begin
result := nil;
- if not GetGlyphMetrics(aFont, aCharCode, GlyphOrigin, GlyphSize, Advance) or
- not ((GlyphOrigin.x <> 0) or (GlyphOrigin.y <> 0) or (GlyphSize.x <> 0) or (GlyphSize.y <> 0) or (Advance <> 0)) then
+ if (aCharCode <> #0) and
+ (not GetGlyphMetrics(aFont, aCharCode, GlyphOrigin, GlyphSize, Advance) or
+ not ((GlyphOrigin.x <> 0) or (GlyphOrigin.y <> 0) or (GlyphSize.x <> 0) or (GlyphSize.y <> 0) or (Advance <> 0))) then
exit;
CharImage := TtsImage.Create;
try
if aRenderer.SaveImages then begin
- if (GlyphSize.x > 0) and (GlyphSize.y > 0) then
+ if (aCharCode = #0) then begin
+ CharImage.CreateEmpty(aRenderer.Format, 3, 1);
+ GlyphOrigin := tsPosition(0, 1);
+ Advance := 1;
+ end else if (GlyphSize.x > 0) and (GlyphSize.y > 0) then
GetCharImage(aFont, aCharCode, CharImage);
if CharImage.IsEmpty and ([tsStyleUnderline, tsStyleStrikeout] * aFont.Properties.Style <> []) then begin
@@ -1412,8 +1427,11 @@ begin
result := TtsChar.Create(aCharCode);
try
result.GlyphOrigin := GlyphOrigin;
- result.GlyphRect := tsRect(0, 0, CharImage.Width, CharImage.Height);
result.Advance := Advance;
+ if (aCharCode = #0) then
+ result.GlyphRect := tsRect(1, 0, 2, 1)
+ else
+ result.GlyphRect := tsRect(0, 0, CharImage.Width, CharImage.Height);
if (aRenderer.SaveImages) then begin
try
@@ -2032,9 +2050,9 @@ var
while (c^ <> #0) do begin
char := GetChar(c^);
if Assigned(char) then begin
- MoveDrawPos(Char.GlyphOrigin.x, -metric.BaseLineOffset);
+ MoveDrawPos(0, -metric.BaseLineOffset);
Render(char.RenderRef);
- MoveDrawPos(char.Advance - char.GlyphOrigin.x + font.CharSpacing, metric.BaseLineOffset);
+ MoveDrawPos(char.Advance + font.CharSpacing, metric.BaseLineOffset);
end;
inc(c);
end;
@@ -2049,9 +2067,9 @@ var
char := GetChar(c^);
if Assigned(char) then begin
if (font.Properties.Style * [tsStyleUnderline, tsStyleStrikeout] <> []) then begin
- MoveDrawPos(char.GlyphOrigin.x, -metric.BaseLineOffset);
+ MoveDrawPos(0, -metric.BaseLineOffset);
Render(char.RenderRef);
- MoveDrawPos(char.Advance - char.GlyphOrigin.x + font.CharSpacing, metric.BaseLineOffset);
+ MoveDrawPos(char.Advance + font.CharSpacing, metric.BaseLineOffset);
end else begin
MoveDrawPos(char.Advance + font.CharSpacing, 0);
end;
@@ -2062,6 +2080,9 @@ var
tmp := Trunc(ExtraSpaceActual);
ExtraSpaceActual := ExtraSpaceActual - tmp;
if (font.Properties.Style * [tsStyleUnderline, tsStyleStrikeout] <> []) then begin
+ char := GetChar(#0);
+ if Assigned(char) then
+ Render(char.RenderRef, tmp);
// TODO draw lines; maybe with a temporary created fake char or something like an empty char?
end;
MoveDrawPos(tmp, 0);
@@ -2108,7 +2129,7 @@ var
tsHorzAlignRight:
x := rect.Right - line^.meta.Width;
tsHorzAlignJustify:
- if (tsAutoLineBreak in line^.Flags) then
+ if (tsAutoLineBreak in line^.Flags) and (line^.meta.SpaceCount > 0) then
ExtraSpaceTotal := (aBlock.Width - line^.meta.Width) / line^.meta.SpaceCount;
end;