diff --git a/TextSuiteTest.lpi b/TextSuiteTest.lpi
index 61be276..7d190ab 100644
--- a/TextSuiteTest.lpi
+++ b/TextSuiteTest.lpi
@@ -33,7 +33,7 @@
-
+
@@ -59,6 +59,7 @@
+
@@ -77,11 +78,34 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -92,10 +116,13 @@
-
+
+
+
+
diff --git a/TextSuiteTest.lpr b/TextSuiteTest.lpr
index 38f7386..79eb67f 100644
--- a/TextSuiteTest.lpr
+++ b/TextSuiteTest.lpr
@@ -7,8 +7,9 @@ uses
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
- Forms, uMainForm, TextSuite, TextSuiteClasses, TextSuiteImports, TextSuitePostProcess,
- TextSuiteTTFUtils, TextSuiteVersion, TextSuiteWideUtils, utsTextSuite;
+ Forms, uMainForm, TextSuite, TextSuiteClasses, TextSuiteImports, TextSuitePostProcess, TextSuiteTTFUtils,
+ TextSuiteVersion, TextSuiteWideUtils, utsTextSuite, utsFontCreatorGDI, utsTtfUtils, utsTypes, utsUtils,
+utsRendererOpenGL;
{$R *.res}
diff --git a/TextSuiteTest.lps b/TextSuiteTest.lps
index 9d2195b..1b5e38b 100644
--- a/TextSuiteTest.lps
+++ b/TextSuiteTest.lps
@@ -4,13 +4,13 @@
-
+
-
+
@@ -19,9 +19,9 @@
-
-
-
+
+
+
@@ -29,58 +29,59 @@
-
-
-
-
+
+
+
-
+
-
-
+
+
-
+
-
-
-
-
+
+
+
+
+
+
+
-
+
-
+
-
-
-
-
+
+
+
@@ -90,16 +91,18 @@
-
+
-
-
-
-
-
+
+
+
+
+
+
+
@@ -108,243 +111,386 @@
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
+
-
+
-
+
-
-
-
diff --git a/new/utsFontCreatorGDI.pas b/new/utsFontCreatorGDI.pas
new file mode 100644
index 0000000..b82c9c9
--- /dev/null
+++ b/new/utsFontCreatorGDI.pas
@@ -0,0 +1,918 @@
+unit utsFontCreatorGDI;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, syncobjs, dynlibs,
+ utsTextSuite, utsTypes;
+
+type
+ HDC = Cardinal;
+
+ TFixed = packed record
+ fract: Word;
+ value: Smallint;
+ end;
+
+ TMat2 = packed record
+ eM11: TFixed;
+ eM12: TFixed;
+ eM21: TFixed;
+ eM22: TFixed;
+ end;
+ PMat2 = ^TMat2;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TtsFontGDI = class(TtsFont)
+ private
+ fHandle: THandle;
+ fMat2: TMat2;
+ protected
+ constructor Create(const aRenderer: TtsRenderer; const aCreator: TtsFontGenerator; const aProperties: TtsFontProperties; const aHandle: THandle);
+ public
+ destructor Destroy; override;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TtsFontRegistration = class(TObject)
+ protected
+ fIsRegistered: Boolean;
+ fFontname: String;
+ procedure UnregisterFont; virtual; abstract;
+ public
+ property IsRegistered: Boolean read fIsRegistered;
+ property Fontname: String read fFontname;
+
+ destructor Destroy; override;
+ end;
+
+ TtsFontRegistrationFile = class(TtsFontRegistration)
+ private
+ fFilename: String;
+ protected
+ procedure UnregisterFont; override;
+ public
+ constructor Create(const aFilename: String);
+ end;
+
+ TtsFontRegistrationStream = class(TtsFontRegistration)
+ private
+ fHandle: THandle;
+ protected
+ procedure UnregisterFont; override;
+ public
+ constructor Create(const aStream: TStream);
+ end;
+
+ TtsRegistredFontGDI = class(TtsFontGDI)
+ private
+ fRegistration: TtsFontRegistration;
+ public
+ constructor Create(const aRenderer: TtsRenderer; const aCreator: TtsFontGenerator;
+ const aRegistration: TtsFontRegistration; const aProperties: TtsFontProperties; const aHandle: THandle);
+ destructor Destroy; override;
+ end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ TtsFontGeneratorGDI = class(TtsFontGenerator)
+ private
+ function ConvertFont(const aFont: TtsFont): TtsFontGDI;
+ function GetGlyphIndex(const aFont: TtsFontGDI; const aCharCode: WideChar): Integer;
+ procedure GetCharImageAANone(const aDC: HDC; const aFont: TtsFontGDI; const aCharCode: WideChar; const aImage: TtsImage);
+ procedure GetCharImageAANormal(const aDC: HDC; const aFont: TtsFontGDI; const aCharCode: WideChar; const aImage: TtsImage);
+
+ function CreateFont(const aFontname: String; const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing; out aProperties: TtsFontProperties): THandle;
+ protected
+ function GetGlyphMetrics(const aFont: TtsFont; const aCharCode: WideChar; out aGlyphOrigin, aGlyphSize: TtsPosition; out aAdvance: Integer): Boolean; override;
+ procedure GetCharImage(const aFont: TtsFont; const aCharCode: WideChar; const aCharImage: TtsImage); override;
+ public
+ function GetFontByName(const aFontname: String; const aRenderer: TtsRenderer; const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont; overload;
+ function GetFontByFile(const aFilename: String; const aRenderer: TtsRenderer; const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont; overload;
+ function GetFontByStream(const aStream: TStream; const aRenderer: TtsRenderer; const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont; overload;
+
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
+implementation
+
+uses
+ math, utsTtfUtils;
+
+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;
+
+type
+ HFONT = Cardinal;
+ HGDIOBJ = Cardinal;
+
+ 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: TtsPosition;
+ 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: TtsRect;
+ otmMacAscent: Integer;
+ otmMacDescent: Integer;
+ otmMacLineGap: LongWord;
+ otmusMinimumPPEM: LongWord;
+ otmptSubscriptSize: TtsPosition;
+ otmptSubscriptOffset: TtsPosition;
+ otmptSuperscriptSize: TtsPosition;
+ otmptSuperscriptOffset: TtsPosition;
+ otmsStrikeoutSize: LongWord;
+ otmsStrikeoutPosition: Integer;
+ otmsUnderscoreSize: Integer;
+ otmsUnderscorePosition: Integer;
+ otmpFamilyName: PWideChar;
+ otmpFaceName: PWideChar;
+ otmpStyleName: PWideChar;
+ otmpFullName: PWideChar;
+ end;
+ POutlineTextmetricW = ^TOutlineTextmetricW;
+
+ TCreateFontIndirectA = function (const p1: TLogFontA): HFONT; stdcall;
+
+ TAddFontResourceA = function(Filename: PAnsiChar): Integer; stdcall;
+ TAddFontResourceExA = function(Filename: PAnsiChar; Flag: DWORD; pdv: Pointer): Integer; stdcall;
+ TAddFontMemResourceEx = function(pbFont: Pointer; cbFont: DWORD; pdv: Pointer; pcFonts: PDWORD): THandle; stdcall;
+ TRemoveFontResourceA = function(Filename: PAnsiChar): Boolean; stdcall;
+ TRemoveFontResourceExA = function(filename: PAnsiChar; Flag: DWORD; pdv: Pointer): Boolean; stdcall;
+ TRemoveFontMemResourceEx = function(fh: THandle): Boolean; stdcall;
+
+ TGetTextMetricsW = function(DC: HDC; var TM: TTextMetricW): Boolean; stdcall;
+ TGetGlyphOutlineA = function(DC: HDC; uChar, uFormat: Cardinal; lpgm: PGlyphMetrics; cbBuffer: DWORD; lpvBuffer: Pointer; lpmat2: PMat2): DWORD; stdcall;
+
+ TGetCharacterPlacementW = function(DC: HDC; Str: PWideChar; Count, MaxExtent: Integer; Result: PGCPResultsW; Flags: DWORD): DWORD; stdcall;
+ TGetFontData = function(DC: HDC; TableName, Offset: DWORD; Buffer: Pointer; Data: DWORD): DWORD; stdcall;
+
+ TCreateCompatibleDC = function(DC: HDC): HDC; stdcall;
+ TDeleteDC = function(DC: HDC): Boolean; stdcall;
+ TSelectObject = function(DC: HDC; p2: HGDIOBJ): HGDIOBJ; stdcall;
+ TDeleteObject = function(p1: HGDIOBJ): Boolean; stdcall;
+
+ TGetOutlineTextMetricsW = function(DC: HDC; p2: LongWord; var OTMetricStructs: TOutlineTextmetricW): LongWord; stdcall;
+
+ TGetLocaleInfoA = function(Locale: DWORD; LCType: DWORD; lpLCData: pAnsiChar; cchData: Integer): Integer; stdcall;
+
+var
+ gdiRefCount: Integer;
+ gdiCritSec: TCriticalSection;
+ gdiInitialized: Boolean;
+ gdiLibHandle: TLibHandle = 0;
+ kernel32LibHandle: TLibHandle = 0;
+
+ CreateFontIndirectA: TCreateFontIndirectA;
+ AddFontResourceA: TAddFontResourceA;
+ AddFontResourceExA: TAddFontResourceExA;
+ AddFontMemResourceEx: TAddFontMemResourceEx;
+ RemoveFontResourceA: TRemoveFontResourceA;
+ RemoveFontResourceExA: TRemoveFontResourceExA;
+ RemoveFontMemResourceEx: TRemoveFontMemResourceEx;
+ GetTextMetricsW: TGetTextMetricsW;
+ GetGlyphOutlineA: TGetGlyphOutlineA;
+ GetCharacterPlacementW: TGetCharacterPlacementW;
+ GetFontData: TGetFontData;
+ CreateCompatibleDC: TCreateCompatibleDC;
+ DeleteDC: TDeleteDC;
+ SelectObject: TSelectObject;
+ DeleteObject: TDeleteObject;
+ GetOutlineTextMetricsW: TGetOutlineTextMetricsW;
+
+ GetLocaleInfoA: TGetLocaleInfoA;
+
+procedure InitGDI;
+
+ function GetProcAddr(const aLibHandle: TLibHandle; const aName: String): Pointer;
+ begin
+ result := GetProcAddress(aLibHandle, aName);
+ if not Assigned(result) then
+ raise EtsException.Create('unable to load procedure from library: ' + aName);
+ end;
+
+begin
+ try
+ if (gdiLibHandle = 0) then begin
+ gdiLibHandle := LoadLibrary(LIB_GDI32);
+ if (gdiLibHandle = 0) then
+ raise EtsException.Create('unable to load gdi lib: ' + LIB_GDI32);
+ end;
+
+ if (kernel32LibHandle = 0) then begin
+ kernel32LibHandle := LoadLibrary(LIB_KERNEL32);
+ if (kernel32LibHandle = 0) then
+ raise EtsException.Create('unable to load kernel lib: ' + LIB_KERNEL32);
+ end;
+
+ CreateFontIndirectA := TCreateFontIndirectA( GetProcAddr(gdiLibHandle, 'CreateFontIndirectA'));
+ AddFontResourceA := TAddFontResourceA( GetProcAddr(gdiLibHandle, 'AddFontResourceA'));
+ AddFontResourceExA := TAddFontResourceExA( GetProcAddr(gdiLibHandle, 'AddFontResourceExA'));
+ AddFontMemResourceEx := TAddFontMemResourceEx( GetProcAddr(gdiLibHandle, 'AddFontMemResourceEx'));
+ RemoveFontResourceA := TRemoveFontResourceA( GetProcAddr(gdiLibHandle, 'RemoveFontResourceA'));
+ RemoveFontResourceExA := TRemoveFontResourceExA( GetProcAddr(gdiLibHandle, 'RemoveFontResourceExA'));
+ RemoveFontMemResourceEx := TRemoveFontMemResourceEx(GetProcAddr(gdiLibHandle, 'RemoveFontMemResourceEx'));
+ GetTextMetricsW := TGetTextMetricsW( GetProcAddr(gdiLibHandle, 'GetTextMetricsW'));
+ GetGlyphOutlineA := TGetGlyphOutlineA( GetProcAddr(gdiLibHandle, 'GetGlyphOutlineA'));
+ GetCharacterPlacementW := TGetCharacterPlacementW( GetProcAddr(gdiLibHandle, 'GetCharacterPlacementW'));
+ GetFontData := TGetFontData( GetProcAddr(gdiLibHandle, 'GetFontData'));
+ CreateCompatibleDC := TCreateCompatibleDC( GetProcAddr(gdiLibHandle, 'CreateCompatibleDC'));
+ DeleteDC := TDeleteDC( GetProcAddr(gdiLibHandle, 'DeleteDC'));
+ SelectObject := TSelectObject( GetProcAddr(gdiLibHandle, 'SelectObject'));
+ DeleteObject := TDeleteObject( GetProcAddr(gdiLibHandle, 'DeleteObject'));
+ GetOutlineTextMetricsW := TGetOutlineTextMetricsW( GetProcAddr(gdiLibHandle, 'GetOutlineTextMetricsW'));
+
+ GetLocaleInfoA := TGetLocaleInfoA(GetProcAddr(kernel32LibHandle, 'GetLocaleInfoA'));
+
+ gdiInitialized := true;
+ except
+ gdiInitialized := false;
+ FreeLibrary(gdiLibHandle);
+ FreeLibrary(kernel32LibHandle);
+ end;
+end;
+
+procedure QuitGDI;
+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;
+
+ GetLocaleInfoA := nil;
+
+ if (gdiLibHandle <> 0) then begin
+ FreeLibrary(gdiLibHandle);
+ gdiLibHandle := 0;
+ end;
+
+ if (kernel32LibHandle <> 0) then begin
+ FreeLibrary(kernel32LibHandle);
+ kernel32LibHandle := 0;
+ end;
+
+ gdiInitialized := false;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsFontGDI////////////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsFontGDI.Create(const aRenderer: TtsRenderer; const aCreator: TtsFontGenerator; const aProperties: TtsFontProperties; const aHandle: THandle);
+begin
+ inherited Create(aRenderer, aCreator, aProperties);
+ FillByte(fMat2, SizeOf(fMat2), 0);
+ fMat2.eM11.value := 1;
+ fMat2.eM22.value := 1;
+ fHandle := aHandle;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsFontGDI.Destroy;
+begin
+ DeleteObject(fHandle);
+ inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsFontRegistration///////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsFontRegistration.Destroy;
+begin
+ if fIsRegistered then
+ UnregisterFont;
+ inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsFontRegistrationFile///////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsFontRegistrationFile.UnregisterFont;
+begin
+ if Assigned(RemoveFontResourceExA) then
+ RemoveFontResourceExA(PAnsiChar(fFilename), 0, nil)
+ else if Assigned(RemoveFontResourceA) then
+ RemoveFontResourceA(PAnsiChar(fFilename));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsFontRegistrationFile.Create(const aFilename: String);
+var
+ lang: AnsiString;
+begin
+ inherited Create;
+ fFilename := aFilename;
+
+ // get Fontname
+ SetLength(lang, 4);
+ GetLocaleInfoA(LOCALE_USER_DEFAULT, LOCALE_ILANGUAGE, @lang[1], 4);
+ fFontname := GetTTFontFullNameFromFile(aFilename, StrToInt('$' + String(lang)));
+
+ // register font
+ if Assigned(AddFontResourceExA) then
+ fIsRegistered := (AddFontResourceExA(PAnsiChar(fFilename), 0, nil) > 0)
+ else if Assigned(AddFontResourceA) then
+ fIsRegistered := (AddFontResourceA(PAnsiChar(fFilename)) > 0)
+ else
+ fIsRegistered := false;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsFontRegistrationStream/////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsFontRegistrationStream.UnregisterFont;
+begin
+ if Assigned(RemoveFontMemResourceEx) then
+ RemoveFontMemResourceEx(fHandle);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsFontRegistrationStream.Create(const aStream: TStream);
+var
+ lang: AnsiString;
+ ms: TMemoryStream;
+ cnt: DWORD;
+begin
+ inherited Create;
+ fHandle := 0;
+ fIsRegistered := false;
+
+ // get Fontname
+ SetLength(Lang, 4);
+ GetLocaleInfoA(LOCALE_USER_DEFAULT, LOCALE_ILANGUAGE, @lang[1], 4);
+ fFontname := GetTTFontFullNameFromStream(aStream, StrToInt('$' + String(Lang)));
+
+ // register font
+ ms := TMemoryStream.Create;
+ try
+ ms.CopyFrom(aStream, 0);
+ if Assigned(AddFontMemResourceEx) then
+ fHandle := AddFontMemResourceEx(ms.Memory, ms.Size, nil, @cnt);
+ fIsRegistered := (fHandle > 0);
+ finally
+ FreeAndNil(ms);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsRegistredFontGDI///////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsRegistredFontGDI.Create(const aRenderer: TtsRenderer; const aCreator: TtsFontGenerator;
+ const aRegistration: TtsFontRegistration; const aProperties: TtsFontProperties; const aHandle: THandle);
+begin
+ inherited Create(aRenderer, aCreator, aProperties, aHandle);
+ fRegistration := aRegistration;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsRegistredFontGDI.Destroy;
+begin
+ FreeAndNil(fRegistration);
+ inherited Destroy;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsFontCreatorGDIFontFace/////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorGDI.ConvertFont(const aFont: TtsFont): TtsFontGDI;
+begin
+ if not (aFont is TtsFontGDI) then
+ raise EtsException.Create('aFont need to be a TtsFontGDI object');
+ result := (aFont as TtsFontGDI);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorGDI.GetGlyphIndex(const aFont: TtsFontGDI; const aCharCode: WideChar): Integer;
+var
+ DC: HDC;
+ GCPRes: TGCPResultsW;
+begin
+ result := -1;
+ DC := CreateCompatibleDC(0);
+ try
+ SelectObject(DC, aFont.fHandle);
+ if Assigned(GetCharacterPlacementW) then begin
+ FillByte(GCPRes, SizeOf(GCPRes), 0);
+ GetMem(GCPRes.lpGlyphs, SizeOf(Cardinal));
+ try
+ GCPRes.lStructSize := SizeOf(GCPRes);
+ GCPRes.lpGlyphs^ := 0;
+ GCPRes.nGlyphs := 1;
+ if (GetCharacterPlacementW(DC, @aCharCode, 1, GCP_MAXEXTENT, @GCPRes, 0) <> GDI_ERROR) and
+ (GCPRes.nGlyphs = 1) and
+ (GCPRes.lpGlyphs <> nil) then
+ begin
+ result := GCPRes.lpGlyphs^;
+ end;
+ finally
+ FreeMem(GCPRes.lpGlyphs);
+ end;
+ end;
+ finally
+ DeleteDC(DC);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsFontGeneratorGDI.GetCharImageAANone(const aDC: HDC; const aFont: TtsFontGDI; const aCharCode: WideChar; const aImage: TtsImage);
+var
+ Metric: TGlyphMetrics;
+ GlyphIndex, srcW, srcX, w, h, x, y: Integer;
+ Size, OutlineRes: Cardinal;
+ Buffer, pSrc, pDst: PByte;
+
+ procedure ExpandByte;
+ var
+ i, cnt, srcCnt: Integer;
+ c: TtsColor4f;
+ begin
+ srcCnt := min(8, srcX);
+ cnt := min(8, x);
+ for i := 1 to cnt do begin
+ c := tsColor4f(1, 1, 1, 1);
+ if ((pSrc^ and $80) > 0) then
+ c.a := 1
+ else
+ c.a := 0;
+ pSrc^ := (pSrc^ and not $80) shl 1;
+ tsFormatMap(aFont.Renderer.Format, pDst, c);
+ end;
+ dec(srcX, srcCnt);
+ dec(x, cnt);
+ inc(pSrc);
+ end;
+
+begin
+ if (aFont.fMat2.eM11.value <> 1) then
+ raise EtsException.Create('invalid value');
+ FillByte(Metric, SizeOf(Metric), 0);
+
+ GlyphIndex := GetGlyphIndex(aFont, aCharCode);
+ if (GlyphIndex < 0) then
+ exit;
+
+ Size := GetGlyphOutlineA(aDC, GlyphIndex, GGO_BITMAP or GGO_GLYPH_INDEX, @Metric, 0, nil, @aFont.fMat2);
+ if (Size = GDI_ERROR) or (Size = 0) then
+ exit;
+
+ GetMem(Buffer, Size);
+ try
+ OutlineRes := GetGlyphOutlineA(aDC, GlyphIndex, GGO_BITMAP or GGO_GLYPH_INDEX, @Metric, Size, Buffer, @aFont.fMat2);
+ if (OutlineRes = GDI_ERROR) then
+ exit;
+ w := Metric.gmBlackBoxX;
+ h := Metric.gmBlackBoxY;
+ srcW := (Size div h) * 8;
+ if (w <= 0) or (h <= 0) then
+ exit;
+ aImage.CreateEmpty(aFont.Renderer.Format, w, h);
+ pSrc := Buffer;
+ for y := 0 to h-1 do begin
+ pDst := aImage.Scanline[y];
+ srcX := srcW;
+ while (srcX > 0) do
+ ExpandByte;
+ end;
+ finally
+ Freemem(Buffer);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsFontGeneratorGDI.GetCharImageAANormal(const aDC: HDC; const aFont: TtsFontGDI; const aCharCode: WideChar; const aImage: TtsImage);
+var
+ Metric: TGlyphMetrics;
+ GlyphIndex, OutlineRes, tmp, Spacer, x, y, w, h: Integer;
+ Size: Cardinal;
+ Buffer, pSrc, pDst: PByte;
+
+ procedure CopyPixel;
+ var
+ i: Integer;
+ tmp, cnt: Cardinal;
+ c: TtsColor4f;
+ begin
+ cnt := min(x, aFont.fMat2.eM11.value);
+ tmp := 0;
+ for i := 0 to cnt-1 do begin
+ tmp := tmp + pSrc^;
+ inc(pSrc, 1);
+ end;
+ dec(x, cnt);
+ c := tsColor4f(1, 1, 1, tmp / ($40 * Cardinal(aFont.fMat2.eM11.value)));
+ tsFormatMap(aFont.Renderer.Format, pDst, c);
+ end;
+
+begin
+ FillByte(Metric, SizeOf(Metric), 0);
+
+ GlyphIndex := GetGlyphIndex(aFont, aCharCode);
+ if (GlyphIndex < 0) then
+ exit;
+
+ Size := GetGlyphOutlineA(aDC, GlyphIndex, GGO_GRAY8_BITMAP or GGO_GLYPH_INDEX, @Metric, 0, nil, @aFont.fMat2);
+ if (Size = GDI_ERROR) or (Size = 0) then
+ exit;
+
+ GetMem(Buffer, Size);
+ try
+ OutlineRes := GetGlyphOutlineA(aDC, GlyphIndex, GGO_GRAY8_BITMAP or GGO_GLYPH_INDEX, @Metric, Size, Buffer, @aFont.fMat2);
+ if (OutlineRes = GDI_ERROR) then
+ exit;
+ w := Integer(Metric.gmBlackBoxX) div aFont.fMat2.eM11.value;
+ h := Metric.gmBlackBoxY;
+ tmp := Integer(Metric.gmBlackBoxX) mod aFont.fMat2.eM11.value;
+ if (tmp <> 0) then
+ w := w + aFont.fMat2.eM11.value - tmp;
+ if (w <= 0) or (h <= 0) then
+ exit;
+
+ // spacer
+ Spacer := Metric.gmBlackBoxX mod 4;
+ if (Spacer <> 0) then
+ Spacer := 4 - Spacer;
+
+ // copy image
+ aImage.CreateEmpty(aFont.Renderer.Format, w, h);
+ pSrc := Buffer;
+ for y := 0 to h-1 do begin
+ pDst := aImage.Scanline[y];
+ x := Metric.gmBlackBoxX;
+ while (x > 0) do
+ CopyPixel;
+ inc(pSrc, Spacer);
+ end;
+ finally
+ FreeMem(Buffer);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorGDI.CreateFont(const aFontname: String; const aSize: Integer; const aStyle: TtsFontStyles;
+ const aAntiAliasing: TtsAntiAliasing; out aProperties: TtsFontProperties): THandle;
+var
+ LogFont: TLogFontA;
+ i: Integer;
+ DC: HDC;
+ TableName, BufSize: Cardinal;
+ Buffer: PByte;
+ Lang: AnsiString;
+ TextMetric: TTextMetricW;
+ OutlineMetric: TOutlineTextmetricW;
+
+ function _(e: Boolean; a, b: Integer): Integer;
+ begin
+ if e then
+ result := a
+ else
+ result := b;
+ end;
+
+begin
+ result := 0;
+
+ FillByte(aProperties, SizeOf(aProperties), 0);
+ aProperties.Size := aSize;
+ aProperties.Style := aStyle;
+ aProperties.AntiAliasing := aAntiAliasing;
+ aProperties.Fontname := aFontname;
+
+ // prepare font attribs
+ FillByte(LogFont, SizeOf(LogFont), 0);
+ for i := 1 to min(Length(aFontname), Length(LogFont.lfFaceName)) do
+ LogFont.lfFaceName[i-1] := aFontname[i];
+ LogFont.lfCharSet := DEFAULT_CHARSET;
+ LogFont.lfHeight := -aSize;
+ LogFont.lfWeight := _(tsStyleBold in aStyle, FW_BOLD, FW_NORMAL);
+ LogFont.lfItalic := _(tsStyleItalic in aStyle, 1, 0);
+ LogFont.lfUnderline := _(tsStyleUnderline in aStyle, 1, 0);
+ LogFont.lfQuality := _(aAntiAliasing = tsAANormal, ANTIALIASED_QUALITY, NONANTIALIASED_QUALITY);
+
+ result := CreateFontIndirectA(LogFont);
+ DC := CreateCompatibleDC(0);
+ try try
+ SelectObject(DC, result);
+ TableName := MakeTTTableName('n', 'a', 'm', 'e');
+ BufSize := GetFontData(DC, TableName, 0, nil, 0);
+ if (BufSize <> GDI_ERROR) then begin
+ GetMem(Buffer, BufSize);
+ try
+ if (GetFontData(DC, TableName, 0, Buffer, BufSize) <> GDI_ERROR) then begin
+ SetLength(Lang, 4);
+ GetLocaleInfoA(LOCALE_USER_DEFAULT, LOCALE_ILANGUAGE, @Lang[1], 4);
+
+ GetTTString(Buffer, BufSize, NAME_ID_COPYRIGHT, StrToInt('$' + String(Lang)), aProperties.Copyright);
+ GetTTString(Buffer, BufSize, NAME_ID_FACE_NAME, StrToInt('$' + String(Lang)), aProperties.FaceName);
+ GetTTString(Buffer, BufSize, NAME_ID_STYLE_NAME, StrToInt('$' + String(Lang)), aProperties.StyleName);
+ GetTTString(Buffer, BufSize, NAME_ID_FULL_NAME, StrToInt('$' + String(Lang)), aProperties.FullName);
+ end;
+ finally
+ FreeMem(Buffer);
+ end;
+ end;
+
+ if GetTextMetricsW(DC, TextMetric) then begin
+ aProperties.Ascent := TextMetric.tmAscent;
+ aProperties.Descent := TextMetric.tmDescent;
+ aProperties.ExternalLeading := TextMetric.tmExternalLeading;
+ aProperties.DefaultChar := TextMetric.tmDefaultChar;
+ end;
+
+ if (GetOutlineTextMetricsW(DC, SizeOf(OutlineMetric), OutlineMetric) > 0) then begin
+ aProperties.UnderlinePos := OutlineMetric.otmsUnderscorePosition;
+ aProperties.UnderlineSize := Min(1, OutlineMetric.otmsUnderscoreSize);
+ aProperties.StrikeoutPos := OutlineMetric.otmsStrikeoutPosition;
+ aProperties.StrikeoutSize := Min(1, OutlineMetric.otmsStrikeoutSize);
+ end;
+ except
+ DeleteObject(result);
+ result := 0;
+ end;
+ finally
+ DeleteDC(DC);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorGDI.GetGlyphMetrics(const aFont: TtsFont; const aCharCode: WideChar; out aGlyphOrigin, aGlyphSize: TtsPosition; out aAdvance: Integer): Boolean;
+var
+ GlyphIndex: Integer;
+ font: TtsFontGDI;
+ DC: HDC;
+ Metric: TGlyphMetrics;
+ Size: Cardinal;
+begin
+ result := false;
+
+ aGlyphOrigin.x := 0;
+ aGlyphOrigin.x := 0;
+ aGlyphSize.x := 0;
+ aGlyphSize.y := 0;
+ aAdvance := 0;
+
+ font := ConvertFont(aFont);
+ GlyphIndex := GetGlyphIndex(font, aCharCode);
+ if (GlyphIndex < 0) then
+ exit;
+
+ DC := CreateCompatibleDC(0);
+ try
+ SelectObject(DC, font.fHandle);
+ case font.Properties.AntiAliasing of
+ tsAANone: begin
+ Size := GetGlyphOutlineA(DC, GlyphIndex, GGO_BITMAP or GGO_GLYPH_INDEX, @Metric, 0, nil, @font.fMat2);
+ end;
+ tsAANormal: begin
+ Size := GetGlyphOutlineA(DC, GlyphIndex, GGO_GRAY8_BITMAP or GGO_GLYPH_INDEX, @Metric, 0, nil, @font.fMat2);
+ end;
+ else
+ Size := GDI_ERROR;
+ end;
+
+ if (Size = GDI_ERROR) then
+ Size := GetGlyphOutlineA(DC, GlyphIndex, GGO_METRICS or GGO_GLYPH_INDEX, @Metric, 0, nil, @font.fMat2);
+
+ if (Size <> GDI_ERROR) then begin
+ aGlyphOrigin.x := Round(Metric.gmptGlyphOrigin.x / font.fMat2.eM11.value);
+ aGlyphOrigin.y := Metric.gmptGlyphOrigin.y;
+ aGlyphSize.x := Round(Metric.gmBlackBoxX / font.fMat2.eM11.value);
+ aGlyphSize.y := Metric.gmBlackBoxY;
+ aAdvance := Round(Metric.gmCellIncX / font.fMat2.eM11.value);
+ result := true;
+ end;
+ finally
+ DeleteDC(DC);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsFontGeneratorGDI.GetCharImage(const aFont: TtsFont; const aCharCode: WideChar; const aCharImage: TtsImage);
+var
+ DC: HDC;
+ font: TtsFontGDI;
+begin
+ font := ConvertFont(aFont);
+ DC := CreateCompatibleDC(0);
+ try
+ SelectObject(DC, font.fHandle);
+ case font.Properties.AntiAliasing of
+ tsAANone:
+ GetCharImageAANone(DC, font, aCharCode, aCharImage);
+ tsAANormal:
+ GetCharImageAANormal(DC, font, aCharCode, aCharImage);
+ end;
+ finally
+ DeleteDC(DC);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorGDI.GetFontByName(const aFontname: String; const aRenderer: TtsRenderer;
+ const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
+var
+ handle: THandle;
+ prop: TtsFontProperties;
+begin
+ handle := CreateFont(aFontname, aSize, aStyle, aAntiAliasing, prop);
+ if (handle = 0) then
+ raise EtsException.Create('unable to create font from name: ' + aFontname);
+ result := TtsFontGDI.Create(aRenderer, self, prop, handle);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorGDI.GetFontByFile(const aFilename: String; const aRenderer: TtsRenderer;
+ const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
+var
+ reg: TtsFontRegistrationFile;
+ handle: THandle;
+ prop: TtsFontProperties;
+begin
+ reg := TtsFontRegistrationFile.Create(aFilename);
+ if not reg.IsRegistered then
+ raise EtsException.Create('unable to register font file: ' + aFilename);
+ handle := CreateFont(reg.Fontname, aSize, aStyle, aAntiAliasing, prop);
+ if (handle = 0) then
+ raise EtsException.Create('unable to create font from file: ' + aFilename);
+ result := TtsRegistredFontGDI.Create(aRenderer, self, reg, prop, handle);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFontGeneratorGDI.GetFontByStream(const aStream: TStream; const aRenderer: TtsRenderer;
+ const aSize: Integer; const aStyle: TtsFontStyles; const aAntiAliasing: TtsAntiAliasing): TtsFont;
+var
+ reg: TtsFontRegistrationStream;
+ handle: THandle;
+ prop: TtsFontProperties;
+begin
+ reg := TtsFontRegistrationStream.Create(aStream);
+ if not reg.IsRegistered then
+ raise EtsException.Create('unable to register font from stream');
+ handle := CreateFont(reg.Fontname, aSize, aStyle, aAntiAliasing, prop);
+ if (handle = 0) then
+ raise EtsException.Create('unable to create font from stream: ' + reg.Fontname);
+ result := TtsRegistredFontGDI.Create(aRenderer, self, reg, prop, handle);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsFontGeneratorGDI.Create;
+begin
+ inherited Create;
+ gdiCritSec.Enter;
+ try
+ inc(gdiRefCount, 1);
+ if not gdiInitialized then
+ InitGDI;
+ finally
+ gdiCritSec.Leave;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsFontGeneratorGDI.Destroy;
+begin
+ gdiCritSec.Enter;
+ try
+ dec(gdiRefCount, 1);
+ if (gdiRefCount <= 0) then
+ QuitGDI;
+ finally
+ gdiCritSec.Leave;
+ end;
+ inherited Destroy;
+end;
+
+initialization
+ gdiRefCount := 0;
+ gdiInitialized := false;
+ gdiCritSec := TCriticalSection.Create;
+
+finalization
+ if gdiInitialized then
+ QuitGDI;
+ FreeAndNil(gdiCritSec);
+
+end.
diff --git a/new/utsRendererOpenGL.pas b/new/utsRendererOpenGL.pas
new file mode 100644
index 0000000..0f8e3a4
--- /dev/null
+++ b/new/utsRendererOpenGL.pas
@@ -0,0 +1,521 @@
+unit utsRendererOpenGL;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, syncobjs, dglOpenGL,
+ utsTextSuite, utsTypes;
+
+type
+ TtsQuadPosF = array[0..3] of TtsPositionF;
+ TtsCharRenderRefOpenGL = class(TtsCharRenderRef)
+ private
+ TextureID: GLint; // ID of OpenGL texture where the char is stored in
+ TexCoordSize: TtsPositionF; // size of the char in texture coords (0.0 - 1.0)
+ TexCoordPos: TtsPositionF; // position of the char in texture coords (0.0 - 1.0)
+ VertexSize: TtsPositionF; // size of the char in world coords
+ VertexPos: TtsPositionF; // size of the char in world coords
+ public
+ constructor Create;
+ end;
+
+ PtsTextureUsageItem = ^TtsTextureUsageItem;
+ TtsTextureUsageItem = packed record
+ children: array[0..3] of PtsTextureUsageItem;
+ end;
+
+ PtsTextureTreeItem = ^TtsTextureTreeItem;
+ TtsTextureTreeItem = packed record
+ value: SmallInt;
+ children: array[0..1] of PtsTextureTreeItem;
+ ref: TtsCharRenderRefOpenGL;
+ end;
+
+ PtsFontTexture = ^TtsFontTexture;
+ TtsFontTexture = packed record
+ ID: GLint; // OpenGL texture ID
+ Usage: PtsTextureTreeItem ; // tree of used texture space
+ Next: PtsFontTexture; // next texture in list
+ Prev: PtsFontTexture; // previouse texture in list
+ Size: Integer; // size of this texture
+ Count: Integer; // number of chars stored in this texture
+ end;
+
+ TtsRendererOpenGL = class(TtsRenderer)
+ private
+ fVBO: GLuint;
+ fTextureSize: Integer;
+ fColor: TtsColor4f;
+ fRenderPos: TtsPosition;
+ fIsRendering: Boolean;
+ fFirstTexture: PtsFontTexture;
+ fLastTexture: PtsFontTexture;
+
+ function CreateNewTexture: PtsFontTexture;
+ procedure FreeTexture(var aTexture: PtsFontTexture);
+ procedure FreeTextures(var aTexture: PtsFontTexture);
+ procedure FreeTextureTreeItem(var aItem: PtsTextureTreeItem);
+ protected
+ function CreateRenderRef(const aChar: TtsChar; const aCharImage: TtsImage): TtsCharRenderRef; override;
+ procedure FreeRenderRef(const aCharRef: TtsCharRenderRef); override;
+
+ procedure BeginRender; override;
+ procedure EndRender; override;
+
+ procedure SetDrawPos(const X, Y: Integer); override;
+ function GetDrawPos: TtsPosition; override;
+ procedure MoveDrawPos(const X, Y: Integer); override;
+ procedure SetColor(const aColor: TtsColor4f); override;
+ procedure Render(const aCharRef: TtsCharRenderRef); override;
+ public
+ property TextureSize: Integer read fTextureSize write fTextureSize;
+
+ constructor Create(const aContext: TtsContext; const aFormat: TtsFormat);
+ destructor Destroy; override;
+ end;
+
+ EtsRendererOpenGL = class(EtsRenderer);
+
+implementation
+
+type
+ TVertex = packed record
+ pos: array[0..1] of GLfloat;
+ tex: array[0..1] of GLfloat;
+ end;
+
+const
+ FORMAT_TYPES: array[TtsFormat] of packed record
+ InternalFormat: GLenum;
+ Format: GLenum;
+ DataFormat: GLenum;
+ end = (
+ ( //tsFormatEmpty
+ InternalFormat: 0;
+ Format: 0;
+ DataFormat: 0),
+ ( //tsFormatRGBA8
+ InternalFormat: GL_RGBA8;
+ Format: GL_RGBA;
+ DataFormat: GL_UNSIGNED_BYTE),
+ ( //tsFormatLumAlpha8
+ InternalFormat: GL_LUMINANCE8_ALPHA8;
+ Format: GL_LUMINANCE_ALPHA;
+ DataFormat: GL_UNSIGNED_BYTE),
+ ( //tsFormatAlpha8
+ InternalFormat: GL_ALPHA8;
+ Format: GL_ALPHA;
+ DataFormat: GL_UNSIGNED_BYTE)
+ );
+
+ VBO_DATA: array[0..3] of TVertex = (
+ (pos: (0.0, 0.0); tex: (0.0, 0.0)),
+ (pos: (0.0, 1.0); tex: (0.0, 1.0)),
+ (pos: (1.0, 1.0); tex: (1.0, 1.0)),
+ (pos: (1.0, 0.0); tex: (1.0, 0.0))
+ );
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsCharRenderRefOpenGL////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsCharRenderRefOpenGL.Create;
+begin
+ inherited Create;
+ TextureID := 0;
+ FillByte(TexCoordPos, SizeOf(TexCoordPos), 0);
+ FillByte(TexCoordSize, SizeOf(TexCoordSize), 0);
+ FillByte(VertexPos, SizeOf(VertexPos), 0);
+ FillByte(VertexSize, SizeOf(VertexSize), 0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsRendererOpenGL/////////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsRendererOpenGL.CreateNewTexture: PtsFontTexture;
+begin
+ new(result);
+ try
+ FillByte(result^, SizeOf(result^), 0);
+ new(result^.Usage);
+ FillByte(result^.Usage^, SizeOf(result^.Usage^), 0);
+ result^.Size := TextureSize;
+ glGenTextures(1, @result^.ID);
+ glBindTexture(GL_TEXTURE_2D, result^.ID);
+ 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,
+ FORMAT_TYPES[Format].InternalFormat,
+ result^.Size,
+ result^.Size,
+ 0,
+ FORMAT_TYPES[Format].Format,
+ FORMAT_TYPES[Format].DataFormat,
+ nil);
+
+ result^.Prev := fLastTexture;
+ if Assigned(fLastTexture) then
+ fLastTexture^.Next := result
+ else
+ fFirstTexture := result;
+ fLastTexture := result;
+ except
+ if Assigned(result^.Usage) then
+ Dispose(result^.Usage);
+ Dispose(result);
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRendererOpenGL.FreeTexture(var aTexture: PtsFontTexture);
+begin
+ if not Assigned(aTexture) then
+ exit;
+ glDeleteTextures(1, @aTexture^.ID);
+ FreeTextureTreeItem(aTexture^.Usage);
+ if Assigned(aTexture^.Prev) then
+ aTexture^.Prev^.Next := aTexture^.Next;
+ if Assigned(aTexture^.Next) then
+ aTexture^.Next^.Prev := aTexture^.Prev;
+ Dispose(aTexture);
+ aTexture := nil;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRendererOpenGL.FreeTextures(var aTexture: PtsFontTexture);
+begin
+ if not Assigned(aTexture) then
+ exit;
+ FreeTextures(aTexture^.Next);
+ FreeTexture(aTexture);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRendererOpenGL.FreeTextureTreeItem(var aItem: PtsTextureTreeItem);
+begin
+ if not Assigned(aItem) then
+ exit;
+ FreeTextureTreeItem(aItem^.children[0]);
+ FreeTextureTreeItem(aItem^.children[1]);
+ Dispose(aItem);
+ aItem := nil;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsRendererOpenGL.CreateRenderRef(const aChar: TtsChar; const aCharImage: TtsImage): TtsCharRenderRef;
+var
+ GlyphWidth, GlyphHeight: Integer;
+
+ function InsertToTree(const aItem: PtsTextureTreeItem; const X1, Y1, X2, Y2: SmallInt; out X, Y: Integer): PtsTextureTreeItem;
+ var
+ w, h: Integer;
+ begin
+ result := nil;
+ w := X2 - X1;
+ h := Y2 - Y1;
+ if not Assigned(aItem) or
+ Assigned(aItem^.ref) or
+ (w < GlyphWidth) or
+ (h < GlyphHeight) then
+ exit;
+
+ if (aItem^.value > 0) then begin
+ result := InsertToTree(aItem^.children[0], X1, Y1, X2, aItem^.value, X, Y);
+ if not Assigned(result) then
+ result := InsertToTree(aItem^.children[1], X1, aItem^.value, X2, Y2, X, Y);
+ end else if (aItem^.value < 0) then begin
+ result := InsertToTree(aItem^.children[0], X1, Y1, -aItem^.value, Y2, X, Y);
+ if not Assigned(result) then
+ result := InsertToTree(aItem^.children[1], -aItem^.value, Y1, X2, Y2, X, Y);
+ end else if (w = GlyphWidth) and (h = GlyphHeight) then begin
+ X := X1;
+ Y := Y1;
+ result := aItem;
+ end else begin
+ new(aItem^.children[0]);
+ new(aItem^.children[1]);
+ FillByte(aItem^.children[0]^, SizeOf(aItem^.children[0]^), 0);
+ FillByte(aItem^.children[1]^, SizeOf(aItem^.children[1]^), 0);
+ if (w - GlyphWidth) < (h - GlyphHeight) then begin
+ aItem^.value := Y1 + GlyphHeight;
+ result := InsertToTree(aItem^.children[0], X1, Y1, X2, aItem^.value, X, Y);
+ end else begin
+ aItem^.value := -(X1 + GlyphWidth);
+ result := InsertToTree(aItem^.children[0], X1, Y1, -aItem^.value, Y2, X, Y)
+ end;
+ end;
+ end;
+
+ function AddToTexture(const aTexture: PtsFontTexture): TtsCharRenderRefOpenGL;
+ var
+ x, y: Integer;
+ item: PtsTextureTreeItem;
+ begin
+ item := InsertToTree(aTexture^.Usage, 0, 0, aTexture^.Size, aTexture^.Size, x, y);
+ if not Assigned(item) then
+ raise EtsRendererOpenGL.Create('unable to add glyph to texture');
+ item^.ref := TtsCharRenderRefOpenGL.Create;
+ result := item^.ref;
+
+ // Text Coords
+ result.TextureID := aTexture^.ID;
+ result.TexCoordPos.x := x / aTexture^.Size;
+ result.TexCoordPos.y := y / aTexture^.Size;
+ result.TexCoordSize.x := aCharImage.Width / aTexture^.Size;
+ result.TexCoordSize.y := aCharImage.Height / aTexture^.Size;
+
+ // Vertex Coords
+ result.VertexPos.x := -aChar.GlyphRect.Left;
+ result.VertexPos.y := -aChar.GlyphRect.Top - aChar.GlyphOrigin.y;
+ result.VertexSize.x := aCharImage.Width;
+ result.VertexSize.y := aCharImage.Height;
+
+ glBindTexture(GL_TEXTURE_2D, result.TextureID);
+ glTexSubImage2D(GL_TEXTURE_2D, 0,
+ x, y, aCharImage.Width, aCharImage.Height,
+ FORMAT_TYPES[aCharImage.Format].Format,
+ FORMAT_TYPES[aCharImage.Format].DataFormat,
+ aCharImage.Data);
+ end;
+
+var
+ tex: PtsFontTexture;
+begin
+ result := nil;
+ if aCharImage.IsEmpty then
+ exit;
+
+ GlyphWidth := aCharImage.Width + 1;
+ GlyphHeight := aCharImage.Height + 1;
+
+ // try to add to existing texture
+ tex := fFirstTexture;
+ while Assigned(tex) and not Assigned(result) do begin
+ result := AddToTexture(tex);
+ tex := tex^.Next;
+ end;
+
+ // create new texture
+ if not Assigned(result) then begin
+ if (aCharImage.Width > TextureSize) or (aCharImage.Height > TextureSize) then
+ raise EtsRendererOpenGL.Create('char is to large to fit into a texture: ' + aChar.CharCode + ' (0x' + IntToHex(Ord(aChar.CharCode), 4) + ')');
+ tex := CreateNewTexture;
+ result := AddToTexture(tex);
+ end;
+
+ if not Assigned(result) then
+ raise EtsRendererOpenGL.Create('unable to creat render reference for char: ' + aChar.CharCode + ' (0x' + IntToHex(Ord(aChar.CharCode), 4) + ')');
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRendererOpenGL.FreeRenderRef(const aCharRef: TtsCharRenderRef);
+var
+ ref: TtsCharRenderRefOpenGL;
+ tex: PtsFontTexture;
+
+ function IsEmtpy(const aItem: PtsTextureTreeItem): Boolean;
+ begin
+ result :=
+ Assigned(aItem) and
+ not Assigned(aItem^.children[0]) and
+ not Assigned(aItem^.children[1]) and
+ not Assigned(aItem^.ref);
+ end;
+
+ function RemoveFromTree(const aItem: PtsTextureTreeItem; const X1, Y1, X2, Y2: Integer): Boolean;
+ var
+ w, h: Integer;
+ begin
+ w := X2 - X1;
+ h := Y2 - Y1;
+ if not Assigned(aItem) or
+ (w < ref.VertexSize.x) or
+ (h < ref.VertexSize.y) then
+ exit;
+
+ result := (aItem^.ref = ref);
+ if not result then begin
+ if (aItem^.value > 0) then begin
+ result := result or RemoveFromTree(aItem^.children[0], X1, Y1, X2, aItem^.value);
+ result := result or RemoveFromTree(aItem^.children[1], X1, aItem^.value, X2, Y2);
+ end else if (aItem^.value < 0) then begin
+ result := result or RemoveFromTree(aItem^.children[0], X1, Y1, -aItem^.value, Y2);
+ result := result or RemoveFromTree(aItem^.children[1], -aItem^.value, Y1, X2, Y2);
+ end;
+ end else
+ aItem^.ref := nil;
+
+ if result and
+ IsEmtpy(aItem^.children[0]) and
+ IsEmtpy(aItem^.children[1]) then
+ begin
+ FreeTextureTreeItem(aItem^.children[0]);
+ FreeTextureTreeItem(aItem^.children[1]);
+ FillByte(aItem^, SizeOf(aItem^), 0);
+ end;
+ end;
+
+begin
+ try
+ if not Assigned(aCharRef) or not (aCharRef is TtsCharRenderRefOpenGL) then
+ exit;
+ ref := (aCharRef as TtsCharRenderRefOpenGL);
+ tex := fFirstTexture;
+ while Assigned(tex) do begin
+ if (tex^.ID = ref.TextureID) then begin
+ if not RemoveFromTree(tex^.Usage, 0, 0, tex^.Size, tex^.Size) then
+ raise EtsRendererOpenGL.Create('unable to remove render ref from texture');
+ if IsEmtpy(tex^.Usage) then begin
+ if (tex = fFirstTexture) then
+ fFirstTexture := nil;
+ FreeTexture(tex);
+ end;
+ tex := nil;
+ end else
+ tex := tex^.Next;
+ end;
+ finally
+ if Assigned(aCharRef) then
+ aCharRef.Free;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRendererOpenGL.BeginRender;
+begin
+ inherited BeginRender;
+ fIsRendering := true;
+ fRenderPos.x := 0;
+ fRenderPos.y := 0;
+ glPushMatrix;
+ glColor4fv(@fColor.arr[0]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRendererOpenGL.EndRender;
+begin
+ if fIsRendering then begin
+ glPopMatrix;
+ fIsRendering := false;
+ end;
+ inherited EndRender;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRendererOpenGL.SetDrawPos(const X, Y: Integer);
+begin
+ fRenderPos.x := X;
+ fRenderPos.y := Y;
+ glPopMatrix;
+ glPushMatrix;
+ glTranslatef(X, Y, 0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsRendererOpenGL.GetDrawPos: TtsPosition;
+begin
+ result := fRenderPos;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRendererOpenGL.MoveDrawPos(const X, Y: Integer);
+begin
+ fRenderPos.x := fRenderPos.x + X;
+ fRenderPos.y := fRenderPos.y + Y;
+ glTranslatef(X, Y, 0);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRendererOpenGL.SetColor(const aColor: TtsColor4f);
+begin
+ fColor := aColor;
+ glColor4fv(@fColor.arr[0]);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsRendererOpenGL.Render(const aCharRef: TtsCharRenderRef);
+var
+ ref: TtsCharRenderRefOpenGL;
+
+ procedure RenderTreeItem(const aItem: PtsTextureTreeItem; const X1, Y1, X2, Y2: Integer);
+ begin
+ glBegin(GL_LINE_LOOP);
+ glVertex2f(X1, Y1);
+ glVertex2f(X2, Y1);
+ glVertex2f(X2, Y2);
+ glVertex2f(X1, Y2);
+ glEnd;
+ if (aItem^.value > 0) then begin
+ RenderTreeItem(aItem^.children[0], X1, Y1, X2, aItem^.value);
+ RenderTreeItem(aItem^.children[1], X1, aItem^.value, X2, Y2);
+ end else if (aItem^.value < 0) then begin
+ RenderTreeItem(aItem^.children[0], X1, Y1, -aItem^.value, Y2);
+ RenderTreeItem(aItem^.children[1], -aItem^.value, Y1, X2, Y2);
+ end;
+ end;
+
+begin
+ if Assigned(aCharRef) and (aCharRef is TtsCharRenderRefOpenGL) then begin
+ ref := (aCharRef as TtsCharRenderRefOpenGL);
+
+ glEnable(GL_TEXTURE_2D);
+ glBindTexture(GL_TEXTURE_2D, ref.TextureID);
+
+ glMatrixMode(GL_TEXTURE);
+ glPushMatrix;
+ glLoadIdentity;
+ glTranslatef(ref.TexCoordPos.x, ref.TexCoordPos.y, 0);
+ glScalef(ref.TexCoordSize.x, ref.TexCoordSize.y, 1);
+
+ glMatrixMode(GL_MODELVIEW);
+ glPushMatrix;
+ glTranslatef(ref.VertexPos.x, ref.VertexPos.y, 0);
+ glScalef(ref.VertexSize.x, ref.VertexSize.y, 1);
+
+ glBindBuffer(GL_ARRAY_BUFFER, fVBO);
+ glEnableClientState(GL_VERTEX_ARRAY);
+ glVertexPointer(2, GL_FLOAT, SizeOf(TVertex), Pointer(0));
+ glEnableClientState(GL_TEXTURE_COORD_ARRAY);
+ glTexCoordPointer(2, GL_FLOAT, SizeOf(TVertex), Pointer(8));
+
+ glDrawArrays(GL_QUADS, 0, 4);
+
+ glDisableClientState(GL_TEXTURE_COORD_ARRAY);
+ glDisableClientState(GL_VERTEX_ARRAY);
+
+ glMatrixMode(GL_TEXTURE);
+ glPopMatrix;
+ glMatrixMode(GL_MODELVIEW);
+ glPopMatrix;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor TtsRendererOpenGL.Create(const aContext: TtsContext; const aFormat: TtsFormat);
+begin
+ inherited Create(aContext, aFormat);
+ fIsRendering := false;
+ fFirstTexture := nil;
+ fLastTexture := nil;
+ fTextureSize := 2048;
+ fColor := tsColor4f(1, 1, 1, 1);
+ fRenderPos := tsPosition(0, 0);
+
+ glGenBuffers(1, @fVBO);
+ glBindBuffer(GL_ARRAY_BUFFER, fVBO);
+ glBufferData(GL_ARRAY_BUFFER, SizeOf(TVertex) * Length(VBO_DATA), @VBO_DATA[0].pos[0], GL_STATIC_DRAW);
+ glBindBuffer(GL_ARRAY_BUFFER, 0);
+end;
+
+destructor TtsRendererOpenGL.Destroy;
+begin
+ glDeleteBuffers(1, @fVBO);
+ FreeTextures(fFirstTexture);
+ inherited Destroy;
+end;
+
+end.
+
diff --git a/new/utsTextSuite.pas b/new/utsTextSuite.pas
index 0408fa8..3eae601 100644
--- a/new/utsTextSuite.pas
+++ b/new/utsTextSuite.pas
@@ -5,142 +5,13 @@ unit utsTextSuite;
interface
uses
- Classes, SysUtils, contnrs, math, syncobjs;
+ Classes, SysUtils, contnrs, math, syncobjs,
+ utsTypes, utsUtils;
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;
+ TtsFontGenerator = class;
TtsRenderer = class;
TtsContext = class;
@@ -180,7 +51,7 @@ type
property Height: Integer read fHeight;
property Format: TtsFormat read fFormat;
property Data: Pointer read fData;
- property Scanline[const aIndex: Integer]: Pointer read GetScanline;
+ property Scanline[const aIndex: Integer]: Pointer read GetScanline;
function GetPixelAt(const x, y: Integer; out aColor: TtsColor4f): Boolean;
@@ -199,6 +70,7 @@ type
procedure AddResizingBorder;
constructor Create;
+ destructor Destroy; override;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -209,15 +81,13 @@ type
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;
+ 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 RenderRef: TtsCharRenderRef read fRenderRef write fRenderRef;
constructor Create(const aCharCode: WideChar);
end;
@@ -231,66 +101,35 @@ type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TtsFont = class(TObject)
private
- fCreateChars: Boolean;
- fDefaultChar: WideChar;
-
- fCopyright: String;
- fFaceName: String;
- fStyleName: String;
- fFullName: String;
-
- fSize: Integer;
- fStyle: TtsFontStyles;
- fAntiAliasing: TtsAntiAliasing;
+ fRenderer: TtsRenderer;
+ fCreator: TtsFontGenerator;
+ fProperties: TtsFontProperties;
- fAscent: Integer;
- fDescent: Integer;
- fExternalLeading: Integer;
- fBaseLineOffset: Integer;
fCharSpacing: Integer;
- fLineSpacing: Integer;
-
- fUnderlinePos: Integer;
- fUnderlineSize: Integer;
- fStrikeoutPos: Integer;
- fStrikeoutSize: Integer;
+ fTabWidth: Integer;
+ fLineSpacing: Single;
fChars: array[Byte] of PtsFontCharArray;
-
- fRenderer: TtsRenderer;
- fCreator: TtsFontCreator;
+ fCreateChars: Boolean;
function HasChar(const aCharCode: WideChar): Boolean;
function GetChar(const aCharCode: WideChar): TtsChar;
- procedure AddChar(const aCharCode: WideChar; const aChar: TtsChar);
+ function GetCharCreate(const aCharCode: WideChar): TtsChar;
+ procedure AddChar(const aCharCode: WideChar; const aChar: TtsChar); overload;
+ protected
+ constructor Create(const aRenderer: TtsRenderer; const aCreator: TtsFontGenerator; const aProperties: TtsFontProperties);
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);
+ property Renderer: TtsRenderer read fRenderer;
+ property Properties: TtsFontProperties read fProperties;
+
+ property CharSpacing: Integer read fCharSpacing write fCharSpacing;
+ property TabWidth: Integer read fTabWidth write fTabWidth;
+ property LineSpacing: Single read fLineSpacing write fLineSpacing;
+
+ function AddChar(const aCharCode: WideChar): TtsChar; overload;
procedure AddCharRange(const aCharCodeBeg, aCharCodeEnd: WideChar);
procedure RemoveChar(const aCharCode: WideChar);
procedure ClearChars;
@@ -298,9 +137,6 @@ type
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;
@@ -336,23 +172,21 @@ type
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TtsFontCreator = class(TObject)
+ TtsFontGenerator = 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;
+ protected
+ function GetGlyphMetrics(const aFont: TtsFont; const aCharCode: WideChar; out aGlyphOrigin, aGlyphSize: TtsPosition; out aAdvance: Integer): Boolean; virtual; abstract;
+ procedure GetCharImage(const aFont: TtsFont; const aCharCode: WideChar; const aCharImage: 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;
@@ -398,7 +232,8 @@ type
end;
TtsLineFlag = (
- tsLastItemIsSpace
+ tsLastItemIsSpace, // is set if the last item was a space item
+ tsMetaValid // is set if the line meta data is valid
);
TtsLineFlags = set of TtsLineFlag;
PtsBlockLine = ^TtsBlockLine;
@@ -406,14 +241,15 @@ type
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
+
+ meta: packed record
+ Width: Integer; // absolut width of this line
+ Height: Integer; // absolute height of this line
+ Spacing: Integer; // spacing between lines
+ Ascent: Integer; // text ascent
+ SpaceCount: Integer; // number of words in this line
+ end;
end;
TtsBlockFlag = (
@@ -442,7 +278,6 @@ type
fHorzAlign: TtsHorzAlignment;
fClipping: TtsClipping;
- fTextMetric: TtsTextMetric;
fCurrentColor: TtsColor4f;
fCurrentFont: TtsFont;
fFirstLine: PtsBlockLine;
@@ -450,15 +285,17 @@ type
function GetRect: TtsRect;
- procedure PushLineItem(const aItem: PtsLineItem; const aUpdateLineWidth: Boolean = true);
+ function PushLineItem(const aItem: PtsLineItem; const aUpdateLineWidth: Boolean = true): Boolean;
procedure PushSpacing(const aWidth: Integer);
+ procedure FreeLineItem(var aItem: PtsLineItem);
procedure FreeLineItems(var aItem: PtsLineItem);
procedure FreeLines(var aItem: PtsBlockLine);
function SplitText(aText: PWideChar): PtsLineItem;
- procedure SplitIntoLines(aItem: PtsLineItem);
+ function SplitIntoLines(aItem: PtsLineItem): Boolean;
procedure TrimSpaces(const aLine: PtsBlockLine);
+ procedure UpdateLineMeta(const aLine: PtsBlockLine);
protected
property Lines: PtsBlockLine read fFirstLine;
procedure PushNewLine;
@@ -495,15 +332,16 @@ type
fContext: TtsContext;
fFormat: TtsFormat;
fSaveImages: Boolean;
- fCritSec: TCriticalSection;
+ fRenderCS: TCriticalSection;
protected
- function AddRenderRef(const aChar: TtsChar; const aCharImage: TtsImage): TtsCharRenderRef; virtual; abstract;
- procedure RemoveRenderRef(const aCharRef: TtsCharRenderRef); virtual; abstract;
+ function CreateRenderRef(const aChar: TtsChar; const aCharImage: TtsImage): TtsCharRenderRef; virtual; abstract;
+ procedure FreeRenderRef(const aCharRef: TtsCharRenderRef); virtual; abstract;
procedure BeginRender; virtual;
procedure EndRender; virtual;
procedure SetDrawPos(const X, Y: Integer); virtual; abstract;
+ function GetDrawPos: TtsPosition; virtual; abstract;
procedure MoveDrawPos(const X, Y: Integer); virtual; abstract;
procedure SetColor(const aColor: TtsColor4f); virtual; abstract;
procedure Render(const aCharRef: TtsCharRenderRef); virtual; abstract;
@@ -536,6 +374,7 @@ type
end;
EtsException = class(Exception);
+ EtsRenderer = class(EtsException);
EtsOutOfRange = class(EtsException)
public
constructor Create(const aMin, aMax, aIndex: Integer);
@@ -548,26 +387,6 @@ const
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
@@ -579,233 +398,6 @@ const
@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///////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1358,6 +950,13 @@ begin
SetData(nil);
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor TtsImage.Destroy;
+begin
+ SetData(nil);
+ inherited Destroy;
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TtsChar///////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1380,13 +979,24 @@ 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
+ if (Ord(aCharCode) > 0) then begin
+ Chars := fChars[(Ord(aCharCode) shr 8) and $FF];
+ if Assigned(Chars) then
+ result := Chars^.Chars[Ord(aCharCode) and $FF]
+ else
+ result := nil;
+ end else
result := nil;
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFont.GetCharCreate(const aCharCode: WideChar): TtsChar;
+begin
+ result := GetChar(aCharCode);
+ if not Assigned(result) then
+ result := AddChar(aCharCode);
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TtsFont.AddChar(const aCharCode: WideChar; const aChar: TtsChar);
var
@@ -1409,20 +1019,27 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsFont.AddChar(const aCharCode: WideChar);
-var
- c: TtsChar;
+constructor TtsFont.Create(const aRenderer: TtsRenderer; const aCreator: TtsFontGenerator; const aProperties: TtsFontProperties);
begin
- if not fCreateChars or (Ord(aCharCode) > 0) then
- exit;
-
- c := GetChar(aCharCode);
- if Assigned(c) then
- exit;
+ inherited Create;
+ fRenderer := aRenderer;
+ fCreator := aCreator;
+ fProperties := aProperties;
+ fCharSpacing := 0;
+ fTabWidth := 0;
+ fLineSpacing := 0.0;
+ fCreateChars := true;
+end;
- c := fCreator.GenerateChar(aCharCode, self, fRenderer);
- if Assigned(c) then
- AddChar(aCharCode, c);
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+function TtsFont.AddChar(const aCharCode: WideChar): TtsChar;
+begin
+ result := GetChar(aCharCode);
+ if not Assigned(result) and fCreateChars and (Ord(aCharCode) > 0) then begin
+ result := fCreator.GenerateChar(aCharCode, self, fRenderer);
+ if Assigned(result) then
+ AddChar(aCharCode, result);
+ end;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1462,8 +1079,8 @@ begin
end;
if Assigned(c.RenderRef) then begin
- fRenderer.RemoveRenderRef(c.RenderRef);
- c.RenderRef.Free;
+ fRenderer.FreeRenderRef(c.RenderRef);
+ c.RenderRef := nil;
end;
FreeAndNil(c);
end;
@@ -1481,10 +1098,8 @@ 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;
+ if Assigned(c.RenderRef) then
+ fRenderer.FreeRenderRef(c.RenderRef);
FreeAndNil(c);
end;
end;
@@ -1504,9 +1119,9 @@ begin
exit;
while (aText^ <> #0) do begin
- c := GetChar(aText^);
+ c := AddChar(aText^);
if not Assigned(c) then
- c := GetChar(fDefaultChar);
+ c := AddChar(fProperties.DefaultChar);
if Assigned(c) then begin
if (result > 0) then
result := result + CharSpacing;
@@ -1519,31 +1134,13 @@ end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TtsFont.GetTextMetric(out aMetric: TtsTextMetric);
begin
- aMetric.Ascent := Ascent;
- aMetric.Descent := Descent;
- aMetric.ExternalLeading := ExternalLeading;
- aMetric.BaseLineOffset := BaseLineOffset;
+ aMetric.Ascent := fProperties.Ascent;
+ aMetric.Descent := fProperties.Descent;
+ aMetric.ExternalLeading := fProperties.ExternalLeading;
+ aMetric.BaseLineOffset := fProperties.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;
+ aMetric.LineHeight := fProperties.Ascent + fProperties.Descent + fProperties.ExternalLeading;
+ aMetric.LineSpacing := Trunc(fProperties.Size * fLineSpacing);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1652,15 +1249,15 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-//TtsFontCreator//////////////////////////////////////////////////////////////////////////////////////////////////////////
+//TtsFontGenerator//////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TtsFontCreator.GetPostProcessStepCount: Integer;
+function TtsFontGenerator.GetPostProcessStepCount: Integer;
begin
result := fPostProcessSteps.Count;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TtsFontCreator.GetPostProcessStep(const aIndex: Integer): TtsPostProcessStep;
+function TtsFontGenerator.GetPostProcessStep(const aIndex: Integer): TtsPostProcessStep;
begin
if (aIndex >= 0) and (aIndex < fPostProcessSteps.Count) then
Result := TtsPostProcessStep(fPostProcessSteps[aIndex])
@@ -1669,7 +1266,7 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsFontCreator.DrawLine(const aChar: TtsChar; const aCharImage: TtsImage; aLinePosition, aLineSize: Integer);
+procedure TtsFontGenerator.DrawLine(const aChar: TtsChar; const aCharImage: TtsImage; aLinePosition, aLineSize: Integer);
var
NewSize, NewPos: TtsPosition;
YOffset, y: Integer;
@@ -1742,7 +1339,7 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsFontCreator.DoPostProcess(const aChar: TtsChar; const aCharImage: TtsImage);
+procedure TtsFontGenerator.DoPostProcess(const aChar: TtsChar; const aCharImage: TtsImage);
var
i: Integer;
step: TtsPostProcessStep;
@@ -1757,16 +1354,15 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TtsFontCreator.GenerateChar(const aCharCode: WideChar; const aFont: TtsFont; const aRenderer: TtsRenderer): TtsChar;
+function TtsFontGenerator.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 GetGlyphMetrics(aFont, aCharCode, GlyphOrigin, GlyphSize, Advance) or
not ((GlyphOrigin.x <> 0) or (GlyphOrigin.y <> 0) or (GlyphSize.x <> 0) or (GlyphSize.y <> 0) or (Advance <> 0)) then
exit;
@@ -1774,41 +1370,35 @@ begin
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
+ GetCharImage(aFont, aCharCode, CharImage);
+ end else if ([tsStyleUnderline, tsStyleStrikeout] * aFont.Properties.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;
+ result := TtsChar.Create(aCharCode);
+ try
+ result.GlyphOrigin := GlyphOrigin;
+ result.GlyphRect := tsRect(0, 0, CharImage.Width, CharImage.Height);
+ result.Advance := Advance;
+
+ if (aRenderer.SaveImages) then begin
+ try
+ if (tsStyleUnderline in aFont.Properties.Style) then
+ DrawLine(result, CharImage, aFont.Properties.UnderlinePos, aFont.Properties.UnderlineSize);
+ if (tsStyleUnderline in aFont.Properties.Style) then
+ DrawLine(result, CharImage, aFont.Properties.StrikeoutPos, aFont.Properties.StrikeoutSize);
+ except
+ CharImage.FillColor(tsColor4f(1, 0, 0, 0), COLOR_CHANNELS_RGB, IMAGE_MODES_NORMAL);
+ end;
- DoPostProcess(Char, CharImage);
+ DoPostProcess(result, 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;
+ result.RenderRef := aRenderer.CreateRenderRef(result, CharImage);
end;
-
- Char.RenderRef := aRenderer.AddRenderRef(Char, CharImage);
+ except
+ FreeAndNil(result);
end;
finally
FreeAndNil(CharImage);
@@ -1816,21 +1406,21 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TtsFontCreator.AddPostProcessStep(const aStep: TtsPostProcessStep): TtsPostProcessStep;
+function TtsFontGenerator.AddPostProcessStep(const aStep: TtsPostProcessStep): TtsPostProcessStep;
begin
result := aStep;
fPostProcessSteps.Add(aStep);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-function TtsFontCreator.InsertPostProcessStep(const aIndex: Integer; const aStep: TtsPostProcessStep): TtsPostProcessStep;
+function TtsFontGenerator.InsertPostProcessStep(const aIndex: Integer; const aStep: TtsPostProcessStep): TtsPostProcessStep;
begin
result := aStep;
fPostProcessSteps.Insert(aIndex, aStep);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsFontCreator.DeletePostProcessStep(const aIndex: Integer);
+procedure TtsFontGenerator.DeletePostProcessStep(const aIndex: Integer);
begin
if (aIndex >= 0) and (aIndex < fPostProcessSteps.Count) then
fPostProcessSteps.Delete(aIndex)
@@ -1839,20 +1429,20 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsFontCreator.ClearPostProcessSteps;
+procedure TtsFontGenerator.ClearPostProcessSteps;
begin
fPostProcessSteps.Clear;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-constructor TtsFontCreator.Create;
+constructor TtsFontGenerator.Create;
begin
inherited Create;
fPostProcessSteps := TObjectList.Create(true);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-destructor TtsFontCreator.Destroy;
+destructor TtsFontGenerator.Destroy;
begin
ClearPostProcessSteps;
FreeAndNil(fPostProcessSteps);
@@ -1871,11 +1461,16 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsTextBlock.PushLineItem(const aItem: PtsLineItem; const aUpdateLineWidth: Boolean);
+function TtsTextBlock.PushLineItem(const aItem: PtsLineItem; const aUpdateLineWidth: Boolean): Boolean;
begin
+ result := false;
if not Assigned(fLastLine) then
PushNewLine;
+ if not Assigned(fLastLine^.First) and
+ (aItem^.ItemType in [tsItemTypeSpace, tsItemTypeSpacing]) then
+ exit; // di not add line space or line spacing if line is empty
+
if Assigned(fLastLine^.Last) then begin
aItem^.Prev := fLastLine^.Last;
aItem^.Next := nil;
@@ -1890,10 +1485,11 @@ begin
case aItem^.ItemType of
tsItemTypeSpace, tsItemTypeText:
- fLastLine^.Width := fLastLine^.Width + aItem^.TextWidth;
+ fLastLine^.meta.Width := fLastLine^.meta.Width + aItem^.TextWidth;
tsItemTypeSpacing:
- fLastLine^.Width := fLastLine^.Width + aItem^.Spacing;
+ fLastLine^.meta.Width := fLastLine^.meta.Width + aItem^.Spacing;
end;
+ result := true;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -1901,6 +1497,8 @@ procedure TtsTextBlock.PushSpacing(const aWidth: Integer);
var
p: PtsLineItem;
begin
+ if (aWidth <= 0) then
+ exit;
new(p);
FillByte(p^, SizeOf(p^), 0);
p^.ItemType := tsItemTypeSpacing;
@@ -1908,6 +1506,21 @@ begin
PushLineItem(p);
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.FreeLineItem(var aItem: PtsLineItem);
+begin
+ if Assigned(aItem^.Prev) then
+ aItem^.Prev^.Next := aItem^.Next;
+ if Assigned(aItem^.Next) then
+ aItem^.Next^.Prev := aItem^.Prev;
+ case aItem^.ItemType of
+ tsItemTypeText, tsItemTypeSpace:
+ tsStrDispose(aItem^.Text);
+ end;
+ Dispose(aItem);
+ aItem := nil;
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TtsTextBlock.FreeLineItems(var aItem: PtsLineItem);
var
@@ -1915,12 +1528,8 @@ var
begin
while Assigned(aItem) do begin
p := aItem;
- case p^.ItemType of
- tsItemTypeText, tsItemTypeSpace:
- tsStrDispose(p^.Text);
- end;
- aItem := p^.Next;
- Dispose(p);
+ aItem := aItem^.Next;
+ FreeLineItem(p);
end;
end;
@@ -1931,9 +1540,9 @@ var
begin
while Assigned(aItem) do begin
p := aItem;
+ aItem := aItem^.Next;
FreeLineItems(p^.First);
- p^.Last := p^.First;
- aItem := p^.Next;
+ p^.Last := nil;
Dispose(p);
end;
end;
@@ -1945,7 +1554,6 @@ var
TextLength: Integer;
State: TtsLineItemType;
LastItem: PtsLineItem;
- c: WideChar;
procedure AddItem(const aItem: PtsLineItem);
begin
@@ -1988,12 +1596,7 @@ var
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;
+ AddItem(p);
TextBegin := aText;
end;
@@ -2020,22 +1623,13 @@ begin
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 else if (TextBegin^ <> #13) or (aText^ <> #10) or (TextBegin + 1 < aText) then
+ ExtractWord;
end;
// spaces
@@ -2045,6 +1639,13 @@ begin
State := tsItemTypeSpace;
end;
+ // tabulator
+ #$0009: begin
+ if (State <> tsItemTypeTab) then
+ ExtractWord;
+ State := tsItemTypeTab;
+ end;
+
else
if (State <> tsItemTypeText) then
ExtractWord;
@@ -2060,13 +1661,15 @@ begin
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-procedure TtsTextBlock.SplitIntoLines(aItem: PtsLineItem);
+function TtsTextBlock.SplitIntoLines(aItem: PtsLineItem): Boolean;
var
p: PtsLineItem;
begin
+ result := falsE;
if not Assigned(fCurrentFont) then
exit;
+ result := true;
while Assigned(aItem) do begin
p := aItem;
aItem := aItem^.Next;
@@ -2081,7 +1684,7 @@ begin
// increment word counter
if (p^.ItemType = tsItemTypeSpace) then begin
if not (tsLastItemIsSpace in fLastLine^.Flags) then
- inc(fLastLine^.SpaceCount, 1);
+ inc(fLastLine^.meta.SpaceCount, 1);
Include(fLastLine^.Flags, tsLastItemIsSpace);
end else
Exclude(fLastLine^.Flags, tsLastItemIsSpace);
@@ -2089,11 +1692,11 @@ begin
// update and check line width
p^.TextWidth := fCurrentFont.GetTextWidthW(p^.Text);
if (tsBlockFlagWordWrap in fFlags) and
- (fLastLine^.Width + p^.TextWidth > fWidth) then
+ (fLastLine^.meta.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
+ if (fLastLine^.meta.Width = 0) then begin
+ if not PushLineItem(p, false) then // if is first word, than add anyway
+ FreeLineItem(p);
p := nil;
end;
PushNewLine;
@@ -2101,19 +1704,25 @@ begin
// add item
if Assigned(p) then begin
- PushLineItem(p);
+ if not PushLineItem(p) then
+ FreeLineItem(p);
PushSpacing(fCurrentFont.CharSpacing);
end;
end;
tsItemTypeLineBreak: begin
- PushLineItem(p);
+ if not PushLineItem(p) then
+ FreeLineItem(p);
PushNewLine;
end;
tsItemTypeTab: begin
- PushLineItem(p);
+ if not PushLineItem(p) then
+ FreeLineItem(p);
end;
+
+ else
+ raise EtsException.Create('unexpected line item');
end;
end;
end;
@@ -2121,10 +1730,13 @@ end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TtsTextBlock.TrimSpaces(const aLine: PtsBlockLine);
- procedure Trim(p: PtsLineItem; const aMoveNext: Boolean);
+ procedure Trim(var aItem: PtsLineItem; const aMoveNext: Boolean);
var
- tmp: PtsLineItem;
+ tmp, p: PtsLineItem;
+ IsFirst: Boolean;
begin
+ IsFirst := true;
+ p := aItem;
while Assigned(p) do begin
tmp := p;
if aMoveNext then
@@ -2139,21 +1751,20 @@ procedure TtsTextBlock.TrimSpaces(const aLine: PtsBlockLine);
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
+ // update line meta
if (tmp^.ItemType = tsItemTypeSpace) then begin
- aLine^.Width := aLine^.Width - tmp^.TextWidth;
- dec(aLine^.SpaceCount, 1);
+ aLine^.meta.Width := aLine^.meta.Width - tmp^.TextWidth;
+ dec(aLine^.meta.SpaceCount, 1);
end else
- aLine^.Width := aLine^.Width - tmp^.Spacing;
+ aLine^.meta.Width := aLine^.meta.Width - tmp^.Spacing;
- Dispose(tmp);
+ FreeLineItem(tmp);
+ if IsFirst then
+ aItem := p;
end;
+
+ else
+ IsFirst := false;
end;
end;
end;
@@ -2165,6 +1776,34 @@ begin
Trim(aLine^.Last, false);
end;
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure TtsTextBlock.UpdateLineMeta(const aLine: PtsBlockLine);
+var
+ metric: TtsTextMetric;
+begin
+ if not Assigned(fCurrentFont) or
+ not Assigned(aLine) then
+ exit;
+
+ fCurrentFont.GetTextMetric(metric);
+ if (tsMetaValid in aLine^.Flags) then begin
+ aLine^.meta.Height := max(
+ aLine^.meta.Height,
+ metric.LineHeight);
+ aLine^.meta.Spacing := max(
+ aLine^.meta.Spacing,
+ metric.LineSpacing);
+ aLine^.meta.Ascent := max(
+ aLine^.meta.Ascent,
+ metric.Ascent);
+ end else begin
+ Include(aLine^.Flags, tsMetaValid);
+ aLine^.meta.Height := metric.LineHeight;
+ aLine^.meta.Spacing := metric.LineSpacing;
+ aLine^.meta.Ascent := metric.Ascent;
+ end;
+end;
+
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TtsTextBlock.PushNewLine;
var
@@ -2174,6 +1813,7 @@ begin
new(p);
FillByte(p^, SizeOf(p^), 0);
+ UpdateLineMeta(p);
if Assigned(fLastLine) then begin
fLastLine^.Next := p;
@@ -2213,25 +1853,11 @@ begin
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;
+ p^.ItemType := tsItemTypeFont;
+ p^.Font := fCurrentFont;
+ PushLineItem(p);
+ UpdateLineMeta(fLastLine);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -2256,7 +1882,7 @@ begin
result := 0;
line := fFirstLine;
while Assigned(line) do begin
- result := result + line^.Height;
+ result := result + line^.meta.Height;
line := line^.Next;
end;
end;
@@ -2280,7 +1906,8 @@ var
p: PtsLineItem;
begin
p := SplitText(aText);
- SplitIntoLines(p);
+ if not SplitIntoLines(p) then
+ FreeLineItems(p);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -2296,13 +1923,13 @@ end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TtsRenderer.BeginRender;
begin
- fCritSec.Enter;
+ fRenderCS.Enter;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TtsRenderer.EndRender;
begin
- fCritSec.Leave;
+ fRenderCS.Leave;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
@@ -2315,8 +1942,9 @@ end;
procedure TtsRenderer.EndBlock(var aBlock: TtsTextBlock);
var
c: PWideChar;
- x, y: Integer;
- ExtraWordSpaceTotal, ExtraWordSpaceCurrent: Single;
+ pos: TtsPosition;
+ x, y, tmp, tab: Integer;
+ ExtraSpaceTotal, ExtraSpaceActual: Single;
rect: TtsRect;
line: PtsBlockLine;
item: PtsLineItem;
@@ -2327,9 +1955,9 @@ var
function GetChar(const aCharCode: WideChar): TtsChar;
begin
- result := font.GetChar(aCharCode);
+ result := font.AddChar(aCharCode);
if not Assigned(result) then
- result := font.GetChar(font.DefaultChar);
+ result := font.AddChar(font.Properties.DefaultChar);
end;
procedure DrawItem;
@@ -2361,28 +1989,45 @@ var
tsItemTypeSpace: begin
if DrawText and Assigned(font) then begin
+ ExtraSpaceActual := ExtraSpaceActual + ExtraSpaceTotal;
c := item^.Text;
while (c^ <> #0) do begin
char := GetChar(c^);
if Assigned(char) then begin
- if (font.Style * [tsStyleUnderline, tsStyleStrikeout] <> []) then begin
-
+ if (font.Properties.Style * [tsStyleUnderline, tsStyleStrikeout] <> []) then begin
+ MoveDrawPos(char.GlyphOrigin.x, -metric.BaseLineOffset);
+ Render(char.RenderRef);
+ MoveDrawPos(char.Advance - char.GlyphOrigin.x + font.CharSpacing, metric.BaseLineOffset);
end else begin
-
+ MoveDrawPos(char.Advance + font.CharSpacing, 0);
end;
end;
+ inc(c);
+ end;
+
+ tmp := Trunc(ExtraSpaceActual);
+ ExtraSpaceActual := ExtraSpaceActual - tmp;
+ if (font.Properties.Style * [tsStyleUnderline, tsStyleStrikeout] <> []) then begin
+ // TODO draw lines; maybe with a temporary created fake char or something like an empty char?
end;
+ MoveDrawPos(tmp, 0);
end;
end;
tsItemTypeLineBreak: begin
+ // because this should be the last item in a line, we have nothing to do here
end;
tsItemTypeTab: begin
+ // get current x pos and round it to TabWidth
+ pos := GetDrawPos;
+ tab := font.TabWidth * font.Properties.Size;
+ pos.x := Ceil(pos.x * tab) div tab;
+ SetDrawPos(pos.x, pos.y);
end;
tsItemTypeSpacing: begin
-
+ MoveDrawPos(item^.Spacing, 0);
end;
end;
end;
@@ -2392,31 +2037,27 @@ var
// check vertical clipping
case aBlock.Clipping of
tsClipCharBorder, tsClipWordBorder:
- DrawText := (y + line^.Height > rect.Top) and (y < rect.Bottom);
+ DrawText := (y + line^.meta.Height > rect.Top) and (y < rect.Bottom);
tsClipCharComplete, tsClipWordComplete:
- DrawText := (y > rect.Top) and (y + line^.Height < rect.Bottom);
+ DrawText := (y > rect.Top) and (y + line^.meta.Height < rect.Bottom);
end;
// check horizontal alignment
x := rect.Left;
- ExtraWordSpaceTotal := 0;
+ ExtraSpaceTotal := 0;
+ ExtraSpaceActual := 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;
+ tsHorzAlignCenter:
+ x := rect.Left + (aBlock.Width div 2) - (line^.meta.Width div 2);
+ tsHorzAlignRight:
+ x := rect.Right - line^.meta.Width;
+ tsHorzAlignJustify:
+ ExtraSpaceTotal := (aBlock.Width - line^.meta.Width) / line^.meta.SpaceCount;
end;
if DrawText then
- SetDrawPos(x, y + line^.Ascent);
+ SetDrawPos(x, y + line^.meta.Ascent);
+ inc(y, line^.meta.Height + line^.meta.Spacing);
item := line^.First;
while Assigned(item) do begin
DrawItem;
@@ -2455,15 +2096,16 @@ end;
constructor TtsRenderer.Create(const aContext: TtsContext; const aFormat: TtsFormat);
begin
inherited Create;
- fContext := aContext;
- fFormat := aFormat;
- fCritSec := TCriticalSection.Create;
+ fContext := aContext;
+ fFormat := aFormat;
+ fSaveImages := true;
+ fRenderCS := TCriticalSection.Create;
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TtsRenderer.Destroy;
begin
- FreeAndNil(fCritSec);
+ FreeAndNil(fRenderCS);
inherited Destroy;
end;
diff --git a/new/utsTtfUtils.pas b/new/utsTtfUtils.pas
new file mode 100644
index 0000000..92caa59
--- /dev/null
+++ b/new/utsTtfUtils.pas
@@ -0,0 +1,323 @@
+unit utsTtfUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+const
+ NAME_ID_COPYRIGHT = 0;
+ NAME_ID_FACE_NAME = 1;
+ NAME_ID_STYLE_NAME = 2;
+ NAME_ID_FULL_NAME = 4;
+
+function MakeTTTableName(const ch1, ch2, ch3, ch4: Char): Cardinal;
+function GetTTString(pBuffer: Pointer; BufferSize: Integer; NameID, LanguageID: Cardinal; var Text: AnsiString): Boolean;
+
+function GetTTFontFullNameFromStream(Stream: TStream; LanguageID: Cardinal): AnsiString;
+function GetTTFontFullNameFromFile(Filename: AnsiString; LanguageID: Cardinal): AnsiString;
+
+implementation
+
+uses
+ utsUtils;
+
+type
+ TT_OFFSET_TABLE = packed record
+ uMajorVersion: Word;
+ uMinorVersion: Word;
+ uNumOfTables: Word;
+ uSearchRange: Word;
+ uEntrySelector: Word;
+ uRangeShift: Word;
+ end;
+
+
+ TT_TABLE_DIRECTORY = packed record
+ TableName: Cardinal; // table name
+ uCheckSum: Cardinal; // Check sum
+ uOffset: Cardinal; // Offset from beginning of file
+ uLength: Cardinal; // length of the table in bytes
+ end;
+
+
+ TT_NAME_TABLE_HEADER = packed record
+ uFSelector: Word; //format selector. Always 0
+ uNRCount: Word; //Name Records count
+ uStorageOffset: Word; //Offset for strings storage, from start of the table
+ end;
+
+ TT_NAME_RECORD = packed record
+ uPlatformID: Word;
+ uEncodingID: Word;
+ uLanguageID: Word;
+ uNameID: Word;
+ uStringLength: Word;
+ uStringOffset: Word; //from start of storage area
+ end;
+
+const
+ PLATFORM_ID_APPLE_UNICODE = 0;
+ PLATFORM_ID_MACINTOSH = 1;
+ PLATFORM_ID_MICROSOFT = 3;
+
+function SWAPWORD(x: Word): Word;
+begin
+ Result := x and $FF;
+ Result := Result shl 8;
+ Result := Result or (x shr 8);
+end;
+
+function SWAPLONG(x: Cardinal): Cardinal;
+begin
+ Result := (x and $FF) shl 24;
+ x := x shr 8;
+
+ Result := Result or ((x and $FF) shl 16);
+ x := x shr 8;
+
+ Result := Result or ((x and $FF) shl 8);
+ x := x shr 8;
+
+ Result := Result or x;
+end;
+
+function GetTTTableData(Stream: TStream; TableName: Cardinal; pBuff: Pointer; var Size: Integer): Boolean;
+var
+ Pos: Int64;
+ OffsetTable: TT_OFFSET_TABLE;
+ TableDir: TT_TABLE_DIRECTORY;
+ Idx: Integer;
+begin
+ Result := False;
+
+ Pos := Stream.Position;
+
+ // Reading table header
+ Stream.Read(OffsetTable, 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 MakeTTTableName(const ch1, ch2, ch3, ch4: Char): Cardinal;
+begin
+ Result := ord(ch4) shl 24 or ord(ch3) shl 16 or ord(ch2) shl 8 or ord(ch1);
+end;
+
+function GetTTString(pBuffer: Pointer; BufferSize: Integer; NameID, LanguageID: Cardinal; 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/new/utsTypes.pas b/new/utsTypes.pas
new file mode 100644
index 0000000..c5a8be8
--- /dev/null
+++ b/new/utsTypes.pas
@@ -0,0 +1,304 @@
+unit utsTypes;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+type
+ 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,
+ tsFormatAlpha8);
+
+ 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;
+
+ TtsFontProperties = packed record
+ Fontname: String;
+ Copyright: String;
+ FaceName: String;
+ StyleName: String;
+ FullName: String;
+
+ Size: Integer;
+ Style: TtsFontStyles;
+ AntiAliasing: TtsAntiAliasing;
+ DefaultChar: WideChar;
+
+ Ascent: Integer;
+ Descent: Integer;
+ ExternalLeading: Integer;
+ BaseLineOffset: Integer;
+
+ UnderlinePos: Integer;
+ UnderlineSize: Integer;
+ StrikeoutPos: Integer;
+ StrikeoutSize: Integer;
+ end;
+
+ TtsPosition = packed record
+ x, y: Integer;
+ end;
+ PtsPosition = ^TtsPosition;
+
+ TtsPositionF = packed record
+ x, y: Single;
+ end;
+ PtsPositionF = ^TtsPositionF;
+
+ TtsRect = packed record
+ case Byte of
+ 0: (TopLeft: TtsPosition; BottomRight: TtsPosition);
+ 1: (Left, Top, Right, Bottom: Integer);
+ end;
+ PtsRect = ^TtsRect;
+
+ TtsRectF = packed record
+ case Byte of
+ 0: (TopLeft: TtsPositionF; BottomRight: TtsPositionF);
+ 1: (Left, Top, Right, Bottom: Single);
+ end;
+ PtsRectF = ^TtsRectF;
+
+ TtsColor4f = packed record
+ case Boolean of
+ true: (r, g, b, a: Single);
+ false: (arr: array[0..3] of Single);
+ end;
+ PtsColor4f = ^TtsColor4f;
+
+ TtsColor4ub = packed record
+ case Boolean of
+ true: (r, g, b, a: Byte);
+ false: (arr: array[0..3] of Byte);
+ 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);
+
+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
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+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;
+ tsFormatAlpha8: result := 1;
+ else
+ result := 0;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure tsFormatMap(const aFormat: TtsFormat; var aData: PByte; const aColor: TtsColor4f);
+var
+ i: Integer;
+ s: Single;
+begin
+ case aFormat of
+ tsFormatRGBA8: begin
+ for i := 0 to 3 do begin
+ aData^ := Trunc($FF * 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;
+
+ tsFormatAlpha8: begin
+ 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;
+
+ tsFormatAlpha8: begin
+ aColor.r := 1.0;
+ aColor.g := 1.0;
+ aColor.b := 1.0;
+ 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;
+
+end.
+
diff --git a/new/utsUtils.pas b/new/utsUtils.pas
new file mode 100644
index 0000000..d8e98ef
--- /dev/null
+++ b/new/utsUtils.pas
@@ -0,0 +1,144 @@
+unit utsUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+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;
+
+implementation
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+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;
+
+end.
+
diff --git a/old/TextSuiteClasses.pas b/old/TextSuiteClasses.pas
index 1466cda..fb5e3ae 100644
--- a/old/TextSuiteClasses.pas
+++ b/old/TextSuiteClasses.pas
@@ -3082,7 +3082,7 @@ begin
// name
fFontname := Fontname;
- for Idx := 1 to Min(Length(Fontname), Length(LogFont.lfFaceName)) do
+ for Idx := 1 to min(Length(Fontname), Length(LogFont.lfFaceName)) do
LogFont.lfFaceName[Idx -1] := Fontname[Idx];
// char set
diff --git a/ttf/calibri.ttf b/ttf/calibri.ttf
deleted file mode 100644
index ee4771c..0000000
Binary files a/ttf/calibri.ttf and /dev/null differ
diff --git a/ttf/calibrib.ttf b/ttf/calibrib.ttf
deleted file mode 100644
index 6d2e6ce..0000000
Binary files a/ttf/calibrib.ttf and /dev/null differ
diff --git a/ttf/calibrii.ttf b/ttf/calibrii.ttf
deleted file mode 100644
index f24016a..0000000
Binary files a/ttf/calibrii.ttf and /dev/null differ
diff --git a/ttf/calibril.ttf b/ttf/calibril.ttf
deleted file mode 100644
index c8898ab..0000000
Binary files a/ttf/calibril.ttf and /dev/null differ
diff --git a/ttf/calibrili.ttf b/ttf/calibrili.ttf
deleted file mode 100644
index 25f4c51..0000000
Binary files a/ttf/calibrili.ttf and /dev/null differ
diff --git a/ttf/calibriz.ttf b/ttf/calibriz.ttf
deleted file mode 100644
index 913d2cc..0000000
Binary files a/ttf/calibriz.ttf and /dev/null differ
diff --git a/uMainForm.lfm b/uMainForm.lfm
index 99b682a..d7a022b 100644
--- a/uMainForm.lfm
+++ b/uMainForm.lfm
@@ -4,6 +4,7 @@ object MainForm: TMainForm
Top = 255
Width = 682
OnCreate = FormCreate
+ OnDestroy = FormDestroy
OnPaint = FormPaint
LCLVersion = '1.3'
object ApplicationProperties: TApplicationProperties
diff --git a/uMainForm.pas b/uMainForm.pas
index d38129d..24e8df1 100644
--- a/uMainForm.pas
+++ b/uMainForm.pas
@@ -2,27 +2,36 @@ unit uMainForm;
{$mode objfpc}{$H+}
+{.$DEFINE USE_OLD_TS}
+
interface
uses
- Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, uglcContext, TextSuite, uglcTypes, utsTextSuite;
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, uglcContext, TextSuite, uglcTypes,
+ utsTextSuite, utsTypes, utsFontCreatorGDI, utsRendererOpenGL;
type
TMainForm = class(TForm)
ApplicationProperties: TApplicationProperties;
procedure ApplicationPropertiesIdle(Sender: TObject; var Done: Boolean);
procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
+ fFrameTime: QWord;
+ fFrameCount: Integer;
+ fSecTime: QWord;
+
fContext: TglcContext;
+ {$IFDEF USE_OLD_TS}
fTextSuiteContext: tsContextID;
fFontID: tsFontID;
-
- ftsContext: TtsContext;
- ftsRenderer: TtsRenderer;
- ftsCreator: TtsFontCreator;
- ftsFont: TtsFont;
-
+ {$ELSE}
+ ftsContext: TtsContext;
+ ftsRenderer: TtsRendererOpenGL;
+ ftsGenerator: TtsFontGeneratorGDI;
+ ftsFont: TtsFont;
+ {$ENDIF}
procedure Render;
public
{ public declarations }
@@ -48,19 +57,31 @@ begin
pf := TglcContext.MakePF();
fContext := TglcContext.GetPlatformClass.Create(self, pf);
fContext.BuildContext;
-
+ {$IFDEF USE_OLD_TS}
tsInit(TS_INIT_TEXTSUITE or TS_INIT_OPENGL or TS_INIT_GDI);
tsContextCreate(@fTextSuiteContext);
tsSetParameteri(TS_RENDERER, TS_RENDERER_OPENGL);
- tsSetParameteri(TS_CREATOR, TS_CREATOR_GDI);
+ tsSetParameteri(TS_CREATOR, TS_CREATOR_GDI_FACENAME);
tsContextBind(fTextSuiteContext);
- tsFontCreateCreatorA('ttf/calibri.ttf', 24, 0, TS_ANTIALIASING_NORMAL, TS_DEFAULT, @fFontID);
+ tsFontCreateCreatorA('Calibri', 25, 0, TS_ANTIALIASING_NORMAL, TS_DEFAULT, @fFontID);
tsFontBind(fFontID);
+ {$ELSE}
+ ftsContext := TtsContext.Create;
+ ftsRenderer := TtsRendererOpenGL.Create(ftsContext, tsFormatRGBA8);
+ ftsGenerator := TtsFontGeneratorGDI.Create;
+ ftsFont := ftsGenerator.GetFontByName('Calibri', ftsRenderer, 25, [], tsAANormal);
+ ftsFont.LineSpacing := 0;
+ {$ENDIF}
+end;
- ftsContext := TtsContext.Create;
- ftsRenderer := TtsRenderer.Create(ftsContext, tsFormatRGBA8);
- ftsCreator := TtsFontCreator.Create;
- ftsFont := TtsFont.Create(ftsRenderer, ftsCreator, '', '', '', '', 12, 0, 0, [], tsAANormal);
+procedure TMainForm.FormDestroy(Sender: TObject);
+begin
+ {$IFNDEF USE_OLD_TS}
+ FreeAndNil(ftsFont);
+ FreeAndNil(ftsGenerator);
+ FreeAndNil(ftsRenderer);
+ FreeAndNil(ftsContext);
+ {$ENDIF}
end;
procedure TMainForm.FormPaint(Sender: TObject);
@@ -71,7 +92,22 @@ end;
procedure TMainForm.Render;
var
block: TtsTextBlock;
+ t: QWord;
+ dif: Integer;
begin
+ t := GetTickCount64;
+ if (fFrameTime <> 0) then begin
+ dif := t - fFrameTime;
+ inc(fFrameCount, 1);
+ inc(fSecTime, dif);
+ if (fSecTime > 1000) then begin
+ Caption := IntToStr(fFrameCount) + ' FPS';
+ fFrameCount := 0;
+ dec(fSecTime, 1000);
+ end;
+ end;
+ fFrameTime := t;
+
glViewport(0, 0, ClientWidth, ClientHeight);
glClearColor(0, 0, 0, 0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
@@ -82,23 +118,22 @@ begin
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]);
+ {$IFDEF USE_OLD_TS}
+ tsTextBeginBlock(0, 0, ClientWidth, ClientHeight, TS_ALIGN_BLOCK);
+ tsTextOutA(TEST_STRING);
+ tsTextEndBlock;
+ {$ELSE}
+ block := ftsRenderer.BeginBlock(0, 0, ClientWidth, ClientHeight, [tsBlockFlagWordWrap]);
try
block.ChangeFont(ftsFont);
- block.TextOutW('test'#13#10#13#10'test'#13#13'test'#10#10'test'#13#10#10'test'#13#13#10);
+ block.TextOutW(TEST_STRING);
finally
ftsRenderer.EndBlock(block);
end;
-
+ {$ENDIF}
fContext.SwapBuffers;
end;