commit a226a7e15bd2cff51b7bc9211ac0dcb3675ca5bc Author: Bergmann89 Date: Tue Jan 13 18:41:31 2015 +0100 * initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..7046fcc --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.exe +lib/ \ No newline at end of file diff --git a/TextSuiteTest.ico b/TextSuiteTest.ico new file mode 100644 index 0000000..0341321 Binary files /dev/null and b/TextSuiteTest.ico differ diff --git a/TextSuiteTest.lpi b/TextSuiteTest.lpi new file mode 100644 index 0000000..61be276 --- /dev/null +++ b/TextSuiteTest.lpi @@ -0,0 +1,119 @@ + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + </RequiredPackages> + <Units Count="10"> + <Unit0> + <Filename Value="TextSuiteTest.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="uMainForm.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="MainForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="uMainForm"/> + </Unit1> + <Unit2> + <Filename Value="new\utsTextSuite.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="utsTextSuite"/> + </Unit2> + <Unit3> + <Filename Value="old\TextSuite.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="TextSuite"/> + </Unit3> + <Unit4> + <Filename Value="old\TextSuiteImports.pas"/> + <IsPartOfProject Value="True"/> + </Unit4> + <Unit5> + <Filename Value="old\TextSuiteWideUtils.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="TextSuiteWideUtils"/> + </Unit5> + <Unit6> + <Filename Value="old\TextSuiteClasses.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="TextSuiteClasses"/> + </Unit6> + <Unit7> + <Filename Value="old\TextSuitePostProcess.pas"/> + <IsPartOfProject Value="True"/> + </Unit7> + <Unit8> + <Filename Value="old\TextSuiteTTFUtils.pas"/> + <IsPartOfProject Value="True"/> + </Unit8> + <Unit9> + <Filename Value="old\TextSuiteVersion.pas"/> + <IsPartOfProject Value="True"/> + </Unit9> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="TextSuiteTest"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir);old"/> + <OtherUnitFiles Value="old;..\bitSpace\_projects\MassiveUniverseOnline\bitSpaceEngine\src\OpenGLCore;new"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/TextSuiteTest.lpr b/TextSuiteTest.lpr new file mode 100644 index 0000000..38f7386 --- /dev/null +++ b/TextSuiteTest.lpr @@ -0,0 +1,21 @@ +program TextSuiteTest; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, uMainForm, TextSuite, TextSuiteClasses, TextSuiteImports, TextSuitePostProcess, + TextSuiteTTFUtils, TextSuiteVersion, TextSuiteWideUtils, utsTextSuite; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. + diff --git a/TextSuiteTest.lps b/TextSuiteTest.lps new file mode 100644 index 0000000..9d2195b --- /dev/null +++ b/TextSuiteTest.lps @@ -0,0 +1,350 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectSession> + <PathDelim Value="\"/> + <Version Value="9"/> + <BuildModes Active="Default"/> + <Units Count="19"> + <Unit0> + <Filename Value="TextSuiteTest.lpr"/> + <IsPartOfProject Value="True"/> + <EditorIndex Value="-1"/> + <CursorPos X="45" Y="17"/> + <UsageCount Value="60"/> + </Unit0> + <Unit1> + <Filename Value="uMainForm.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="MainForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="uMainForm"/> + <TopLine Value="79"/> + <CursorPos Y="97"/> + <UsageCount Value="60"/> + <Loaded Value="True"/> + <LoadedDesigner Value="True"/> + </Unit1> + <Unit2> + <Filename Value="new\utsTextSuite.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="utsTextSuite"/> + <IsVisibleTab Value="True"/> + <EditorIndex Value="2"/> + <TopLine Value="1988"/> + <CursorPos X="22" Y="2002"/> + <UsageCount Value="59"/> + <Loaded Value="True"/> + </Unit2> + <Unit3> + <Filename Value="old\TextSuite.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="TextSuite"/> + <EditorIndex Value="1"/> + <WindowIndex Value="1"/> + <TopLine Value="207"/> + <CursorPos X="3" Y="223"/> + <ExtraEditorCount Value="1"/> + <ExtraEditor1> + <EditorIndex Value="-1"/> + <TopLine Value="232"/> + <CursorPos X="3" Y="302"/> + </ExtraEditor1> + <UsageCount Value="54"/> + <Loaded Value="True"/> + </Unit3> + <Unit4> + <Filename Value="old\TextSuiteImports.pas"/> + <IsPartOfProject Value="True"/> + <EditorIndex Value="-1"/> + <TopLine Value="662"/> + <CursorPos X="3" Y="664"/> + <UsageCount Value="54"/> + </Unit4> + <Unit5> + <Filename Value="old\TextSuiteWideUtils.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="TextSuiteWideUtils"/> + <EditorIndex Value="2"/> + <WindowIndex Value="1"/> + <TopLine Value="1243"/> + <CursorPos X="18" Y="1257"/> + <UsageCount Value="54"/> + <Loaded Value="True"/> + </Unit5> + <Unit6> + <Filename Value="old\TextSuiteClasses.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="TextSuiteClasses"/> + <IsVisibleTab Value="True"/> + <WindowIndex Value="1"/> + <TopLine Value="4487"/> + <CursorPos X="28" Y="4439"/> + <UsageCount Value="54"/> + <Loaded Value="True"/> + </Unit6> + <Unit7> + <Filename Value="old\TextSuitePostProcess.pas"/> + <IsPartOfProject Value="True"/> + <EditorIndex Value="-1"/> + <WindowIndex Value="1"/> + <TopLine Value="163"/> + <CursorPos X="61" Y="141"/> + <UsageCount Value="54"/> + </Unit7> + <Unit8> + <Filename Value="old\TextSuiteTTFUtils.pas"/> + <IsPartOfProject Value="True"/> + <EditorIndex Value="-1"/> + <WindowIndex Value="-1"/> + <TopLine Value="-1"/> + <CursorPos X="-1" Y="-1"/> + <UsageCount Value="54"/> + </Unit8> + <Unit9> + <Filename Value="old\TextSuiteVersion.pas"/> + <IsPartOfProject Value="True"/> + <EditorIndex Value="-1"/> + <WindowIndex Value="-1"/> + <TopLine Value="-1"/> + <CursorPos X="-1" Y="-1"/> + <UsageCount Value="54"/> + </Unit9> + <Unit10> + <Filename Value="..\bitSpace\_projects\MassiveUniverseOnline\bitSpaceEngine\src\OpenGLCore\uglcTypes.pas"/> + <UnitName Value="uglcTypes"/> + <EditorIndex Value="1"/> + <TopLine Value="264"/> + <CursorPos X="3" Y="273"/> + <UsageCount Value="30"/> + <Loaded Value="True"/> + </Unit10> + <Unit11> + <Filename Value="..\bitSpace\_projects\MassiveUniverseOnline\bitSpaceEngine\src\OpenGLCore\dglOpenGL.pas"/> + <UnitName Value="dglOpenGL"/> + <EditorIndex Value="5"/> + <TopLine Value="11398"/> + <CursorPos X="3" Y="11232"/> + <UsageCount Value="30"/> + <Loaded Value="True"/> + </Unit11> + <Unit12> + <Filename Value="new\uglctextsuite.pas"/> + <EditorIndex Value="-1"/> + <CursorPos X="3" Y="13"/> + <UsageCount Value="15"/> + </Unit12> + <Unit13> + <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\2.7.1\source\rtl\inc\ustringh.inc"/> + <EditorIndex Value="4"/> + <TopLine Value="110"/> + <CursorPos X="10" Y="126"/> + <UsageCount Value="28"/> + <Loaded Value="True"/> + </Unit13> + <Unit14> + <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\2.7.1\source\rtl\inc\ustrings.inc"/> + <EditorIndex Value="-1"/> + <TopLine Value="1819"/> + <CursorPos X="37" Y="2066"/> + <UsageCount Value="6"/> + </Unit14> + <Unit15> + <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\2.7.1\source\rtl\inc\systemh.inc"/> + <EditorIndex Value="-1"/> + <TopLine Value="756"/> + <CursorPos X="32" Y="774"/> + <UsageCount Value="27"/> + </Unit15> + <Unit16> + <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\2.7.1\source\rtl\inc\heaph.inc"/> + <EditorIndex Value="3"/> + <TopLine Value="69"/> + <CursorPos X="10" Y="94"/> + <UsageCount Value="27"/> + <Loaded Value="True"/> + </Unit16> + <Unit17> + <Filename Value="old\TextSuiteCPUUtils.pas"/> + <EditorIndex Value="-1"/> + <WindowIndex Value="1"/> + <CursorPos X="23" Y="20"/> + <UsageCount Value="18"/> + </Unit17> + <Unit18> + <Filename Value="..\glBitmap\glBitmap\glBitmap.pas"/> + <EditorIndex Value="-1"/> + <CursorPos X="14" Y="14"/> + <UsageCount Value="6"/> + </Unit18> + </Units> + <JumpHistory Count="30" HistoryIndex="29"> + <Position1> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1979" TopLine="1967"/> + </Position1> + <Position2> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1980" TopLine="1967"/> + </Position2> + <Position3> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1981" TopLine="1967"/> + </Position3> + <Position4> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1982" TopLine="1967"/> + </Position4> + <Position5> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1983" TopLine="1967"/> + </Position5> + <Position6> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1984" TopLine="1967"/> + </Position6> + <Position7> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1987" TopLine="1967"/> + </Position7> + <Position8> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2032" TopLine="2015"/> + </Position8> + <Position9> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2037" TopLine="2015"/> + </Position9> + <Position10> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1970" TopLine="1954"/> + </Position10> + <Position11> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1973" TopLine="1954"/> + </Position11> + <Position12> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1974" TopLine="1954"/> + </Position12> + <Position13> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1975" TopLine="1967"/> + </Position13> + <Position14> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1977" TopLine="1967"/> + </Position14> + <Position15> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1991" TopLine="1967"/> + </Position15> + <Position16> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1995" TopLine="2008"/> + </Position16> + <Position17> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1997" TopLine="1982"/> + </Position17> + <Position18> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2008" TopLine="1982"/> + </Position18> + <Position19> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2054" TopLine="2037"/> + </Position19> + <Position20> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2032" TopLine="2016"/> + </Position20> + <Position21> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2037" Column="36" TopLine="2013"/> + </Position21> + <Position22> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2011" TopLine="1995"/> + </Position22> + <Position23> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2032" TopLine="2016"/> + </Position23> + <Position24> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1991" Column="51" TopLine="2005"/> + </Position24> + <Position25> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2011" TopLine="2006"/> + </Position25> + <Position26> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2034" TopLine="2012"/> + </Position26> + <Position27> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2035" TopLine="2012"/> + </Position27> + <Position28> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2051" TopLine="2035"/> + </Position28> + <Position29> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="1993" Column="28" TopLine="1991"/> + </Position29> + <Position30> + <Filename Value="new\utsTextSuite.pas"/> + <Caret Line="2011" TopLine="1990"/> + </Position30> + </JumpHistory> + </ProjectSession> + <Debugging> + <BreakPoints Count="4"> + <Item1> + <Kind Value="bpkSource"/> + <WatchScope Value="wpsLocal"/> + <WatchKind Value="wpkWrite"/> + <Source Value="new\utsTextSuite.pas"/> + <Line Value="2011"/> + </Item1> + <Item2> + <Kind Value="bpkSource"/> + <WatchScope Value="wpsLocal"/> + <WatchKind Value="wpkWrite"/> + <Source Value="new\utsTextSuite.pas"/> + <Line Value="2058"/> + </Item2> + <Item3> + <Kind Value="bpkSource"/> + <WatchScope Value="wpsLocal"/> + <WatchKind Value="wpkWrite"/> + <Source Value="new\utsTextSuite.pas"/> + <Line Value="2037"/> + </Item3> + <Item4> + <Kind Value="bpkSource"/> + <WatchScope Value="wpsLocal"/> + <WatchKind Value="wpkWrite"/> + <Source Value="new\utsTextSuite.pas"/> + <Line Value="1991"/> + </Item4> + </BreakPoints> + <Watches Count="4"> + <Item1> + <Expression Value="Text"/> + </Item1> + <Item2> + <Expression Value="p^.Text"/> + </Item2> + <Item3> + <Expression Value="TextBegin"/> + </Item3> + <Item4> + <Expression Value="aText"/> + </Item4> + </Watches> + </Debugging> +</CONFIG> diff --git a/TextSuiteTest.res b/TextSuiteTest.res new file mode 100644 index 0000000..7c6cf3e Binary files /dev/null and b/TextSuiteTest.res differ diff --git a/new/utsTextSuite.pas b/new/utsTextSuite.pas new file mode 100644 index 0000000..0408fa8 --- /dev/null +++ b/new/utsTextSuite.pas @@ -0,0 +1,2531 @@ +unit utsTextSuite; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, contnrs, math, syncobjs; + +type + TtsRendererType = ( + rtNull, + rtOpenGL); + + TtsCodePage = ( + tsUTF8, + tsISO_8859_1, + tsISO_8859_2, + tsISO_8859_3, + tsISO_8859_4, + tsISO_8859_5, + tsISO_8859_6, + tsISO_8859_7, + tsISO_8859_8, + tsISO_8859_9, + tsISO_8859_10, + tsISO_8859_11, + tsISO_8859_13, + tsISO_8859_14, + tsISO_8859_15, + tsISO_8859_16, + tsISO_037, + tsISO_437, + tsISO_500, + tsISO_737, + tsISO_775, + tsISO_850, + tsISO_852, + tsISO_855, + tsISO_857, + tsISO_860, + tsISO_861, + tsISO_862, + tsISO_863, + tsISO_864, + tsISO_865, + tsISO_866, + tsISO_869, + tsISO_874, + tsISO_875, + tsISO_1026, + tsISO_1250, + tsISO_1251, + tsISO_1252, + tsISO_1253, + tsISO_1254, + tsISO_1255, + tsISO_1256, + tsISO_1257, + tsISO_1258); + + TtsFontStyle = ( + tsStyleBold, + tsStyleItalic, + tsStyleUnderline, + tsStyleStrikeout); + TtsFontStyles = set of TtsFontStyle; + + TtsVertAlignment = ( + tsVertAlignTop, + tsVertAlignCenter, + tsVertAlignBottom); + + TtsHorzAlignment = ( + tsHorzAlignLeft, + tsHorzAlignCenter, + tsHorzAlignRight, + tsHorzAlignJustify); + + TtsFormat = ( + tsFormatEmpty, + tsFormatRGBA8, + tsFormatLumAlpha8); + + TtsAntiAliasing = ( + tsAANone, + tsAANormal); + + TtsColorChannel = ( + tsChannelRed, + tsChannelGreen, + tsChannelBlue, + tsChannelAlpha); + TtsColorChannels = set of TtsColorChannel; + + TtsImageMode = ( + tsModeIgnore, + tsModeReplace, + tsModeModulate); + TtsImageModes = array[TtsColorChannel] of TtsImageMode; + TtsImageModeFunc = function(const aSource, aDest: Single): Single; + + TtsPosition = packed record + x, y: Integer; + end; + PtsPosition = ^TtsPosition; + + TtsRect = packed record + case Byte of + 0: (TopLeft: TtsPosition; BottomRight: TtsPosition); + 1: (Left, Top, Right, Bottom: Integer); + end; + PtsRect = ^TtsRect; + + TtsColor4f = packed record + case Boolean of + true: (r, g, b, a: Single); + false: (arr: array[0..3] of Single); + end; + PtsColor4f = ^TtsColor4f; + + TtsColor4ub = packed record + case Boolean of + true: (r, g, b, a: Byte); + false: (arr: array[0..3] of Byte); + end; + PtsColor4ub = ^TtsColor4ub; + + TtsTextMetric = packed record + Ascent: Integer; + Descent: Integer; + ExternalLeading: Integer; + BaseLineOffset: Integer; + CharSpacing: Integer; + LineHeight: Integer; + LineSpacing: Integer; + end; + + TtsAnsiToWideCharFunc = procedure(aDst: PWideChar; const aSize: Integer; aSource: PAnsiChar; const aCodePage: TtsCodePage; const aDefaultChar: WideChar); + + TtsImage = class; + TtsFont = class; + TtsFontCreator = class; + TtsRenderer = class; + TtsContext = class; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TtsKernel1DItem = packed record + Offset: Integer; + Value: Single; + DataOffset: Integer; + end; + + TtsKernel1D = class + public + Size: Integer; + Items: array of TtsKernel1DItem; + ItemCount: Integer; + constructor Create(const aRadius, aStrength: Single); + end; + + TtsImageFunc = procedure(const aImage: TtsImage; X, Y: Integer; var aPixel: TtsColor4f; aArgs: Pointer); + TtsImage = class(TObject) + private + fWidth: Integer; + fHeight: Integer; + fFormat: TtsFormat; + + fData: Pointer; + fHasScanlines: Boolean; + fScanlines: array of Pointer; + + function GetScanline(const aIndex: Integer): Pointer; + function GetIsEmpty: Boolean; + procedure SetData(const aData: Pointer; const aFormat: TtsFormat = tsFormatEmpty; const aWidth: Integer = 0; const aHeight: Integer = 0); + procedure UpdateScanlines; + public + property IsEmpty: Boolean read GetIsEmpty; + property Width: Integer read fWidth; + property Height: Integer read fHeight; + property Format: TtsFormat read fFormat; + property Data: Pointer read fData; + property Scanline[const aIndex: Integer]: Pointer read GetScanline; + + function GetPixelAt(const x, y: Integer; out aColor: TtsColor4f): Boolean; + + procedure Assign(const aImage: TtsImage); + procedure CreateEmpty(const aFormat: TtsFormat; const aWidth, aHeight: Integer); + procedure LoadFromFunc(const aFunc: TtsImageFunc; const aArgs: Pointer); + + procedure Resize(const aNewWidth, aNewHeight, X, Y: Integer); + procedure FindMinMax(out aRect: TtsRect); + + procedure FillColor(const aColor: TtsColor4f; const aChannelMask: TtsColorChannels; const aModes: TtsImageModes); + procedure FillPattern(const aPattern: TtsImage; X, Y: Integer; const aChannelMask: TtsColorChannels; const aModes: TtsImageModes); + procedure BlendImage(const aImage: TtsImage; const X, Y: Integer); + procedure Blur(const aHorzKernel, aVertKernel: TtsKernel1D; const aChannelMask: TtsColorChannels); + + procedure AddResizingBorder; + + constructor Create; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TtsCharRenderRef = class(TObject); + TtsChar = class(TObject) + private + fCharCode: WideChar; + fGlyphOrigin: TtsPosition; + fGlyphRect: TtsRect; + fAdvance: Integer; + fHasResisingBorder: Boolean; + fRenderRef: TtsCharRenderRef; + public + property CharCode: WideChar read fCharCode; + property GlyphOrigin: TtsPosition read fGlyphOrigin write fGlyphOrigin; + property GlyphRect: TtsRect read fGlyphRect write fGlyphRect; + property Advance: Integer read fAdvance write fAdvance; + property HasResisingBorder: Boolean read fHasResisingBorder write fHasResisingBorder; + property RenderRef: TtsCharRenderRef read fRenderRef write fRenderRef; + + constructor Create(const aCharCode: WideChar); + end; + + TtsFontCharArray = packed record + Chars: array [Byte] of TtsChar; + CharCount: Byte; + end; + PtsFontCharArray = ^TtsFontCharArray; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TtsFont = class(TObject) + private + fCreateChars: Boolean; + fDefaultChar: WideChar; + + fCopyright: String; + fFaceName: String; + fStyleName: String; + fFullName: String; + + fSize: Integer; + fStyle: TtsFontStyles; + fAntiAliasing: TtsAntiAliasing; + + fAscent: Integer; + fDescent: Integer; + fExternalLeading: Integer; + fBaseLineOffset: Integer; + fCharSpacing: Integer; + fLineSpacing: Integer; + + fUnderlinePos: Integer; + fUnderlineSize: Integer; + fStrikeoutPos: Integer; + fStrikeoutSize: Integer; + + fChars: array[Byte] of PtsFontCharArray; + + fRenderer: TtsRenderer; + fCreator: TtsFontCreator; + + function HasChar(const aCharCode: WideChar): Boolean; + function GetChar(const aCharCode: WideChar): TtsChar; + procedure AddChar(const aCharCode: WideChar; const aChar: TtsChar); + public + property CreateChars: Boolean read fCreateChars write fCreateChars; + property Char[const aCharCode: WideChar]: TtsChar read GetChar; + + property Copyright: String read fCopyright; + property FaceName: String read fFaceName; + property StyleName: String read fStyleName; + property FullName: String read fFullName; + + property Size: Integer read fSize; + property Style: TtsFontStyles read fStyle; + property AntiAliasing: TtsAntiAliasing read fAntiAliasing; + property Renderer: TtsRenderer read fRenderer; + + property Ascent: Integer read fAscent; + property Descent: Integer read fDescent; + property ExternalLeading: Integer read fExternalLeading; + property BaseLineOffset: Integer read fBaseLineOffset; + property CharSpacing: Integer read fCharSpacing; + property LineSpacing: Integer read fLineSpacing; + + property DefaultChar: WideChar read fDefaultChar write fDefaultChar; + property UnderlinePos: Integer read fUnderlinePos write fUnderlinePos; + property UnderlineSize: Integer read fUnderlineSize write fUnderlineSize; + property StrikeoutPos: Integer read fStrikeoutPos write fStrikeoutPos; + property StrikeoutSize: Integer read fStrikeoutSize write fStrikeoutSize; + + procedure AddChar(const aCharCode: WideChar); + procedure AddCharRange(const aCharCodeBeg, aCharCodeEnd: WideChar); + procedure RemoveChar(const aCharCode: WideChar); + procedure ClearChars; + + function GetTextWidthW(aText: PWideChar): Integer; + procedure GetTextMetric(out aMetric: TtsTextMetric); + + constructor Create(const aRenderer: TtsRenderer; const aCreator: TtsFontCreator; + const aCopyright, aFaceName, aStyleName, aFullName: String; const aSize, aCharSpacing, aLineSpacing: Integer; + const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing); + destructor Destroy; override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TtsPostProcessStepRange = record + StartChar: WideChar; + EndChar: WideChar; + end; + PtsPostProcessStepRange = ^TtsPostProcessStepRange; + + TtsFontProcessStepUsage = ( + tsUsageInclude, + tsUsageExclude); + + TtsPostProcessStep = class(TObject) + private + fIncludeCharRange: TList; + fExcludeCharRange: TList; + + procedure ClearList(const aList: TList); + public + function IsInRange(const aCharCode: WideChar): Boolean; + procedure Execute(const aChar: TtsChar; const aCharImage: TtsImage); virtual; abstract; + + procedure AddUsageRange(const aUsage: TtsFontProcessStepUsage; const aStartChar, aEndChar: WideChar); + procedure AddUsageChars(const aUsage: TtsFontProcessStepUsage; aChars: PWideChar); + + procedure ClearIncludeRange; + procedure ClearExcludeRange; + + constructor Create; + destructor Destroy; override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TtsFontCreator = class(TObject) + private + fPostProcessSteps: TObjectList; + fAddResizingBorder: Boolean; + + function GetPostProcessStepCount: Integer; + function GetPostProcessStep(const aIndex: Integer): TtsPostProcessStep; + + procedure DrawLine(const aChar: TtsChar; const aCharImage: TtsImage; aLinePosition, aLineSize: Integer); + procedure DoPostProcess(const aChar: TtsChar; const aCharImage: TtsImage); + + function GetGlyphMetrics(const aCharCode: WideChar; out aGlyphOriginX, aGlyphOriginY, aGlyphWidth, aGlyphHeight, aAdvance: Integer): Boolean; virtual; abstract; + procedure GetCharImage(const aCharCode: WideChar; const CharImage: TtsImage); virtual; abstract; + public + property PostProcessStepCount: Integer read GetPostProcessStepCount; + property PostProcessStep[const aIndex: Integer]: TtsPostProcessStep read GetPostProcessStep; + property AddResizingBorder: Boolean read fAddResizingBorder write fAddResizingBorder; + + function GenerateChar(const aCharCode: WideChar; const aFont: TtsFont; const aRenderer: TtsRenderer): TtsChar; + + function AddPostProcessStep(const aStep: TtsPostProcessStep): TtsPostProcessStep; + function InsertPostProcessStep(const aIndex: Integer; const aStep: TtsPostProcessStep): TtsPostProcessStep; + procedure DeletePostProcessStep(const aIndex: Integer); + procedure ClearPostProcessSteps; + + constructor Create; + destructor Destroy; override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TtsLineItemType = ( + tsItemTypeUnknown, + tsItemTypeFont, + tsItemTypeColor, + tsItemTypeText, + tsItemTypeSpace, + tsItemTypeLineBreak, + tsItemTypeTab, + tsItemTypeSpacing); + + PtsLineItem = ^TtsLineItem; + TtsLineItem = packed record + Next: PtsLineItem; + Prev: PtsLineItem; + ItemType: TtsLineItemType; + case TtsLineItemType of + tsItemTypeFont: ( + Font: TtsFont + ); + tsItemTypeColor: ( + Color: TtsColor4f; + ); + tsItemTypeText, tsItemTypeSpace: ( + Text: PWideChar; // text of this item + TextWidth: Integer; // width of text (in pixel) + ); + tsItemTypeSpacing: ( + Spacing: Integer; + ); + end; + + TtsLineFlag = ( + tsLastItemIsSpace + ); + TtsLineFlags = set of TtsLineFlag; + PtsBlockLine = ^TtsBlockLine; + TtsBlockLine = packed record + Next: PtsBlockLine; + First: PtsLineItem; + Last: PtsLineItem; + + Flags: TtsLineFlags; + Width: Integer; // absolut width of this line + Height: Integer; // absolute height of this line + Spacing: Integer; // spacing between lines + Ascent: Integer; // text ascent + SpaceCount: Integer; // number of words in this line + AutoBreak: Boolean; // automatically set linebreak + end; + + TtsBlockFlag = ( + tsBlockFlagWordWrap + ); + TtsBlockFlags = set of TtsBlockFlag; + + TtsClipping = ( + tsClipNone, // no clipping + tsClipWordBorder, // draw all words that have at least one pixel inside the box + tsClipCharBorder, // draw all chars that have at least one pixel inside the box + tsClipWordComplete, // draw all words that are completly inside the box + tsClipCharComplete // draw all chars that are completly inside the box + ); + + TtsTextBlock = class(TObject) + private + fRenderer: TtsRenderer; + + fTop: Integer; + fLeft: Integer; + fWidth: Integer; + fHeight: Integer; + fFlags: TtsBlockFlags; + fVertAlign: TtsVertAlignment; + fHorzAlign: TtsHorzAlignment; + fClipping: TtsClipping; + + fTextMetric: TtsTextMetric; + fCurrentColor: TtsColor4f; + fCurrentFont: TtsFont; + fFirstLine: PtsBlockLine; + fLastLine: PtsBlockLine; + + function GetRect: TtsRect; + + procedure PushLineItem(const aItem: PtsLineItem; const aUpdateLineWidth: Boolean = true); + procedure PushSpacing(const aWidth: Integer); + procedure FreeLineItems(var aItem: PtsLineItem); + + procedure FreeLines(var aItem: PtsBlockLine); + + function SplitText(aText: PWideChar): PtsLineItem; + procedure SplitIntoLines(aItem: PtsLineItem); + procedure TrimSpaces(const aLine: PtsBlockLine); + protected + property Lines: PtsBlockLine read fFirstLine; + procedure PushNewLine; + constructor Create(const aRenderer: TtsRenderer; const aTop, aLeft, aWidth, aHeight: Integer; const aFlags: TtsBlockFlags); + public + property Renderer: TtsRenderer read fRenderer; + property CurrentColor: TtsColor4f read fCurrentColor; + property CurrentFont: TtsFont read fCurrentFont; + property Rect: TtsRect read GetRect; + property Width: Integer read fWidth; + property Height: Integer read fHeight; + property Flags: TtsBlockFlags read fFlags; + + property Top: Integer read fTop write fTop; + property Left: Integer read fLeft write fLeft; + property VertAlign: TtsVertAlignment read fVertAlign write fVertAlign; + property HorzAlign: TtsHorzAlignment read fHorzAlign write fHorzAlign; + property Clipping: TtsClipping read fClipping write fClipping; + + procedure ChangeFont(const aFont: TtsFont); + procedure ChangeColor(const aColor: TtsColor4f); + + function GetActualBlockHeight: Integer; + + procedure TextOutA(const aText: PAnsiChar); + procedure TextOutW(const aText: PWideChar); + + destructor Destroy; override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TtsRenderer = class(TObject) + private + fContext: TtsContext; + fFormat: TtsFormat; + fSaveImages: Boolean; + fCritSec: TCriticalSection; + protected + function AddRenderRef(const aChar: TtsChar; const aCharImage: TtsImage): TtsCharRenderRef; virtual; abstract; + procedure RemoveRenderRef(const aCharRef: TtsCharRenderRef); virtual; abstract; + + procedure BeginRender; virtual; + procedure EndRender; virtual; + + procedure SetDrawPos(const X, Y: Integer); virtual; abstract; + procedure MoveDrawPos(const X, Y: Integer); virtual; abstract; + procedure SetColor(const aColor: TtsColor4f); virtual; abstract; + procedure Render(const aCharRef: TtsCharRenderRef); virtual; abstract; + public + property Context: TtsContext read fContext; + property Format: TtsFormat read fFormat; + property SaveImages: Boolean read fSaveImages write fSaveImages; + + function BeginBlock(const aTop, aLeft, aWidth, aHeight: Integer; const aFlags: TtsBlockFlags): TtsTextBlock; + procedure EndBlock(var aBlock: TtsTextBlock); + + constructor Create(const aContext: TtsContext; const aFormat: TtsFormat); + destructor Destroy; override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TtsContext = class(TObject) + private + fID: Cardinal; + + fCodePage: TtsCodePage; + fCodePagePtr: Pointer; + fCodePageFunc: TtsAnsiToWideCharFunc; + fCodePageDefault: WideChar; + public + function AnsiToWide(const aText: PAnsiChar): PWideChar; + + constructor Create; + destructor Destroy; override; + end; + + EtsException = class(Exception); + EtsOutOfRange = class(EtsException) + public + constructor Create(const aMin, aMax, aIndex: Integer); + end; + +const + IMAGE_MODES_REPLACE: TtsImageModes = (tsModeReplace, tsModeReplace, tsModeReplace, tsModeReplace); + IMAGE_MODES_NORMAL: TtsImageModes = (tsModeReplace, tsModeReplace, tsModeReplace, tsModeModulate); + + COLOR_CHANNELS_RGB: TtsColorChannels = [tsChannelRed, tsChannelGreen, tsChannelBlue]; + COLOR_CHANNELS_RGBA: TtsColorChannels = [tsChannelRed, tsChannelGreen, tsChannelBlue, tsChannelAlpha]; + +function tsStrAlloc(aSize: Cardinal): PWideChar; +function tsStrNew(const aText: PWideChar): PWideChar; +procedure tsStrDispose(const aText: PWideChar); +function tsStrLength(aText: PWideChar): Cardinal; +function tsStrCopy(aDst, aSrc: PWideChar): PWideChar; +function tsISO_8859_1ToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar): Integer; +function tsUTF8ToWide(aDst: PWideChar; const aSize: Integer; const aSrc: PAnsiChar; const aDefaultChar: WideChar): Integer; + +function tsColor4f(r, g, b, a: Single): TtsColor4f; +function tsRect(const l, t, r, b: Integer): TtsRect; +function tsPosition(const x, y: Integer): TtsPosition; + +function tsFormatSize(const aFormat: TtsFormat): Integer; +procedure tsFormatMap(const aFormat: TtsFormat; var aData: PByte; const aColor: TtsColor4f); +procedure tsFormatUnmap(const aFormat: TtsFormat; var aData: PByte; out aColor: TtsColor4f); + +function tsImageModeFuncIgnore(const aSource, aDest: Single): Single; +function tsImageModeFuncReplace(const aSource, aDest: Single): Single; +function tsImageModeFuncModulate(const aSource, aDest: Single): Single; + +implementation + +var + gLastContextID: Cardinal = 0; + +const + IMAGE_MODE_FUNCTIONS: array[TtsImageMode] of TtsImageModeFunc = ( + @tsImageModeFuncIgnore, + @tsImageModeFuncReplace, + @tsImageModeFuncModulate); + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsStrAlloc(aSize: Cardinal): PWideChar; +begin + aSize := (aSize + 1) shl 1; + GetMem(result, aSize); + FillChar(result^, aSize, 0); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsStrNew(const aText: PWideChar): PWideChar; +begin + result := tsStrAlloc(tsStrLength(aText)); + tsStrCopy(result, aText); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure tsStrDispose(const aText: PWideChar); +begin + FreeMem(aText); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsStrLength(aText: PWideChar): Cardinal; +begin + result := 0; + if Assigned(aText) then + while (ord(aText^) <> 0) do begin + inc(result); + inc(aText); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsStrCopy(aDst, aSrc: PWideChar): PWideChar; +begin + result := aDst; + if Assigned(aDst) and Assigned(aSrc) then + while ord(aSrc^) <> 0 do begin + aDst^ := aSrc^; + inc(aDst); + inc(aSrc); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsISO_8859_1ToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar): Integer; +begin + result := 0; + if Assigned(aDst) and Assigned(aSrc) then + while (ord(aSrc^) <> 0) do begin + aDst^ := WideChar(aSrc^); + inc(aDst); + inc(aSrc); + inc(result); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsUTF8ToWide(aDst: PWideChar; const aSize: Integer; const aSrc: PAnsiChar; const aDefaultChar: WideChar): Integer; + + procedure AddToDest(aCharCode: UInt64); + begin + if (aCharCode > $FFFF) then + aCharCode := ord(aDefaultChar); + + PWord(aDst)^ := aCharCode; + inc(aDst); + result := result + 1; + end; + +const + STATE_STARTBYTE = 0; + STATE_FOLLOWBYTE = 1; +var + cc: QWord; + len, state, c: Integer; + p: PByte; + tmp: Byte; +begin + result := 0; + if not Assigned(aDst) or not Assigned(aSrc) or (aSize <= 0) then + exit; + + p := PByte(aSrc); + len := Length(aSrc); + state := STATE_STARTBYTE; + while (len > 0) do begin + case state of + STATE_STARTBYTE: begin + if (p^ and %10000000 = 0) then begin + AddToDest(p^); + end else if (p^ and %01000000 > 0) then begin + tmp := p^; + c := 0; + while (tmp and %10000000) > 0 do begin + inc(c); + tmp := tmp shl 1; + end; + cc := p^ and ((1 shl (7 - c)) - 1); + state := STATE_FOLLOWBYTE; + c := c - 1; + end; + end; + + STATE_FOLLOWBYTE: begin + if ((p^ and %11000000) = %10000000) then begin + cc := (cc shl 6) or (p^ and %00111111); + c := c - 1; + if (c = 0) then begin + AddToDest(cc); + state := STATE_STARTBYTE; + end; + end else + state := STATE_STARTBYTE; + end; + end; + + if (result >= aSize) then + exit; + inc(p); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsColor4f(r, g, b, a: Single): TtsColor4f; +begin + result.r := r; + result.g := g; + result.b := b; + result.a := a; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsRect(const l, t, r, b: Integer): TtsRect; +begin + result.Left := l; + result.Top := t; + result.Right := r; + result.Bottom := b; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsPosition(const x, y: Integer): TtsPosition; +begin + result.x := x; + result.y := y; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsFormatSize(const aFormat: TtsFormat): Integer; +begin + case aFormat of + tsFormatRGBA8: result := 4; + tsFormatLumAlpha8: result := 2; + else + result := 0; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure tsFormatMap(const aFormat: TtsFormat; var aData: PByte; const aColor: TtsColor4f); +var + i: Integer; + s: Single; +begin + case aFormat of + tsFormatRGBA8: begin + for i := 0 to 3 do begin + aData^ := Trunc($FF * aColor.arr[i]); + inc(aData); + end; + end; + + tsFormatLumAlpha8: begin + s := 0.30 * aColor.r + 0.59 * aColor.g + 0.11 * aColor.b; + aData^ := Trunc($FF * s); inc(aData); + aData^ := Trunc($FF * s); inc(aData); + aData^ := Trunc($FF * s); inc(aData); + aData^ := Trunc($FF * aColor.a); inc(aData); + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure tsFormatUnmap(const aFormat: TtsFormat; var aData: PByte; out aColor: TtsColor4f); +var + i: Integer; +begin + case aFormat of + tsFormatRGBA8: begin + for i := 0 to 3 do begin + aColor.arr[i] := aData^ / $FF; + inc(aData); + end; + end; + + tsFormatLumAlpha8: begin + aColor.r := aData^ / $FF; + aColor.g := aData^ / $FF; + aColor.b := aData^ / $FF; + inc(aData); + aColor.a := aData^ / $FF; + inc(aData); + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsImageModeFuncIgnore(const aSource, aDest: Single): Single; +begin + result := aDest; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsImageModeFuncReplace(const aSource, aDest: Single): Single; +begin + result := aSource; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function tsImageModeFuncModulate(const aSource, aDest: Single): Single; +begin + result := aSource * aDest; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TtsKernel1D/////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TtsKernel1D.Create(const aRadius, aStrength: Single); +var + TempRadius, SQRRadius, TempStrength, TempValue: Double; + Idx: Integer; + + function CalcValue(const aIndex: Integer): Single; + var + Temp: Double; + begin + Temp := Max(0, Abs(aIndex) - TempStrength); + Temp := Sqr(Temp * TempRadius) / SQRRadius; + result := Exp(-Temp); + end; + +begin + inherited Create; + + // calculate new radius and strength + TempStrength := Min(aRadius - 1, aRadius * aStrength); + TempRadius := aRadius - TempStrength; + SQRRadius := sqr(TempRadius) * sqr(TempRadius); + + // caluculating size of the kernel + Size := Round(TempRadius); + while CalcValue(Size) > 0.001 do + Inc(Size); + Size := Size -1; + ItemCount := Size * 2 +1; + SetLength(Items, ItemCount); + + // calculate Value (yes thats right. there is no -1) + for Idx := 0 to Size do begin + TempValue := CalcValue(Idx); + + with Items[Size + Idx] do begin + Offset := Idx; + Value := TempValue; + end; + + with Items[Size - Idx] do begin + Offset := -Idx; + Value := TempValue; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TtsImage////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsImage.GetScanline(const aIndex: Integer): Pointer; +begin + if not fHasScanlines then + UpdateScanlines; + + if fHasScanlines and (aIndex >= 0) and (aIndex <= High(fScanlines)) then + result := fScanlines[aIndex] + else + result := nil; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsImage.GetIsEmpty: Boolean; +begin + result := not Assigned(fData); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.SetData(const aData: Pointer; const aFormat: TtsFormat; const aWidth: Integer; const aHeight: Integer); +begin + fHasScanlines := false; + if Assigned(fData) then + FreeMemory(fData); + + fData := aData; + if Assigned(fData) then begin + fWidth := aWidth; + fHeight := aHeight; + fFormat := aFormat; + end else begin + fWidth := 0; + fHeight := 0; + fFormat := tsFormatEmpty; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.UpdateScanlines; +var + i, LineSize: Integer; + tmp: PByte; +begin + LineSize := fWidth * tsFormatSize(fFormat); + SetLength(fScanlines, fHeight); + for i := 0 to fHeight-1 do begin + tmp := fData; + inc(tmp, i * LineSize); + fScanlines[i] := tmp; + end; + fHasScanlines := true; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsImage.GetPixelAt(const x, y: Integer; out aColor: TtsColor4f): Boolean; +var + p: PByte; +begin + result := (x >= 0) and (x < Width) and (y >= 0) and (y < Height); + if result then begin + p := Scanline[y]; + inc(p, x * tsFormatSize(Format)); + tsFormatUnmap(Format, p, aColor); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.Assign(const aImage: TtsImage); +var + ImgData: Pointer; + ImgSize: Integer; +begin + ImgSize := aImage.Width * aImage.Height * tsFormatSize(aImage.Format); + GetMem(ImgData, ImgSize); + if Assigned(ImgData) then + Move(aImage.Data, ImgData, ImgSize); + SetData(ImgData, aImage.Format, aImage.Width, aImage.Height); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.CreateEmpty(const aFormat: TtsFormat; const aWidth, aHeight: Integer); +var + ImgData: PByte; +begin + ImgData := AllocMem(aWidth * aHeight * tsFormatSize(aFormat)); + SetData(ImgData, aFormat, aWidth, aHeight); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.LoadFromFunc(const aFunc: TtsImageFunc; const aArgs: Pointer); +var + X, Y: Integer; + c: TtsColor4f; + p, tmp: PByte; +begin + for Y := 0 to Height - 1 do begin + p := ScanLine[Y]; + for X := 0 to Width - 1 do begin + tmp := p; + tsFormatUnmap(fFormat, tmp, c); + aFunc(Self, X, Y, c, aArgs); + tsFormatMap(fFormat, p, c); + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.Resize(const aNewWidth, aNewHeight, X, Y: Integer); +var + ImgData: PByte; + PixSize, LineSize, ImageSize, OrgLineSize: Integer; + + src, dst: PByte; + YStart, YEnd, YPos, XStart, XEnd: Integer; +begin + if (aNewHeight = 0) or (aNewWidth = 0) then begin + SetData(nil); + exit; + end; + + PixSize := tsFormatSize(Format); + LineSize := PixSize * aNewWidth; + ImageSize := LineSize * aNewHeight; + OrgLineSize := PixSize * Width; + + GetMem(ImgData, ImageSize); + try + FillChar(ImgData^, ImageSize, 0); + + // positions + YStart := Max(0, Y); + YEnd := Min(aNewHeight, Y + Height); + XStart := Max(0, X); + XEnd := Min(aNewWidth, X + Width); + + // copy data + for YPos := YStart to YEnd -1 do begin + dst := ImgData; + Inc(dst, LineSize * YPos + PixSize * XStart); + + src := fData; + Inc(src, OrgLineSize * (YPos - Y) + PixSize * (XStart - X)); + + Move(src^, dst^, (XEnd - XStart) * PixSize); + end; + + // assign + SetData(ImgData, Format, aNewWidth, aNewHeight); + except + FreeMem(ImgData); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.FindMinMax(out aRect: TtsRect); +var + X, Y: Integer; + c: TtsColor4f; + p: PByte; +begin + aRect.Top := -1; + aRect.Left := -1; + aRect.Right := -1; + aRect.Bottom := -1; + + // Search for MinMax + for Y := 0 to Height-1 do begin + p := ScanLine[Y]; + for X := 0 to Width-1 do begin + tsFormatUnmap(Format, p, c); + if c.a > 0 then begin + if (X < aRect.Left) or (aRect.Left = -1) then + aRect.Left := X; + + if (X+1 > aRect.Right) or (aRect.Right = -1) then + aRect.Right := X+1; + + if (Y < aRect.Top) or (aRect.Top = -1) then + aRect.Top := Y; + + if (Y+1 > aRect.Bottom) or (aRect.Bottom = -1) then + aRect.Bottom := Y+1; + end; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.FillColor(const aColor: TtsColor4f; const aChannelMask: TtsColorChannels; const aModes: TtsImageModes); +var + x, y: Integer; + p: PByte; + c: TtsColor4f; + ch: TtsColorChannel; + i: Integer; +begin + for y := 0 to Height-1 do begin + p := Scanline[y]; + for x := 0 to Width-1 do begin + tsFormatUnmap(Format, p, c); + for i := 0 to 3 do begin + ch := TtsColorChannel(i); + if (ch in aChannelMask) then + c.arr[i] := IMAGE_MODE_FUNCTIONS[aModes[ch]](aColor.arr[i], c.arr[i]); + end; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.FillPattern(const aPattern: TtsImage; X, Y: Integer; const aChannelMask: TtsColorChannels; const aModes: TtsImageModes); +var + _x, _y, posX, i: Integer; + src, dst, tmp: PByte; + cSrc, cDst: TtsColor4f; + ch: TtsColorChannel; +begin + if x < 0 then + x := Random(aPattern.Width); + if y < 0 then + y := Random(aPattern.Height); + + for _y := 0 to Height-1 do begin + src := aPattern.Scanline[(y + _y) mod aPattern.Height]; + dst := Scanline[_y]; + + inc(src, x); + posX := x; + + for _x := 0 to Width-1 do begin + if (posX >= aPattern.Width) then begin + src := aPattern.Scanline[(y + _y) mod aPattern.Height]; + posX := 0; + end; + + tmp := dst; + tsFormatUnmap(Format, src, cSrc); + tsFormatUnmap(Format, tmp, cDst); + for i := 0 to 3 do begin + ch := TtsColorChannel(i); + if (ch in aChannelMask) then + cDst.arr[i] := IMAGE_MODE_FUNCTIONS[aModes[ch]](cSrc.arr[i], cDst.arr[i]); + end; + tsFormatMap(Format, dst, cDst); + inc(posX); + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.BlendImage(const aImage: TtsImage; const X, Y: Integer); +var + _x, _y, i: Integer; + c, cOver, cUnder: TtsColor4f; + FaqOver, FaqUnder: Single; + UnionRect, IntersectRect: TtsRect; + NewSize: TtsPosition; + ImgSize: Integer; + ImgData, dst, src, pOver, pUnder: PByte; + tmpLines: array of Pointer; +begin + UnionRect := tsRect( + Min(X, 0), + Min(Y, 0), + Max(X + aImage.Width, Width), + Max(Y + aImage.Height, Height)); + IntersectRect := tsRect( + Max(X, 0), + Max(Y, 0), + Min(X + aImage.Width, Width), + Min(X + aImage.Height, Height)); + NewSize := tsPosition( + UnionRect.Right - UnionRect.Left, + UnionRect.Bottom - UnionRect.Top); + + ImgSize := NewSize.x * NewSize.y * tsFormatSize(Format); + GetMem(ImgData, ImgSize); + try + FillByte(ImgData^, ImgSize, $00); + + // temporary scanlines + SetLength(tmpLines, NewSize.y); + for _y := 0 to NewSize.y-1 do begin + tmpLines[_y] := ImgData; + inc(tmpLines[_y], _y * NewSize.y); + end; + + // copy data from underlaying image + for _y := 0 to Height-1 do begin + src := Scanline[_y]; + dst := tmpLines[_y - UnionRect.Top]; + dec(dst, UnionRect.Left); + for _x := 0 to Width-1 do begin + dst^ := src^; + inc(src); + inc(dst); + end; + end; + + // copy data from overlaying image + for _y := 0 to aImage.Height-1 do begin + src := aImage.Scanline[_y]; + dst := tmpLines[_y + y - UnionRect.Top]; + inc(dst, X - UnionRect.Left); + for _x := 0 to Width-1 do begin + dst^ := src^; + inc(src); + inc(dst); + end; + end; + + // blend overlapped + for _y := IntersectRect.Top to IntersectRect.Bottom-1 do begin + pOver := aImage.Scanline[_y - Min(IntersectRect.Top, UnionRect.Top)]; + inc(pOver, IntersectRect.Left - UnionRect.Left); + + pUnder := Scanline[_y - Min(IntersectRect.Top, 0)]; + inc(pUnder, IntersectRect.Left); + + dst := tmpLines[_y - Min(Y, 0)]; + inc(dst, IntersectRect.Left - Min(X, 0)); + + for _x := IntersectRect.Left to IntersectRect.Right-1 do begin + tsFormatUnmap(aImage.Format, pOver, cOver); + tsFormatUnmap(Format, pUnder, cUnder); + c.a := cOver.a + cUnder.a * (1 - cOver.a); + if (c.a > 0) then begin + FaqUnder := (cUnder.a * (1 - cOver.a)) / c.a; + FaqOver := cOver.a / c.a; + for i := 0 to 2 do + c.arr[i] := cOver.arr[i] * FaqOver + cUnder.arr[i] * FaqUnder; + end else begin + c.r := 0; + c.g := 0; + c.b := 0; + end; + tsFormatMap(Format, dst, c); + end; + end; + except + FreeMem(ImgData); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.Blur(const aHorzKernel, aVertKernel: TtsKernel1D; const aChannelMask: TtsColorChannels); +var + tmpImage: TtsImage; + + procedure DoBlur(const aSrc, aDst: TtsImage; const aKernel: TtsKernel1D; const ShiftX, ShiftY: Integer); + var + x, y, i, j: Integer; + src, dst: PByte; + v: Single; + c, tmp: TtsColor4f; + begin + for y := 0 to Height-1 do begin + src := aSrc.Scanline[y]; + dst := aDst.Scanline[y]; + for x := 0 to Width-1 do begin + + // read color and clear channels + v := 0; + tsFormatUnmap(aSrc.Format, src, c); + for j := 0 to 3 do + if (TtsColorChannel(j) in aChannelMask) then + c.arr[j] := 0; + + // do blur + for i := 0 to aKernel.ItemCount-1 do with aKernel.Items[i] do begin + if aSrc.GetPixelAt(x + Offset * ShiftX, y + Offset * ShiftY, tmp) then begin + for j := 0 to 3 do begin + if (TtsColorChannel(j) in aChannelMask) then + c.arr[j] := c.arr[j] + tmp.arr[j] * Value; + end; + v := v + Value; + end; + end; + + // calc final color and write + for j := 0 to 3 do + if (TtsColorChannel(i) in aChannelMask) then + c.arr[j] := c.arr[j] / v; + tsFormatMap(aDst.Format, dst, c); + end; + end; + end; + +begin + tmpImage := TtsImage.Create; + try + tmpImage.CreateEmpty(Format, Width, Height); + tmpImage.FillColor(tsColor4f(1, 1, 1, 0), COLOR_CHANNELS_RGBA, IMAGE_MODES_REPLACE); + + DoBlur(self, tmpImage, aHorzKernel, 1, 0); + DoBlur(tmpImage, self, aVertKernel, 0, 1); + finally + FreeAndNil(tmpImage); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsImage.AddResizingBorder; +var + c, cTmp, cSum: TtsColor4f; + x, y, cnt: Integer; + p, tmp: PByte; + + procedure AddCol(const aColor: TtsColor4f); + var + i: Integer; + begin + if (aColor.a > 0) then begin + inc(cnt); + for i := 0 to 2 do + cSum.arr[i] := cSum.arr[i] + cTmp.arr[i]; + end; + end; + +var + i: Integer; +begin + Resize(Width + 4, Height + 4, 2, 2); + for y := 0 to Height-1 do begin + p := Scanline[y]; + for x := 0 to Width-1 do begin + FillByte(cSum, SizeOf(cSum), 0); + cnt := 0; + tmp := p; + tsFormatUnmap(Format, tmp, c); + if (c.a = 0) then begin + + // row - 1 + if (y > 0) then begin + + // row - 1 | col + GetPixelAt(x, y-1, cTmp); + AddCol(cTmp); + + //row - 1 | col - 1 + if (x > 0) then begin + GetPixelAt(x-1, y-1, cTmp); + AddCol(cTmp); + end; + + // row - 1 | col + 1 + if (x < Width-1) then begin + GetPixelAt(x+1, y-1, cTmp); + AddCol(cTmp); + end; + end; + + // row + 1 + if (y < Height-1) then begin + // row - 1 | col + GetPixelAt(x, y+1, cTmp); + AddCol(cTmp); + + //row + 1 | col - 1 + if (x > 0) then begin + GetPixelAt(x-1, y+1, cTmp); + AddCol(cTmp); + end; + + // row + 1 | col + 1 + if (x < Width-1) then begin + GetPixelAt(x+1, y+1, cTmp); + AddCol(cTmp); + end; + end; + + //row | col - 1 + if (x > 0) then begin + GetPixelAt(x-1, y+1, cTmp); + AddCol(cTmp); + end; + + // row | col + 1 + if (x < Width-1) then begin + GetPixelAt(x+1, y+1, cTmp); + AddCol(cTmp); + end; + + // any pixel next to the transparent pixel they are opaque? + if (cnt > 0) then begin + for i := 0 to 2 do + c.arr[i] := cSum.arr[i] / cnt; + end; + end; + tsFormatMap(Format, p, c); + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TtsImage.Create; +begin + inherited Create; + SetData(nil); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TtsChar/////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TtsChar.Create(const aCharCode: WideChar); +begin + inherited Create; + fCharCode := aCharCode; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TtsFont/////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsFont.HasChar(const aCharCode: WideChar): Boolean; +begin + result := Assigned(GetChar(aCharCode)); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsFont.GetChar(const aCharCode: WideChar): TtsChar; +var + Chars: PtsFontCharArray; +begin + Chars := fChars[(Ord(aCharCode) shr 8) and $FF]; + if Assigned(Chars) then + result := Chars^.Chars[Ord(aCharCode) and $FF] + else + result := nil; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsFont.AddChar(const aCharCode: WideChar; const aChar: TtsChar); +var + h, l: Integer; + Chars: PtsFontCharArray; +begin + h := (Ord(aCharCode) shr 8) and $FF; + Chars := fChars[h]; + if not Assigned(Chars) then begin + New(Chars); + FillChar(Chars^, SizeOf(Chars^), 0); + fChars[h] := Chars; + end; + + if Assigned(Chars) then begin + l := Ord(aCharCode) and $FF; + Chars^.Chars[l] := aChar; + inc(Chars^.CharCount); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsFont.AddChar(const aCharCode: WideChar); +var + c: TtsChar; +begin + if not fCreateChars or (Ord(aCharCode) > 0) then + exit; + + c := GetChar(aCharCode); + if Assigned(c) then + exit; + + c := fCreator.GenerateChar(aCharCode, self, fRenderer); + if Assigned(c) then + AddChar(aCharCode, c); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsFont.AddCharRange(const aCharCodeBeg, aCharCodeEnd: WideChar); +var + c: WideChar; +begin + for c := aCharCodeBeg to aCharCodeEnd do + AddChar(c); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsFont.RemoveChar(const aCharCode: WideChar); +var + h, l: Integer; + Chars: PtsFontCharArray; + c: TtsChar; +begin + // find char array + h := (Ord(aCharCode) shr 8) and $FF; + Chars := fChars[h]; + if not Assigned(Chars) then + exit; + + // find char + l := Ord(aCharCode) and $FF; + c := Chars^.Chars[l]; + if not Assigned(c) then + exit; + + // remove char + Chars^.Chars[l] := nil; + dec(Chars^.CharCount); + if (Chars^.CharCount <= 0) then begin + fChars[h] := nil; + Dispose(Chars); + end; + + if Assigned(c.RenderRef) then begin + fRenderer.RemoveRenderRef(c.RenderRef); + c.RenderRef.Free; + end; + FreeAndNil(c); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsFont.ClearChars; +var + h, l: Integer; + Chars: PtsFontCharArray; + c: TtsChar; +begin + for h := Low(fChars) to High(fChars) do begin + Chars := fChars[h]; + if Assigned(Chars) then begin + for l := Low(Chars^.Chars) to High(Chars^.Chars) do begin + c := Chars^.Chars[l]; + if Assigned(c) then begin + if Assigned(c.RenderRef) then begin + fRenderer.RemoveRenderRef(c.RenderRef); + c.RenderRef.Free; + end; + FreeAndNil(c); + end; + end; + Dispose(Chars); + fChars[h] := nil; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsFont.GetTextWidthW(aText: PWideChar): Integer; +var + c: TtsChar; +begin + result := 0; + if not Assigned(aText) then + exit; + + while (aText^ <> #0) do begin + c := GetChar(aText^); + if not Assigned(c) then + c := GetChar(fDefaultChar); + if Assigned(c) then begin + if (result > 0) then + result := result + CharSpacing; + result := result + c.Advance; + end; + inc(aText); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsFont.GetTextMetric(out aMetric: TtsTextMetric); +begin + aMetric.Ascent := Ascent; + aMetric.Descent := Descent; + aMetric.ExternalLeading := ExternalLeading; + aMetric.BaseLineOffset := BaseLineOffset; + aMetric.CharSpacing := CharSpacing; + aMetric.LineHeight := Ascent + Descent + ExternalLeading; + aMetric.LineSpacing := LineSpacing; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TtsFont.Create(const aRenderer: TtsRenderer; const aCreator: TtsFontCreator; const aCopyright, aFaceName, + aStyleName, aFullName: String; const aSize, aCharSpacing, aLineSpacing: Integer; const aStyle: TtsFontStyles; + const aAntiAliasing: TtsAntiAliasing); +begin + inherited Create; + fRenderer := aRenderer; + fCreator := aCreator; + fDefaultChar := '?'; + fCopyright := aCopyright; + fFaceName := aFaceName; + fStyleName := aStyleName; + fFullName := aFullName; + fSize := aSize; + fStyle := aStyle; + fAntiAliasing := aAntiAliasing; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TtsFont.Destroy; +begin + ClearChars; + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TtsPostProcessStep//////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsPostProcessStep.ClearList(const aList: TList); +var + i: Integer; + p: PtsPostProcessStepRange; +begin + for i := 0 to aList.Count-1 do begin + p := aList[i]; + Dispose(p); + end; + aList.Clear; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsPostProcessStep.IsInRange(const aCharCode: WideChar): Boolean; +var + i: Integer; + p: PtsPostProcessStepRange; +begin + result := (fIncludeCharRange.Count = 0); + + if not result then for i := 0 to fIncludeCharRange.Count-1 do begin + p := fIncludeCharRange[i]; + if (aCharCode >= p^.StartChar) and (aCharCode <= p^.EndChar) then begin + result := true; + break; + end; + end; + + if result then for i := 0 to fExcludeCharRange.Count-1 do begin + p := fExcludeCharRange[i]; + if (aCharCode >= p^.StartChar) and (aCharCode <= p^.EndChar) then begin + result := false; + break; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsPostProcessStep.AddUsageRange(const aUsage: TtsFontProcessStepUsage; const aStartChar, aEndChar: WideChar); +var + p: PtsPostProcessStepRange; +begin + New(p); + + p^.StartChar := aStartChar; + p^.EndChar := aEndChar; + + case aUsage of + tsUsageInclude: + fIncludeCharRange.Add(p); + tsUsageExclude: + fExcludeCharRange.Add(p); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsPostProcessStep.AddUsageChars(const aUsage: TtsFontProcessStepUsage; aChars: PWideChar); +begin + if Assigned(aChars) then + while (aChars^ <> #0) do begin + AddUsageRange(aUsage, aChars^, aChars^); + inc(aChars); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsPostProcessStep.ClearIncludeRange; +begin + ClearList(fIncludeCharRange); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsPostProcessStep.ClearExcludeRange; +begin + ClearList(fExcludeCharRange); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TtsPostProcessStep.Create; +begin + inherited Create; + fIncludeCharRange := TList.Create; + fExcludeCharRange := TList.Create; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TtsPostProcessStep.Destroy; +begin + ClearList(fIncludeCharRange); + ClearList(fExcludeCharRange); + FreeAndNil(fIncludeCharRange); + FreeAndNil(fExcludeCharRange); + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TtsFontCreator////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsFontCreator.GetPostProcessStepCount: Integer; +begin + result := fPostProcessSteps.Count; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsFontCreator.GetPostProcessStep(const aIndex: Integer): TtsPostProcessStep; +begin + if (aIndex >= 0) and (aIndex < fPostProcessSteps.Count) then + Result := TtsPostProcessStep(fPostProcessSteps[aIndex]) + else + raise EtsOutOfRange.Create(0, fPostProcessSteps.Count-1, aIndex); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsFontCreator.DrawLine(const aChar: TtsChar; const aCharImage: TtsImage; aLinePosition, aLineSize: Integer); +var + NewSize, NewPos: TtsPosition; + YOffset, y: Integer; + + procedure FillLine(aData: PByte); + var + w, i: Integer; + c: TtsColor4f; + tmp: PByte; + begin + w := NewSize.x; + while (w > 0) do begin + tmp := aData; + tsFormatUnmap(aCharImage.Format, tmp, c); + for i := 0 to 3 do + c.arr[i] := 1.0; + tsFormatMap(aCharImage.Format, aData, c); + dec(w); + end; + end; + +begin + if aLineSize <= 0 then + exit; + + aLinePosition := aLinePosition - aLineSize; + + // calculate width and height + NewPos.x := 0; + NewPos.y := 0; + NewSize.x := aCharImage.Width; + NewSize.y := aCharImage.Height; + + // expand image to the full advance + if aChar.Advance > aCharImage.Width then + NewSize.x := aChar.Advance; + + // 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; + 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); + + // 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; + end; + + // resize + aCharImage.Resize(NewSize.x, NewSize.y, NewPos.x, NewPos.y); + + // draw lines + YOffset := (aChar.GlyphOrigin.y + NewPos.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.Right + NewPos.x, + aChar.GlyphRect.Top + NewPos.y, + aChar.GlyphRect.Bottom + NewPos.y); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsFontCreator.DoPostProcess(const aChar: TtsChar; const aCharImage: TtsImage); +var + i: Integer; + step: TtsPostProcessStep; +begin + if not aCharImage.IsEmpty then begin + for i := 0 to fPostProcessSteps.Count-1 do begin + step := TtsPostProcessStep(fPostProcessSteps[i]); + if step.IsInRange(aChar.CharCode) then + step.Execute(aChar, aCharImage); + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsFontCreator.GenerateChar(const aCharCode: WideChar; const aFont: TtsFont; const aRenderer: TtsRenderer): TtsChar; +var + GlyphOrigin, GlyphSize: TtsPosition; + Advance: Integer; + CharImage: TtsImage; + Char: TtsChar; +begin + result := nil; + if (Ord(aCharCode) = 0) or + not GetGlyphMetrics(aCharCode, GlyphOrigin.x, GlyphOrigin.y, GlyphSize.x, GlyphSize.y, 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 begin + GetCharImage(aCharCode, CharImage); + end else if ([tsStyleUnderline, tsStyleStrikeout] * aFont.Style <> []) then begin + CharImage.CreateEmpty(aRenderer.Format, Advance, 1); + GlyphOrigin.y := 1; + end; + end; + + Char := TtsChar.Create(aCharCode); + Char.GlyphOrigin := GlyphOrigin; + Char.GlyphRect := tsRect(0, 0, CharImage.Width, CharImage.Height); + Char.Advance := Advance; + + if (aRenderer.SaveImages) then begin + try + if (tsStyleUnderline in aFont.Style) then + DrawLine(Char, CharImage, aFont.UnderlinePos, aFont.UnderlineSize); + if (tsStyleUnderline in aFont.Style) then + DrawLine(Char, CharImage, aFont.StrikeoutPos, aFont.StrikeoutSize); + except + CharImage.FillColor(tsColor4f(1, 0, 0, 0), COLOR_CHANNELS_RGB, IMAGE_MODES_NORMAL); + end; + + DoPostProcess(Char, CharImage); + + if AddResizingBorder then begin + Char.HasResisingBorder := true; + Char.GlyphRect := tsRect( + Char.GlyphRect.Left + 1, + Char.GlyphRect.Top + 1, + Char.GlyphRect.Right + 1, + Char.GlyphRect.Bottom + 1); + CharImage.AddResizingBorder; + end; + + Char.RenderRef := aRenderer.AddRenderRef(Char, CharImage); + end; + finally + FreeAndNil(CharImage); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsFontCreator.AddPostProcessStep(const aStep: TtsPostProcessStep): TtsPostProcessStep; +begin + result := aStep; + fPostProcessSteps.Add(aStep); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsFontCreator.InsertPostProcessStep(const aIndex: Integer; const aStep: TtsPostProcessStep): TtsPostProcessStep; +begin + result := aStep; + fPostProcessSteps.Insert(aIndex, aStep); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsFontCreator.DeletePostProcessStep(const aIndex: Integer); +begin + if (aIndex >= 0) and (aIndex < fPostProcessSteps.Count) then + fPostProcessSteps.Delete(aIndex) + else + raise EtsOutOfRange.Create(0, fPostProcessSteps.Count-1, aIndex); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsFontCreator.ClearPostProcessSteps; +begin + fPostProcessSteps.Clear; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TtsFontCreator.Create; +begin + inherited Create; + fPostProcessSteps := TObjectList.Create(true); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TtsFontCreator.Destroy; +begin + ClearPostProcessSteps; + FreeAndNil(fPostProcessSteps); + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TtsTextBlock////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsTextBlock.GetRect: TtsRect; +begin + result.Left := fLeft; + result.Top := fTop; + result.Right := fLeft + fWidth; + result.Bottom := fTop + fHeight; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsTextBlock.PushLineItem(const aItem: PtsLineItem; const aUpdateLineWidth: Boolean); +begin + if not Assigned(fLastLine) then + PushNewLine; + + if Assigned(fLastLine^.Last) then begin + aItem^.Prev := fLastLine^.Last; + aItem^.Next := nil; + fLastLine^.Last^.Next := aItem; + fLastLine^.Last := aItem; + end; + + if not Assigned(fLastLine^.First) then begin + fLastLine^.First := aItem; + fLastLine^.Last := aItem; + end; + + case aItem^.ItemType of + tsItemTypeSpace, tsItemTypeText: + fLastLine^.Width := fLastLine^.Width + aItem^.TextWidth; + tsItemTypeSpacing: + fLastLine^.Width := fLastLine^.Width + aItem^.Spacing; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsTextBlock.PushSpacing(const aWidth: Integer); +var + p: PtsLineItem; +begin + new(p); + FillByte(p^, SizeOf(p^), 0); + p^.ItemType := tsItemTypeSpacing; + p^.Spacing := aWidth; + PushLineItem(p); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsTextBlock.FreeLineItems(var aItem: PtsLineItem); +var + p: PtsLineItem; +begin + while Assigned(aItem) do begin + p := aItem; + case p^.ItemType of + tsItemTypeText, tsItemTypeSpace: + tsStrDispose(p^.Text); + end; + aItem := p^.Next; + Dispose(p); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsTextBlock.FreeLines(var aItem: PtsBlockLine); +var + p: PtsBlockLine; +begin + while Assigned(aItem) do begin + p := aItem; + FreeLineItems(p^.First); + p^.Last := p^.First; + aItem := p^.Next; + Dispose(p); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsTextBlock.SplitText(aText: PWideChar): PtsLineItem; +var + TextBegin: PWideChar; + TextLength: Integer; + State: TtsLineItemType; + LastItem: PtsLineItem; + c: WideChar; + + procedure AddItem(const aItem: PtsLineItem); + begin + if Assigned(result) then begin + LastItem^.Next := aItem; + aItem^.Prev := LastItem; + aItem^.Next := nil; + LastItem := aItem; + end; + + if not Assigned(result) then begin + result := aItem; + LastItem := aItem; + end; + end; + + procedure ExtractWord; + var + p: PtsLineItem; + Text: PWideChar; + begin + if (State = tsItemTypeUnknown) then + exit; + + new(p); + FillByte(p^, SizeOf(p^), 0); + p^.ItemType := State; + + case State of + tsItemTypeText, tsItemTypeSpace: begin + p^.Text := tsStrAlloc(TextLength); + TextLength := 0; + Text := p^.Text; + while (TextBegin <> aText) do begin + Text^ := TextBegin^; + inc(Text, 1); + inc(TextBegin, 1); + end; + AddItem(p); + end; + + tsItemTypeLineBreak: begin + if ((c = #13) and (aText^ = #10)) or not (aText^ in [#10, #13]) then begin + Dispose(p); + p := nil; + end else begin + AddItem(p); + end; + TextBegin := aText; + end; + + tsItemTypeTab: begin + AddItem(p); + end; + + else + Dispose(p); + p := nil; + end; + end; + +begin + result := nil; + LastItem := nil; + TextBegin := aText; + TextLength := 0; + State := tsItemTypeUnknown; + + if not Assigned(aText) then + exit; + + while (aText^ <> #0) do begin + case aText^ of + + // tabulator + #$0009: begin + ExtractWord; + inc(TextBegin, 1); + State := tsItemTypeTab; + end; + + // line breaks + #$000D, #$000A: begin + if (State <> tsItemTypeLineBreak) then begin + ExtractWord; + State := tsItemTypeLineBreak; + c := #0; + end; + ExtractWord; + c := aText^; + end; + + // spaces + #$0020: begin + if (State <> tsItemTypeSpace) then + ExtractWord; + State := tsItemTypeSpace; + end; + + else + if (State <> tsItemTypeText) then + ExtractWord; + State := tsItemTypeText; + end; + + inc(aText, 1); + inc(TextLength, 1); + end; + + if (TextBegin <> aText) then + ExtractWord; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsTextBlock.SplitIntoLines(aItem: PtsLineItem); +var + p: PtsLineItem; +begin + if not Assigned(fCurrentFont) then + exit; + + while Assigned(aItem) do begin + p := aItem; + aItem := aItem^.Next; + p^.Next := nil; + p^.Prev := nil; + + if not Assigned(fLastLine) then + PushNewLine; + + case p^.ItemType of + tsItemTypeText, tsItemTypeSpace: begin + // increment word counter + if (p^.ItemType = tsItemTypeSpace) then begin + if not (tsLastItemIsSpace in fLastLine^.Flags) then + inc(fLastLine^.SpaceCount, 1); + Include(fLastLine^.Flags, tsLastItemIsSpace); + end else + Exclude(fLastLine^.Flags, tsLastItemIsSpace); + + // update and check line width + p^.TextWidth := fCurrentFont.GetTextWidthW(p^.Text); + if (tsBlockFlagWordWrap in fFlags) and + (fLastLine^.Width + p^.TextWidth > fWidth) then + begin + fLastLine^.AutoBreak := true; + if (fLastLine^.Width = 0) then begin + PushLineItem(p, false); // if is first word, than add anyway + p := nil; + end; + PushNewLine; + end; + + // add item + if Assigned(p) then begin + PushLineItem(p); + PushSpacing(fCurrentFont.CharSpacing); + end; + end; + + tsItemTypeLineBreak: begin + PushLineItem(p); + PushNewLine; + end; + + tsItemTypeTab: begin + PushLineItem(p); + end; + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsTextBlock.TrimSpaces(const aLine: PtsBlockLine); + + procedure Trim(p: PtsLineItem; const aMoveNext: Boolean); + var + tmp: PtsLineItem; + begin + while Assigned(p) do begin + tmp := p; + if aMoveNext then + p := p^.Next + else + p := p^.Prev; + + case tmp^.ItemType of + tsItemTypeText: begin //done + break; + end; + + tsItemTypeSpace, + tsItemTypeSpacing: begin + // delete item from list + if Assigned(tmp^.Prev) then + tmp^.Prev^.Next := tmp^.Next; + if Assigned(tmp^.Next) then + tmp^.Next^.Prev := tmp^.Prev; + + // update line width + if (tmp^.ItemType = tsItemTypeSpace) then begin + aLine^.Width := aLine^.Width - tmp^.TextWidth; + dec(aLine^.SpaceCount, 1); + end else + aLine^.Width := aLine^.Width - tmp^.Spacing; + + Dispose(tmp); + end; + end; + end; + end; + +begin + if not Assigned(aLine) then + exit; + Trim(aLine^.First, true); + Trim(aLine^.Last, false); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsTextBlock.PushNewLine; +var + p: PtsBlockLine; +begin + TrimSpaces(fLastLine); + + new(p); + FillByte(p^, SizeOf(p^), 0); + + if Assigned(fLastLine) then begin + fLastLine^.Next := p; + fLastLine := p; + end; + + if not Assigned(fFirstLine) then begin + fFirstLine := p; + fLastLine := p; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TtsTextBlock.Create(const aRenderer: TtsRenderer; const aTop, aLeft, aWidth, aHeight: Integer; const aFlags: TtsBlockFlags); +begin + inherited Create; + + fRenderer := aRenderer; + fTop := aTop; + fLeft := aLeft; + fWidth := aWidth; + fHeight := aHeight; + fFlags := aFlags; + fVertAlign := tsVertAlignTop; + fHorzAlign := tsHorzAlignLeft; + + PushNewLine; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsTextBlock.ChangeFont(const aFont: TtsFont); +var + p: PtsLineItem; +begin + if not Assigned(aFont) then + exit; + + New(p); + FillByte(p^, SizeOf(p^), 0); + p^.ItemType := tsItemTypeFont; + p^.Font := aFont; + PushLineItem(p); + + fCurrentFont := aFont; + if Assigned(fCurrentFont) then begin + fCurrentFont.GetTextMetric(fTextMetric); + if Assigned(fLastLine) then begin + fLastLine^.Height := max( + fLastLine^.Height, + fTextMetric.LineHeight); + fLastLine^.Spacing := max( + fLastLine^.Spacing, + fTextMetric.LineSpacing); + fLastLine^.Ascent := max( + fLastLine^.Ascent, + fTextMetric.Ascent); + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsTextBlock.ChangeColor(const aColor: TtsColor4f); +var + p: PtsLineItem; +begin + New(p); + FillByte(p^, SizeOf(p^), 0); + p^.ItemType := tsItemTypeColor; + p^.Color := aColor; + PushLineItem(p); + + fCurrentColor := aColor; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsTextBlock.GetActualBlockHeight: Integer; +var + line: PtsBlockLine; +begin + result := 0; + line := fFirstLine; + while Assigned(line) do begin + result := result + line^.Height; + line := line^.Next; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsTextBlock.TextOutA(const aText: PAnsiChar); +var + tmp: PWideChar; +begin + tmp := Renderer.Context.AnsiToWide(aText); + try + TextOutW(tmp); + finally + tsStrDispose(tmp); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsTextBlock.TextOutW(const aText: PWideChar); +var + p: PtsLineItem; +begin + p := SplitText(aText); + SplitIntoLines(p); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TtsTextBlock.Destroy; +begin + FreeLines(fFirstLine); + fLastLine := nil; + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TtsRenderer/////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsRenderer.BeginRender; +begin + fCritSec.Enter; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsRenderer.EndRender; +begin + fCritSec.Leave; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsRenderer.BeginBlock(const aTop, aLeft, aWidth, aHeight: Integer; const aFlags: TtsBlockFlags): TtsTextBlock; +begin + result := TtsTextBlock.Create(self, aTop, aLeft, aWidth, aHeight, aFlags); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TtsRenderer.EndBlock(var aBlock: TtsTextBlock); +var + c: PWideChar; + x, y: Integer; + ExtraWordSpaceTotal, ExtraWordSpaceCurrent: Single; + rect: TtsRect; + line: PtsBlockLine; + item: PtsLineItem; + font: TtsFont; + char: TtsChar; + metric: TtsTextMetric; + DrawText: Boolean; + + function GetChar(const aCharCode: WideChar): TtsChar; + begin + result := font.GetChar(aCharCode); + if not Assigned(result) then + result := font.GetChar(font.DefaultChar); + end; + + procedure DrawItem; + begin + case item^.ItemType of + tsItemTypeFont: begin + font := item^.Font; + font.GetTextMetric(metric); + end; + + tsItemTypeColor: begin + SetColor(item^.Color); + end; + + tsItemTypeText: begin + if DrawText and Assigned(font) then begin + c := item^.Text; + while (c^ <> #0) do begin + char := GetChar(c^); + if Assigned(char) then begin + MoveDrawPos(Char.GlyphOrigin.x, -metric.BaseLineOffset); + Render(char.RenderRef); + MoveDrawPos(char.Advance - char.GlyphOrigin.x + font.CharSpacing, metric.BaseLineOffset); + end; + inc(c); + end; + end; + end; + + tsItemTypeSpace: begin + if DrawText and Assigned(font) then begin + c := item^.Text; + while (c^ <> #0) do begin + char := GetChar(c^); + if Assigned(char) then begin + if (font.Style * [tsStyleUnderline, tsStyleStrikeout] <> []) then begin + + end else begin + + end; + end; + end; + end; + end; + + tsItemTypeLineBreak: begin + end; + + tsItemTypeTab: begin + end; + + tsItemTypeSpacing: begin + + end; + end; + end; + + procedure DrawLine; + begin + // check vertical clipping + case aBlock.Clipping of + tsClipCharBorder, tsClipWordBorder: + DrawText := (y + line^.Height > rect.Top) and (y < rect.Bottom); + tsClipCharComplete, tsClipWordComplete: + DrawText := (y > rect.Top) and (y + line^.Height < rect.Bottom); + end; + + // check horizontal alignment + x := rect.Left; + ExtraWordSpaceTotal := 0; + case aBlock.HorzAlign of + tsHorzAlignCenter: begin + x := rect.Left + (aBlock.Width div 2) - (line^.Width div 2); + end; + + tsHorzAlignRight: begin + x := rect.Right - line^.Width; + end; + + tsHorzAlignJustify: begin + ExtraWordSpaceTotal := (aBlock.Width - line^.Width) / line^.SpaceCount; + ExtraWordSpaceCurrent := ExtraWordSpaceTotal; + end; + end; + + if DrawText then + SetDrawPos(x, y + line^.Ascent); + item := line^.First; + while Assigned(item) do begin + DrawItem; + item := item^.Next; + end; + end; + +begin + BeginRender; + try + // init variables + y := aBlock.Top; + font := nil; + line := aBlock.Lines; + rect := aBlock.Rect; + + // check vertical alignment + case aBlock.VertAlign of + tsVertAlignCenter: + y := y + (aBlock.Height div 2 - aBlock.GetActualBlockHeight div 2); + tsVertAlignBottom: + y := y + (aBlock.Height - aBlock.GetActualBlockHeight); + end; + + while Assigned(line) do begin + DrawLine; + line := line^.Next; + end; + finally + EndRender; + FreeAndNil(aBlock); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TtsRenderer.Create(const aContext: TtsContext; const aFormat: TtsFormat); +begin + inherited Create; + fContext := aContext; + fFormat := aFormat; + fCritSec := TCriticalSection.Create; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TtsRenderer.Destroy; +begin + FreeAndNil(fCritSec); + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TtsContext//////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TtsContext.AnsiToWide(const aText: PAnsiChar): PWideChar; +var + len: Integer; +begin + result := nil; + + if not Assigned(aText) then + exit; + len := Length(aText); + + // UTF-8 + if (fCodePage = tsUTF8) then begin + result := tsStrAlloc(len); + tsUTF8ToWide(result, len, aText, fCodePageDefault); + + // ISO 8859-1 + end else if (fCodePage = tsISO_8859_1) then begin + result := tsStrAlloc(len); + tsISO_8859_1ToWide(result, len, aText); + + // single or double byte CodePage + end else if Assigned(fCodePageFunc) and Assigned(fCodePagePtr) then begin + result := tsStrAlloc(len); + fCodePageFunc(result, len, aText, fCodePage, fCodePageDefault); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TtsContext.Create; +begin + inherited Create; + + fID := InterLockedIncrement(gLastContextID); + + fCodePage := tsUTF8; + fCodePageFunc := nil; + fCodePagePtr := nil; + fCodePageDefault := WideChar('?'); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TtsContext.Destroy; +begin + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//Exceptions//////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor EtsOutOfRange.Create(const aMin, aMax, aIndex: Integer); +begin + inherited Create(Format('index (%d) is out of range (%d - %d)', [aIndex, aMin, aMax])); +end; + +initialization + Randomize; + +end. + diff --git a/old/TextSuite.pas b/old/TextSuite.pas new file mode 100644 index 0000000..af944a5 --- /dev/null +++ b/old/TextSuite.pas @@ -0,0 +1,3650 @@ +{ +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 new file mode 100644 index 0000000..ef0157b --- /dev/null +++ b/old/TextSuiteCPUUtils.pas @@ -0,0 +1,143 @@ +{ +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 new file mode 100644 index 0000000..1466cda --- /dev/null +++ b/old/TextSuiteClasses.pas @@ -0,0 +1,5762 @@ +{ +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 new file mode 100644 index 0000000..f071897 --- /dev/null +++ b/old/TextSuiteImports.pas @@ -0,0 +1,867 @@ +{ +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 new file mode 100644 index 0000000..fe761ca --- /dev/null +++ b/old/TextSuiteOptions.inc @@ -0,0 +1,46 @@ + +{ *** 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 new file mode 100644 index 0000000..2486265 --- /dev/null +++ b/old/TextSuitePostProcess.pas @@ -0,0 +1,398 @@ +{ +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 new file mode 100644 index 0000000..a7253b0 --- /dev/null +++ b/old/TextSuiteTTFUtils.pas @@ -0,0 +1,367 @@ +{ +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 new file mode 100644 index 0000000..a27d1b5 --- /dev/null +++ b/old/TextSuiteVersion.pas @@ -0,0 +1,13 @@ +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 new file mode 100644 index 0000000..af51fdc --- /dev/null +++ b/old/TextSuiteWideUtils.pas @@ -0,0 +1,1394 @@ +{ +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/ttf/calibri.ttf b/ttf/calibri.ttf new file mode 100644 index 0000000..ee4771c Binary files /dev/null and b/ttf/calibri.ttf differ diff --git a/ttf/calibrib.ttf b/ttf/calibrib.ttf new file mode 100644 index 0000000..6d2e6ce Binary files /dev/null and b/ttf/calibrib.ttf differ diff --git a/ttf/calibrii.ttf b/ttf/calibrii.ttf new file mode 100644 index 0000000..f24016a Binary files /dev/null and b/ttf/calibrii.ttf differ diff --git a/ttf/calibril.ttf b/ttf/calibril.ttf new file mode 100644 index 0000000..c8898ab Binary files /dev/null and b/ttf/calibril.ttf differ diff --git a/ttf/calibrili.ttf b/ttf/calibrili.ttf new file mode 100644 index 0000000..25f4c51 Binary files /dev/null and b/ttf/calibrili.ttf differ diff --git a/ttf/calibriz.ttf b/ttf/calibriz.ttf new file mode 100644 index 0000000..913d2cc Binary files /dev/null and b/ttf/calibriz.ttf differ diff --git a/uMainForm.lfm b/uMainForm.lfm new file mode 100644 index 0000000..99b682a --- /dev/null +++ b/uMainForm.lfm @@ -0,0 +1,14 @@ +object MainForm: TMainForm + Left = 536 + Height = 508 + Top = 255 + Width = 682 + OnCreate = FormCreate + OnPaint = FormPaint + LCLVersion = '1.3' + object ApplicationProperties: TApplicationProperties + OnIdle = ApplicationPropertiesIdle + left = 56 + top = 24 + end +end diff --git a/uMainForm.pas b/uMainForm.pas new file mode 100644 index 0000000..d38129d --- /dev/null +++ b/uMainForm.pas @@ -0,0 +1,112 @@ +unit uMainForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, uglcContext, TextSuite, uglcTypes, utsTextSuite; + +type + TMainForm = class(TForm) + ApplicationProperties: TApplicationProperties; + procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean); + procedure FormCreate(Sender: TObject); + procedure FormPaint(Sender: TObject); + private + fContext: TglcContext; + fTextSuiteContext: tsContextID; + fFontID: tsFontID; + + ftsContext: TtsContext; + ftsRenderer: TtsRenderer; + ftsCreator: TtsFontCreator; + ftsFont: TtsFont; + + 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; +begin + pf := TglcContext.MakePF(); + fContext := TglcContext.GetPlatformClass.Create(self, pf); + fContext.BuildContext; + + tsInit(TS_INIT_TEXTSUITE or TS_INIT_OPENGL or TS_INIT_GDI); + tsContextCreate(@fTextSuiteContext); + tsSetParameteri(TS_RENDERER, TS_RENDERER_OPENGL); + tsSetParameteri(TS_CREATOR, TS_CREATOR_GDI); + tsContextBind(fTextSuiteContext); + tsFontCreateCreatorA('ttf/calibri.ttf', 24, 0, TS_ANTIALIASING_NORMAL, TS_DEFAULT, @fFontID); + tsFontBind(fFontID); + + ftsContext := TtsContext.Create; + ftsRenderer := TtsRenderer.Create(ftsContext, tsFormatRGBA8); + ftsCreator := TtsFontCreator.Create; + ftsFont := TtsFont.Create(ftsRenderer, ftsCreator, '', '', '', '', 12, 0, 0, [], tsAANormal); +end; + +procedure TMainForm.FormPaint(Sender: TObject); +begin + Render; +end; + +procedure TMainForm.Render; +var + block: TtsTextBlock; +begin + 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; + + glDisable(GL_CULL_FACE); + glDisable(GL_DEPTH_TEST); + glEnable(GL_BLEND); + + glcBlendFunc(TglcBlendMode.bmAdditiveAlphaBlend); + //tsTextBeginBlock(10, 10, ClientWidth-10, ClientHeight-10, TS_ALIGN_BLOCK); + //tsTextOutA(TEST_STRING); + //tsTextEndBlock; + + block := ftsRenderer.BeginBlock(10, 10, ClientWidth-10, ClientHeight-10, [tsBlockFlagWordWrap]); + try + block.ChangeFont(ftsFont); + block.TextOutW('test'#13#10#13#10'test'#13#13'test'#10#10'test'#13#10#10'test'#13#13#10); + finally + ftsRenderer.EndBlock(block); + end; + + fContext.SwapBuffers; +end; + +procedure TMainForm.ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean); +begin + Render; + Done := false; +end; + +end. +