From e73b884d020019c29aadf11a2c5ac8fe5b53b0dd Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 25 Oct 2008 10:11:41 +0000 Subject: font-engine added (not used atm) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1467 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 2646 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 2646 insertions(+) create mode 100644 src/base/UFont.pas (limited to 'src/base/UFont.pas') diff --git a/src/base/UFont.pas b/src/base/UFont.pas new file mode 100644 index 00000000..947a1c6f --- /dev/null +++ b/src/base/UFont.pas @@ -0,0 +1,2646 @@ +unit UFont; + +{$IFDEF FPC} + {$mode delphi}{$H+} +{$ENDIF} + +{$DEFINE HasInline} + +interface + +// Flip direction of y-axis. +// Default is a cartesian coordinate system with y-axis in upper direction +// but with USDX the y-axis is in lower direction. +{$DEFINE FLIP_YAXIS} +{$DEFINE BITMAP_FONT} + +uses + FreeType, + gl, + glext, + glu, + sdl, + {$IFDEF BITMAP_FONT} + UTexture, + {$ENDIF} + Math, + Classes, + SysUtils; + +type + + PGLubyteArray = ^TGLubyteArray; + TGLubyteArray = array[0 .. (MaxInt div SizeOf(GLubyte))-1] of GLubyte; + TGLubyteDynArray = array of GLubyte; + + TWideStringArray = array of WideString; + + TGLColor = packed record + case byte of + 0: ( vals: array[0..3] of GLfloat; ); + 1: ( r, g, b, a: GLfloat; ); + end; + + TBoundsDbl = record + Left, Right: double; + Bottom, Top: double; + end; + + TPositionDbl = record + X, Y: double; + end; + + TTextureSize = record + Width, Height: integer; + end; + + TBitmapCoords = record + Left, Top: double; + Width, Height: integer; + end; + + {** + * Abstract base class representing a glyph. + *} + TGlyph = class + protected + function GetAdvance(): TPositionDbl; virtual; abstract; + function GetBounds(): TBoundsDbl; virtual; abstract; + public + procedure Render(UseDisplayLists: boolean); virtual; abstract; + procedure RenderReflection(); virtual; abstract; + + {** Distance to next glyph (in pixels) *} + property Advance: TPositionDbl read GetAdvance; + {** Glyph bounding box (in pixels) *} + property Bounds: TBoundsDbl read GetBounds; + end; + + {** + * Font styles used by TFont.Style + *} + TFontStyle = set of (Italic, Underline, Reflect); + + {** + * Base font class. + *} + TFont = class + private + {** Non-virtual reset-method used in Create() and Reset() } + procedure ResetIntern(); + + protected + fStyle: TFontStyle; + fUseKerning: boolean; + fLineSpacing: single; // must be inited by subclass + fReflectionSpacing: single; // must be inited by subclass to -2*Descender + fGlyphSpacing: single; + fReflectionPass: boolean; + + {** + * Splits lines in Text seperated by newline (char-code #13). + * @param Text UTF-8 encoded string + * @param Lines splitted WideString lines + *} + procedure SplitLines(const Text: UTF8String; var Lines: TWideStringArray); + + {** + * Print an array of WideStrings. Each array-item is a line of text. + * Lines of text are seperated by the line-spacing. + * This is the base function for all text drawing. + *} + procedure Print(const Text: TWideStringArray); overload; virtual; + + {** + * Draws an underline. + *} + procedure DrawUnderline(const Text: WideString); virtual; + + {** + * Renders (one) line of text. + *} + procedure Render(const Text: WideString); virtual; abstract; + + {** + * Returns the bounds of text-lines contained in Text. + * @param(Advance if true the right bound is set to the advance instead + * of the minimal right bound.) + *} + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract; + + {** + * Resets all user settings to default values. + * Override methods should always call the inherited version. + *} + procedure Reset(); virtual; + + function GetHeight(): single; virtual; abstract; + function GetAscender(): single; virtual; abstract; + function GetDescender(): single; virtual; abstract; + procedure SetLineSpacing(Spacing: single); virtual; + function GetLineSpacing(): single; virtual; + procedure SetGlyphSpacing(Spacing: single); virtual; + function GetGlyphSpacing(): single; virtual; + procedure SetReflectionSpacing(Spacing: single); virtual; + function GetReflectionSpacing(): single; virtual; + procedure SetStyle(Style: TFontStyle); virtual; + function GetStyle(): TFontStyle; virtual; + function GetUnderlinePosition(): single; virtual; abstract; + function GetUnderlineThickness(): single; virtual; abstract; + procedure SetUseKerning(Enable: boolean); virtual; + function GetUseKerning(): boolean; virtual; + procedure SetReflectionPass(Enable: boolean); virtual; + + {** Returns true if the current render-pass is used to draw the reflection } + property ReflectionPass: boolean read fReflectionPass write SetReflectionPass; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Prints a text. + *} + procedure Print(const Text: WideString); overload; + {** UTF-8 version of @link(Print) } + procedure Print(const Text: string); overload; + + {** + * Calculates the bounding box (width and height) around Text. + * Works with Italic and Underline styles but reflections created + * with the Reflect style are not considered. + * Note that the width might differ due to kerning with appended text, + * e.g. Width('VA') <= Width('V') + Width('A'). + * @param Advance if set to true, Result.Right is set to the advance of + * the given text rather than the min. right border. The advance width is + * bigger than the text's width as it additionally contains the advance + * and glyph-spacing of the last character. + *} + function BBox(const Text: WideString; Advance: boolean = false): TBoundsDbl; overload; + {** UTF-8 version of @link(BBox) } + function BBox(const Text: UTF8String; Advance: boolean = false): TBoundsDbl; overload; + + {** Font height } + property Height: single read GetHeight; + {** Vertical distance from baseline to top of glyph } + property Ascender: single read GetAscender; + {** Vertical distance from baseline to bottom of glyph } + property Descender: single read GetDescender; + {** Vertical distance between two baselines } + property LineSpacing: single read GetLineSpacing write SetLineSpacing; + {** Space between end and start of next glyph added to the advance width } + property GlyphSpacing: single read GetGlyphSpacing write SetGlyphSpacing; + {** Distance between normal baseline and baseline of the reflection } + property ReflectionSpacing: single read GetReflectionSpacing write SetReflectionSpacing; + {** Font style (italic/underline/...) } + property Style: TFontStyle read GetStyle write SetStyle; + {** If set to true (default) kerning will be used if available } + property UseKerning: boolean read GetUseKerning write SetUseKerning; + end; + +const + //** Max. number of mipmap levels that a TScalableFont can contain + cMaxMipmapLevel = 5; + +type + {** + * Wrapper around TFont to allow font size changes. + * The font is scaled to the requested size by a modelview matrix + * transformation (glScale) and not by rescaling the internal bitmap + * representation. This way changing the size is really fast but the result + * may lack quality on large or small scale factors. + *} + TScalableFont = class(TFont) + private + procedure ResetIntern(); + + protected + fScale: single; //**< current height to base-font height ratio + fAspect: single; //**< width to height aspect + fBaseFont: TFont; //**< shortcut for fMipmapFonts[0] + fUseMipmaps: boolean; //**< true if mipmap fonts are generated + /// Mipmap fonts (size[level+1] = size[level]/2) + fMipmapFonts: array[0..cMaxMipmapLevel] of TFont; + + procedure Render(const Text: WideString); override; + procedure Print(const Text: TWideStringArray); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + {** + * Callback called for creation of each mipmap font. + * Must be defined by the subclass. + * Mipmaps created by this method are managed and freed by TScalableFont. + *} + function CreateMipmap(Level: integer; Scale: single): TFont; virtual; abstract; + + {** + * Returns the mipmap level considering the current scale and projection + * matrix. + *} + function GetMipmapLevel(): integer; + + {** + * Returns the scale applied to the given mipmap font. + * fScale * fBaseFont.Height / fMipmapFont[Level].Height + *} + function GetMipmapScale(Level: integer): single; + + {** + * Chooses the mipmap that looks nicest with current scale and projection + * matrix. + *} + function ChooseMipmapFont(): TFont; + + procedure SetHeight(Height: single); virtual; + function GetHeight(): single; override; + procedure SetAspect(Aspect: single); virtual; + function GetAspect(): single; virtual; + function GetAscender(): single; override; + function GetDescender(): single; override; + procedure SetLineSpacing(Spacing: single); override; + function GetLineSpacing(): single; override; + procedure SetGlyphSpacing(Spacing: single); override; + function GetGlyphSpacing(): single; override; + procedure SetReflectionSpacing(Spacing: single); override; + function GetReflectionSpacing(): single; override; + procedure SetStyle(Style: TFontStyle); override; + function GetStyle(): TFontStyle; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + procedure SetUseKerning(Enable: boolean); override; + + public + {** + * Creates a wrapper to make the base-font Font scalable. + * If UseMipmaps is set to true smaller fonts are created so that a + * resized (Height property changed) font looks nicer. + * The font passed is managed and freed by TScalableFont. + *} + constructor Create(Font: TFont; UseMipmaps: boolean); overload; + + {** + * Frees memory. The fonts passed on Create() and mipmap creation + * are freed too. + *} + destructor Destroy(); override; + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Font height } + property Height: single read GetHeight write SetHeight; + {** Factor for font stretching (NewWidth = Width*Aspect), 1.0 by default } + property Aspect: single read GetAspect write SetAspect; + end; + + {** + * Table for storage of max. 256 glyphs. + * Used for the second cache level. Indexed by the LSB of the WideChar + * char-code. + *} + PGlyphTable = ^TGlyphTable; + TGlyphTable = array[0..255] of TGlyph; + + {** + * Cache for glyphs of a single font. + * The cached glyphs are stored inside a hash-list. + * Hashing is performed in two steps: + * 1. the least significant byte (LSB) of the WideChar character code + * is removed (shr 8) and the result (we call it BaseCode here) looked up in + * the hash-list. + * 2. Each entry of the hash-list contains a table with max. 256 entries. + * The LSB of the char-code of a glyph is the table-offset of that glyph. + *} + TGlyphCache = class + private + fHash: TList; + + {** + * Finds a glyph-table storing cached glyphs with base-code BaseCode + * (= upper char-code bytes) in the hash-list and returns the table and + * its index. + * @param(InsertPos the position of the tyble in the list if it was found, + * otherwise the position the table should be inserted) + *} + function FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Add glyph Glyph with char-code ch to the cache. + * @returns @true on success, @false otherwise + *} + function AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; + + {** + * Removes the glyph with char-code ch from the cache. + *} + procedure DeleteGlyph(ch: WideChar); + + {** + * Removes the glyph with char-code ch from the cache. + *} + function GetGlyph(ch: WideChar): TGlyph; + + {** + * Checks if a glyph with char-code ch is cached. + *} + function HasGlyph(ch: WideChar): boolean; + + {** + * Remove and free all cached glyphs. If KeepBaseSet is set to + * true, cached characters in the range 0..255 will not be flushed. + *} + procedure FlushCache(KeepBaseSet: boolean); + end; + + {** + * Entry of a glyph-cache's (TGlyphCache) hash. + * Stores a BaseCode (upper-bytes of a glyph's char-code) and a table + * with all glyphs cached at the moment with that BaseCode. + *} + TGlyphCacheHashEntry = class + private + fBaseCode: cardinal; + public + GlyphTable: TGlyphTable; + + constructor Create(BaseCode: cardinal); + + {** Base-code (upper-bytes) of the glyphs stored in this entry's table } + property BaseCode: cardinal read fBaseCode; + end; + + TCachedFont = class(TFont) + protected + fCache: TGlyphCache; + + {** + * Retrieves a cached glyph with char-code ch from cache. + * If the glyph is not already cached, it is loaded with LoadGlyph(). + *} + function GetGlyph(ch: WideChar): TGlyph; + + {** + * Callback to create (load) a glyph with char-code ch. + * Implemented by subclasses. + *} + function LoadGlyph(ch: WideChar): TGlyph; virtual; abstract; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Remove and free all cached glyphs. If KeepBaseSet is set to + * true, the base glyphs are not be flushed. + * @seealso TGlyphCache.FlushCache + *} + procedure FlushCache(KeepBaseSet: boolean); + end; + + TFTFont = class; + + {** + * Freetype glyph. + * Each glyph stores a texture with the glyph's image. + *} + TFTGlyph = class(TGlyph) + private + fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code) + fDisplayList: GLuint; //**< Display-list ID + fTexture: GLuint; //**< Texture ID + fBitmapCoords: TBitmapCoords; //**< Left/Top offset and Width/Height of the bitmap (in pixels) + fTexOffset: TPositionDbl; //**< Right and bottom texture offset for removal of power-of-2 padding + fTexSize: TTextureSize; //**< Texture size in pixels + + fFont: TFTFont; //**< Font associated with this glyph + fAdvance: TPositionDbl; //**< Advance width of this glyph + fBounds: TBoundsDbl; //**< Glyph bounds + fOutset: single; //**< Extrusion outset + + {** + * Extrudes the outline of a glyph's bitmap stored in TexBuffer with size + * fTexSize by Outset pixels. + * This is useful to create bold or outlined fonts. + * TexBuffer must be 2*Ceil(Outset) pixels higher and wider than the + * original glyph bitmap, otherwise the glyph borders cannot be extruded + * correctly. + * The bitmap must be 2* pixels wider and higher than the + * original glyph's bitmap with the latter centered in it. + *} + procedure Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); + + {** + * Creates an OpenGL texture (and display list) for the glyph. + * The glyph's and bitmap's metrics are set correspondingly. + * @param LoadFlags flags passed to FT_Load_Glyph() + * @raises Exception if the glyph could not be initialized + *} + procedure CreateTexture(LoadFlags: FT_Int32); + + protected + function GetAdvance(): TPositionDbl; override; + function GetBounds(): TBoundsDbl; override; + + public + {** + * Creates a glyph with char-code ch from font Font. + * @param LoadFlags flags passed to FT_Load_Glyph() + *} + constructor Create(Font: TFTFont; ch: WideChar; Outset: single; + LoadFlags: FT_Int32); + destructor Destroy(); override; + + {** Renders the glyph (normal render pass) } + procedure Render(UseDisplayLists: boolean); override; + {** Renders the glyph's reflection } + procedure RenderReflection(); override; + + {** Freetype specific char-index (<> char-code) } + property CharIndex: FT_UInt read fCharIndex; + end; + + {** + * Freetype font class. + *} + TFTFont = class(TCachedFont) + private + procedure ResetIntern(); + + protected + fFilename: string; //**< filename of the font-file + fSize: integer; //**< Font base size (in pixels) + fOutset: single; //**< size of outset extrusion (in pixels) + fFace: FT_Face; //**< Holds the height of the font + fLoadFlags: FT_Int32; //**< FT glpyh load-flags + fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio + fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing + + {** @seealso TCachedFont.LoadGlyph } + function LoadGlyph(ch: WideChar): TGlyph; override; + + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + + property Face: FT_Face read fFace; + + public + {** + * Creates a font of size Size (in pixels) from the file Filename. + * If Outset (in pixels) is set to a value > 0 the glyphs will be extruded + * at their borders. Use it for e.g. a bold effect. + * @param LoadFlags flags passed to FT_Load_Glyph() + * @raises Exception if the font-file could not be loaded + *} + constructor Create(const Filename: string; + Size: integer; Outset: single = 0.0; + LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); + + {** + * Frees all resources associated with the font. + *} + destructor Destroy(); override; + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Size of the base font } + property Size: integer read fSize; + {** Outset size } + property Outset: single read fOutset; + end; + + TFTScalableFont = class(TScalableFont) + protected + function GetOutset(): single; virtual; + function CreateMipmap(Level: integer; Scale: single): TFont; override; + + public + {** + * Creates a scalable font of size Size (in pixels) from the file Filename. + * OutsetAmount is the ratio of the glyph extrusion. + * The extrusion in pixels is Size*OutsetAmount + * (0.0 -> no extrusion, 0.1 -> 10%). + *} + constructor Create(const Filename: string; + Size: integer; OutsetAmount: single = 0.0; + UseMipmaps: boolean = true); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** Outset size (in pixels) of the scaled font } + property Outset: single read GetOutset; + end; + + + {** + * Represents a freetype font with an additional outline around its glyphs. + * The outline size is passed on creation and cannot be changed later. + *} + TFTOutlineFont = class(TFont) + private + fFilename: string; + fSize: integer; + fOutset: single; + fInnerFont, fOutlineFont: TFTFont; + fOutlineColor: TGLColor; + + procedure ResetIntern(); + + protected + procedure DrawUnderline(const Text: WideString); override; + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + procedure SetLineSpacing(Spacing: single); override; + procedure SetGlyphSpacing(Spacing: single); override; + procedure SetReflectionSpacing(Spacing: single); override; + procedure SetStyle(Style: TFontStyle); override; + function GetStyle(): TFontStyle; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + procedure SetUseKerning(Enable: boolean); override; + procedure SetReflectionPass(Enable: boolean); override; + + public + constructor Create(const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); + destructor Destroy; override; + + {** Sets the color of the outline } + procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = 1.0); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Size of the base font } + property Size: integer read fSize; + {** Outset size } + property Outset: single read fOutset; + end; + + {** + * Wrapper around TOutlineFont to allow font resizing. + * @seealso TScalableFont + *} + TFTScalableOutlineFont = class(TScalableFont) + protected + function GetOutset(): single; virtual; + function CreateMipmap(Level: integer; Scale: single): TFont; override; + + public + constructor Create(const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean = true); + + {** Sets the color of the outline } + procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = 1.0); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** Outset size } + property Outset: single read GetOutset; + end; + +{$IFDEF BITMAP_FONT} + + {** + * A bitmapped font loads it's glyphs from a bitmap and stores them in a + * texture. Unicode characters are not supported (but could be by supporting + * multiple textures each storing a subset of unicode glyphs). + * For backward compatibility only. + *} + TBitmapFont = class(TFont) + private + fTex: TTexture; + fTexSize: integer; + fBaseline: integer; + fAscender: integer; + fDescender: integer; + fWidths: array[0..255] of byte; //**< half widths + fOutline: integer; + fTempColor: TGLColor; //**< colours for the reflection + + procedure ResetIntern(); + + procedure RenderChar(ch: WideChar; var AdvanceX: real); + + {** + * Load font widths from an info file. + * @param InfoFile the name of the info (.dat) file + * @raises Exception if the file is corrupted + *} + procedure LoadFontInfo(const InfoFile: string); + + protected + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + + public + {** + * Creates a bitmapped font from image Filename and font width info + * loaded from the corresponding file with ending .dat. + * @param(Baseline y-coord of the baseline given in cartesian coords + * (y-axis up) and from the lower edge of the glyphs bounding box) + * @param(Ascender pixels from baseline to top of highest glyph) + *} + constructor Create(const Filename: string; Outline: integer; + Baseline, Ascender, Descender: integer); + destructor Destroy(); override; + + {** + * Corrects font widths provided by the info file. + * NewWidth := Width * WidthMult + WidthAdd + *} + procedure CorrectWidths(WidthMult: real; WidthAdd: integer); + + {** @seealso TFont.Reset } + procedure Reset(); override; + end; + +{$ENDIF BITMAP_FONT} + + TFreeType = class + public + {** + * Returns a pointer to the freetype library singleton. + * If non exists, freetype will be initialized. + * @raises Exception if initialization failed + *} + class function GetLibrary(): FT_Library; + class procedure FreeLibrary(); + end; + + +implementation + +uses Types; + +const + //** shear factor used for the italic effect (bigger value -> more bending) + cShearFactor = 0.25; + cShearMatrix: array[0..15] of GLfloat = ( + 1, 0, 0, 0, + cShearFactor, 1, 0, 0, + 0, 0, 1, 0, + 0, 0, 0, 1 + ); + cShearMatrixInv: array[0..15] of GLfloat = ( + 1, 0, 0, 0, + -cShearFactor, 1, 0, 0, + 0, 0, 1, 0, + 0, 0, 0, 1 + ); + +var + LibraryInst: FT_Library; + +function NewGLColor(r, g, b, a: GLfloat): TGLColor; +begin + Result.r := r; + Result.g := g; + Result.b := b; + Result.a := a; +end; + +{** + * Returns the first power of 2 >= Value. + *} +function NextPowerOf2(Value: integer): integer; {$IFDEF HasInline}inline;{$ENDIF} +begin + Result := 1; + while (Result < Value) do + Result := Result shl 1; +end; + + +{* + * TFont + *} + +constructor TFont.Create(); +begin + inherited; + ResetIntern(); +end; + +destructor TFont.Destroy(); +begin + inherited; +end; + +procedure TFont.ResetIntern(); +begin + fStyle := []; + fUseKerning := true; + fGlyphSpacing := 0.0; + fReflectionPass := false; + + // must be set by subclasses + fLineSpacing := 0.0; + fReflectionSpacing := 0.0; +end; + +procedure TFont.Reset(); +begin + ResetIntern(); +end; + +procedure TFont.SplitLines(const Text: UTF8String; var Lines: TWideStringArray); +var + LineList: TStringList; + LineIndex: integer; +begin + // split lines on newline (there is no WideString version of ExtractStrings) + LineList := TStringList.Create(); + ExtractStrings([#13], [], PChar(Text), LineList); + + // create an array of WideStrins from the UTF-8 string-list + SetLength(Lines, LineList.Count); + for LineIndex := 0 to LineList.Count-1 do + Lines[LineIndex] := UTF8Decode(LineList[LineIndex]); + LineList.Free(); +end; + +function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl; +var + LineArray: TWideStringArray; +begin + SplitLines(Text, LineArray); + Result := BBox(LineArray, Advance); + SetLength(LineArray, 0); +end; + +function TFont.BBox(const Text: WideString; Advance: boolean): TBoundsDbl; +begin + Result := BBox(UTF8Encode(Text), Advance); +end; + +procedure TFont.Print(const Text: TWideStringArray); +var + LineIndex: integer; +begin + // recursively call this function to draw reflected text + if ((Reflect in Style) and not ReflectionPass) then + begin + ReflectionPass := true; + Print(Text); + ReflectionPass := false; + end; + + // store current color, enable-flags, matrix-mode + glPushAttrib(GL_CURRENT_BIT or GL_ENABLE_BIT or GL_TRANSFORM_BIT); + + // set OpenGL state + glMatrixMode(GL_MODELVIEW); + glDisable(GL_DEPTH_TEST); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + { + // TODO: just draw texels with alpha > 0 to avoid setting z-buffer for them? + glAlphaFunc(GL_GREATER, 0); + glEnable(GL_ALPHA_TEST); + + //TODO: Do we need depth-testing? + if (ReflectionPass) then + begin + glDepthMask(0); + glEnable(GL_DEPTH_TEST); + end; + } + + {$IFDEF FLIP_YAXIS} + glPushMatrix(); + glScalef(1, -1, 1); + {$ENDIF} + + // display text + for LineIndex := 0 to High(Text) do + begin + glPushMatrix(); + + // move to baseline + glTranslatef(0, -LineSpacing*LineIndex, 0); + + if ((Underline in Style) and not ReflectionPass) then + begin + glDisable(GL_TEXTURE_2D); + DrawUnderline(Text[LineIndex]); + glEnable(GL_TEXTURE_2D); + end; + + // draw reflection + if (ReflectionPass) then + begin + // set reflection spacing + glTranslatef(0, -ReflectionSpacing, 0); + // flip y-axis + glScalef(1, -1, 1); + end; + + // shear for italic effect + if (Italic in Style) then + glMultMatrixf(@cShearMatrix); + + // render text line + Render(Text[LineIndex]); + + glPopMatrix(); + end; + + // restore settings + {$IFDEF FLIP_YAXIS} + glPopMatrix(); + {$ENDIF} + glPopAttrib(); +end; + +procedure TFont.Print(const Text: string); +var + LineArray: TWideStringArray; +begin + SplitLines(Text, LineArray); + Print(LineArray); + SetLength(LineArray, 0); +end; + +procedure TFont.Print(const Text: WideString); +begin + Print(UTF8Encode(Text)); +end; + +procedure TFont.DrawUnderline(const Text: WideString); +var + UnderlineY1, UnderlineY2: single; + Bounds: TBoundsDbl; +begin + UnderlineY1 := GetUnderlinePosition(); + UnderlineY2 := UnderlineY1 + GetUnderlineThickness(); + Bounds := BBox(Text); + glRectf(Bounds.Left, UnderlineY1, Bounds.Right, UnderlineY2); +end; + +procedure TFont.SetStyle(Style: TFontStyle); +begin + fStyle := Style; +end; + +function TFont.GetStyle(): TFontStyle; +begin + Result := fStyle; +end; + +procedure TFont.SetLineSpacing(Spacing: single); +begin + fLineSpacing := Spacing; +end; + +function TFont.GetLineSpacing(): single; +begin + Result := fLineSpacing; +end; + +procedure TFont.SetGlyphSpacing(Spacing: single); +begin + fGlyphSpacing := Spacing; +end; + +function TFont.GetGlyphSpacing(): single; +begin + Result := fGlyphSpacing; +end; + +procedure TFont.SetReflectionSpacing(Spacing: single); +begin + fReflectionSpacing := Spacing; +end; + +function TFont.GetReflectionSpacing(): single; +begin + Result := fReflectionSpacing; +end; + +procedure TFont.SetUseKerning(Enable: boolean); +begin + fUseKerning := Enable; +end; + +function TFont.GetUseKerning(): boolean; +begin + Result := fUseKerning; +end; + +procedure TFont.SetReflectionPass(Enable: boolean); +begin + fReflectionPass := Enable; +end; + + +{* + * TScalableFont + *} + +constructor TScalableFont.Create(Font: TFont; UseMipmaps: boolean); +var + MipmapLevel: integer; +begin + inherited Create(); + + fBaseFont := Font; + fMipmapFonts[0] := Font; + fUseMipmaps := UseMipmaps; + ResetIntern(); + + // create mipmap fonts if requested + if (UseMipmaps) then + begin + for MipmapLevel := 1 to cMaxMipmapLevel do + begin + fMipmapFonts[MipmapLevel] := CreateMipmap(MipmapLevel, 1/(1 shl MipmapLevel)); + // stop if no smaller mipmap font is returned + if (fMipmapFonts[MipmapLevel] = nil) then + Break; + end; + end; +end; + +destructor TScalableFont.Destroy(); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + fMipmapFonts[Level].Free; + inherited; +end; + +procedure TScalableFont.ResetIntern(); +begin + fScale := 1.0; + fAspect := 1.0; +end; + +procedure TScalableFont.Reset(); +var + Level: integer; +begin + inherited; + ResetIntern(); + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].Reset(); +end; + +{** + * Returns the mipmap level to use with regard to the current projection + * and modelview matrix, font scale and aspect. + * + * Note: + * - for Freetype fonts, hinting and grid-fitting must be disabled, otherwise + * the glyph widths/heights ratios and advance widths of the mipmap fonts + * do not match as they are adjusted sligthly (e.g. an 'a' at size 12px has + * width 12px, but at size 6px width 8px). + * - returned mipmap-level is used for all glyphs of the current text to print. + * This is faster, much easier to handle, since we just need to create + * multiple sized fonts and select the one we need for the mipmap-level and + * it avoids that neighbored glyphs use different mipmap-level which might + * look odd because one glyph might look blurry and the other sharp. + * + * Motivation: + * We do not use OpenGL for mipmapping as the results are very bad. At least + * with automatic mipmap generation (gluBuildMipmaps) the fonts look rather + * blurry. + * Defining our own mipmaps by creating multiple textures with + * for different mimap levels is a pain, as the font size passed to freetype + * is not the size of the bitmaps created and it does not guarantee that a + * glyph bitmap of a font with font-size s/2 is half the size of the font with + * font-size s. If the bitmap size is just a single pixel bigger than the half + * we might need a texture of the next power-of-2 and the texture would not be + * half of the size of the next bigger mipmap. In addition we use a fixed one + * pixel sized border to smooth the texture (see cTexSmoothBorder) and maybe + * an outset that is added to the font, so creating a glyph mipmap that is + * exactly half the size of the next bigger one is a very difficult task. + * + * Solution: + * Use mipmap textures that are not exactly half the size of the next mipmap + * level. OpenGL does not support this (at least not without extensions). + * The trickiest task is to determine the mipmap to use by calculating the + * amount of minification that is performed in this function. + *} +function TScalableFont.GetMipmapLevel(): integer; +var + ModelMatrix, ProjMatrix: T16dArray; + WinCoords: array[0..2, 0..2] of GLdouble; + ViewPortArray: TViewPortArray; + Dist, Dist2: double; + WidthScale, HeightScale: double; +const + // width/height of square used for determining the scale + cTestSize = 10.0; + // an offset to the mipmap-level to adjust the change-over of two consecutive + // mipmap levels. If for example the bias is 0.1 and unbiased level is 1.9 + // the result level will be 2. A bias of 0.5 is equal to rounding. + // With bias=0.1 we prefer larger mipmaps over smaller ones. + cBias = 0.2; +begin + // 1. retrieve current transformation matrices for gluProject + glGetDoublev(GL_MODELVIEW_MATRIX, @ModelMatrix); + glGetDoublev(GL_PROJECTION_MATRIX, @ProjMatrix); + glGetIntegerv(GL_VIEWPORT, @ViewPortArray); + + // 2. project three of the corner points of a square with size cTestSize + // to window coordinates (the square is just a dummy for a glyph) + + // project point (x1, y1) to window corrdinates + gluProject(0, 0, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[0][0], @WinCoords[0][1], @WinCoords[0][2]); + // project point (x2, y1) to window corrdinates + gluProject(cTestSize, 0, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[1][0], @WinCoords[1][1], @WinCoords[1][2]); + // project point (x1, y2) to window corrdinates + gluProject(0, cTestSize, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[2][0], @WinCoords[2][1], @WinCoords[2][2]); + + // 3. Lets see how much the width and height of the square changed. + // Calculate the width and height as displayed on the screen in window + // coordinates and calculate the ratio to the original coordinates in + // modelview space so the ratio gives us the scale (minification here). + + // projected width ||(x1, y1) - (x2, y1)|| + Dist := (WinCoords[0][0] - WinCoords[1][0]); + Dist2 := (WinCoords[0][1] - WinCoords[1][1]); + WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + // projected height ||(x1, y1) - (x1, y2)|| + Dist := (WinCoords[0][0] - WinCoords[2][0]); + Dist2 := (WinCoords[0][1] - WinCoords[2][1]); + HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + //writeln(Format('Scale %f, %f', [WidthScale, HeightScale])); + + // 4. Now that we have got the scale, take the bigger minification scale + // and get it to a logarithmic scale as each mipmap is 1/2 the size of its + // predecessor (Mipmap_size[i] = Mipmap_size[i-1]/2). + // The result is our mipmap-level = the index of the mipmap to use. + + // Level > 0: Minification; < 0: Magnification + Result := Trunc(Log2(Max(WidthScale, HeightScale)) + cBias); + + // clamp to valid range + if (Result < 0) then + Result := 0; + if (Result > High(fMipmapFonts)) then + Result := High(fMipmapFonts); +end; + +function TScalableFont.GetMipmapScale(Level: integer): single; +begin + if (fMipmapFonts[Level] = nil) then + begin + Result := -1; + Exit; + end; + + Result := fScale * fMipmapFonts[0].Height / fMipmapFonts[Level].Height; +end; + +{** + * Returns the correct mipmap font for the current scale and projection + * matrix. The modelview scale is adjusted to the mipmap level, so + * Result.Print() will display the font in the correct size. + *} +function TScalableFont.ChooseMipmapFont(): TFont; +var + DesiredLevel: integer; + Level: integer; + MipmapScale: single; +begin + Result := nil; + DesiredLevel := GetMipmapLevel(); + + // get the smallest mipmap available for the desired level + // as not all levels must be assigned to a font. + for Level := DesiredLevel downto 0 do + begin + if (fMipmapFonts[Level] <> nil) then + begin + Result := fMipmapFonts[Level]; + Break; + end; + end; + + // since the mipmap font (if level > 0) is smaller than the base-font + // we have to scale to get its size right. + MipmapScale := fMipmapFonts[0].Height/Result.Height; + glScalef(MipmapScale, MipmapScale, 0); +end; + +procedure TScalableFont.Print(const Text: TWideStringArray); +begin + glPushMatrix(); + + // set scale and stretching + glScalef(fScale * fAspect, fScale, 0); + + // print text + if (fUseMipmaps) then + ChooseMipmapFont().Print(Text) + else + fBaseFont.Print(Text); + + glPopMatrix(); +end; + +procedure TScalableFont.Render(const Text: WideString); +begin + Assert(false, 'Unused TScalableFont.Render() was called'); +end; + +function TScalableFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +begin + Result := fBaseFont.BBox(Text, Advance); + Result.Left := Result.Left * fScale * fAspect; + Result.Right := Result.Right * fScale * fAspect; + Result.Top := Result.Top * fScale; + Result.Bottom := Result.Bottom * fScale; +end; + +procedure TScalableFont.SetHeight(Height: single); +begin + fScale := Height / fBaseFont.GetHeight(); +end; + +function TScalableFont.GetHeight(): single; +begin + Result := fBaseFont.GetHeight() * fScale; +end; + +procedure TScalableFont.SetAspect(Aspect: single); +begin + fAspect := Aspect; +end; + +function TScalableFont.GetAspect(): single; +begin + Result := fAspect; +end; + +function TScalableFont.GetAscender(): single; +begin + Result := fBaseFont.GetAscender() * fScale; +end; + +function TScalableFont.GetDescender(): single; +begin + Result := fBaseFont.GetDescender() * fScale; +end; + +procedure TScalableFont.SetLineSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetLineSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetLineSpacing(): single; +begin + Result := fBaseFont.GetLineSpacing() * fScale; +end; + +procedure TScalableFont.SetGlyphSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetGlyphSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetGlyphSpacing(): single; +begin + Result := fBaseFont.GetGlyphSpacing() * fScale; +end; + +procedure TScalableFont.SetReflectionSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetReflectionSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetReflectionSpacing(): single; +begin + Result := fBaseFont.GetLineSpacing() * fScale; +end; + +procedure TScalableFont.SetStyle(Style: TFontStyle); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetStyle(Style); +end; + +function TScalableFont.GetStyle(): TFontStyle; +begin + Result := fBaseFont.GetStyle(); +end; + +function TScalableFont.GetUnderlinePosition(): single; +begin + Result := fBaseFont.GetUnderlinePosition(); +end; + +function TScalableFont.GetUnderlineThickness(): single; +begin + Result := fBaseFont.GetUnderlinePosition(); +end; + +procedure TScalableFont.SetUseKerning(Enable: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetUseKerning(Enable); +end; + + +{* + * TCachedFont + *} + +constructor TCachedFont.Create(); +begin + inherited; + fCache := TGlyphCache.Create(); +end; + +destructor TCachedFont.Destroy(); +begin + fCache.Free; + inherited; +end; + +function TCachedFont.GetGlyph(ch: WideChar): TGlyph; +begin + Result := fCache.GetGlyph(ch); + if (Result = nil) then + begin + Result := LoadGlyph(ch); + if (not fCache.AddGlyph(ch, Result)) then + Result.Free; + end; +end; + +procedure TCachedFont.FlushCache(KeepBaseSet: boolean); +begin + fCache.FlushCache(KeepBaseSet); +end; + + +{* + * TFTFont + *} + +constructor TFTFont.Create( + const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32); +var + i: WideChar; +begin + inherited Create(); + + fFilename := Filename; + fSize := Size; + fOutset := Outset; + fLoadFlags := LoadFlags; + fUseDisplayLists := true; + + // load font information + if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename), 0, fFace) <> 0) then + raise Exception.Create('FT_New_Face: Could not load font ''' + Filename + ''''); + + // support scalable fonts only + if (not FT_IS_SCALABLE(fFace)) then + raise Exception.Create('Font is not scalable'); + + if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then + raise Exception.Create('FT_Set_Pixel_Sizes failes'); + + // get scale factor for font-unit to pixel-size transformation + fFontUnitScale.X := fFace.size.metrics.x_ppem / fFace.units_per_EM; + fFontUnitScale.Y := fFace.size.metrics.y_ppem / fFace.units_per_EM; + + ResetIntern(); + + // pre-cache some commonly used glyphs (' ' - '~') + for i := #32 to #126 do + fCache.AddGlyph(i, TFTGlyph.Create(Self, i, Outset, LoadFlags)); +end; + +destructor TFTFont.Destroy(); +begin + // free face + FT_Done_Face(fFace); + inherited; +end; + +procedure TFTFont.ResetIntern(); +begin + // Note: outset and non outset fonts use same spacing + fLineSpacing := fFace.height * fFontUnitScale.Y; + fReflectionSpacing := -2*fFace.descender * fFontUnitScale.Y; +end; + +procedure TFTFont.Reset(); +begin + inherited; + ResetIntern(); +end; + +function TFTFont.LoadGlyph(ch: WideChar): TGlyph; +begin + Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags); +end; + +function TFTFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +var + Glyph, PrevGlyph: TFTGlyph; + TextLine: WideString; + LineYOffset: single; + LineIndex, CharIndex: integer; + LineBounds: TBoundsDbl; + KernDelta: FT_Vector; + UnderlinePos: double; +begin + // Reset global bounds + Result.Left := Infinity; + Result.Right := 0; + Result.Bottom := Infinity; + Result.Top := 0; + + // reset last glyph + PrevGlyph := nil; + + // display text + for LineIndex := 0 to High(Text) do + begin + // get next text line + TextLine := Text[LineIndex]; + LineYOffset := -LineSpacing * LineIndex; + + // reset line bounds + LineBounds.Left := Infinity; + LineBounds.Right := 0; + LineBounds.Bottom := Infinity; + LineBounds.Top := 0; + + // for each glyph image, compute its bounding box + for CharIndex := 1 to Length(TextLine) do + begin + Glyph := TFTGlyph(GetGlyph(TextLine[CharIndex])); + if (Glyph <> nil) then + begin + // get kerning + if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + begin + FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_KERNING_UNSCALED, KernDelta); + LineBounds.Right := LineBounds.Right + KernDelta.x * fFontUnitScale.X; + end; + + // update left bound (must be done before right bound is updated) + if (LineBounds.Right + Glyph.Bounds.Left < LineBounds.Left) then + LineBounds.Left := LineBounds.Right + Glyph.Bounds.Left; + + // update right bound + if (CharIndex < Length(TextLine)) or // not the last character + (TextLine[CharIndex] = ' ') or // on space char (Bounds.Right = 0) + Advance then // or in advance mode + begin + // add advance and glyph spacing + LineBounds.Right := LineBounds.Right + Glyph.Advance.x + GlyphSpacing + end + else + begin + // add glyph's right bound + LineBounds.Right := LineBounds.Right + Glyph.Bounds.Right; + end; + + // update bottom and top bounds + if (Glyph.Bounds.Bottom < LineBounds.Bottom) then + LineBounds.Bottom := Glyph.Bounds.Bottom; + if (Glyph.Bounds.Top > LineBounds.Top) then + LineBounds.Top := Glyph.Bounds.Top; + end; + + PrevGlyph := Glyph; + end; + + // handle italic font style + if (Italic in Style) then + begin + LineBounds.Left := LineBounds.Left + LineBounds.Bottom * cShearFactor; + LineBounds.Right := LineBounds.Right + LineBounds.Top * cShearFactor; + end; + + // handle underlined font style + if (Underline in Style) then + begin + UnderlinePos := GetUnderlinePosition(); + if (UnderlinePos < LineBounds.Bottom) then + LineBounds.Bottom := UnderlinePos; + end; + + // add line offset + LineBounds.Bottom := LineBounds.Bottom + LineYOffset; + LineBounds.Top := LineBounds.Top + LineYOffset; + + // adjust global bounds + if (Result.Left > LineBounds.Left) then + Result.Left := LineBounds.Left; + if (Result.Right < LineBounds.Right) then + Result.Right := LineBounds.Right; + if (Result.Bottom > LineBounds.Bottom) then + Result.Bottom := LineBounds.Bottom; + if (Result.Top < LineBounds.Top) then + Result.Top := LineBounds.Top; + end; + + // if left or bottom bound was not set, set them to 0 + if (Result.Left = Infinity) then + Result.Left := 0.0; + if (Result.Bottom = Infinity) then + Result.Bottom := 0.0; +end; + +procedure TFTFont.Render(const Text: WideString); +var + CharIndex: integer; + Glyph, PrevGlyph: TFTGlyph; + KernDelta: FT_Vector; +begin + // reset last glyph + PrevGlyph := nil; + + // draw current line + for CharIndex := 1 to Length(Text) do + begin + Glyph := TFTGlyph(GetGlyph(Text[CharIndex])); + if (Assigned(Glyph)) then + begin + // get kerning + if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + begin + FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_KERNING_UNSCALED, KernDelta); + glTranslatef(KernDelta.x * fFontUnitScale.X, 0, 0); + end; + + if (ReflectionPass) then + Glyph.RenderReflection() + else + Glyph.Render(fUseDisplayLists); + + glTranslatef(Glyph.Advance.x + fGlyphSpacing, 0, 0); + end; + + PrevGlyph := Glyph; + end; +end; + +function TFTFont.GetHeight(): single; +begin + Result := Ascender - Descender; +end; + +function TFTFont.GetAscender(): single; +begin + Result := fFace.ascender * fFontUnitScale.Y + Outset*2; +end; + +function TFTFont.GetDescender(): single; +begin + // Note: outset is not part of the descender as the baseline is lifted + Result := fFace.descender * fFontUnitScale.Y; +end; + +function TFTFont.GetUnderlinePosition(): single; +begin + Result := fFace.underline_position * fFontUnitScale.Y - Outset; +end; + +function TFTFont.GetUnderlineThickness(): single; +begin + Result := fFace.underline_thickness * fFontUnitScale.Y + Outset*2; +end; + + +{* + * TFTScalableFont + *} + +constructor TFTScalableFont.Create(const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean); +var + LoadFlags: FT_Int32; +begin + LoadFlags := FT_LOAD_DEFAULT; + // Disable hinting and grid-fitting to preserve font outlines at each font + // size, otherwise the font widths/heights do not match resulting in ugly + // text size changes during zooming. + // A drawback is a reduced quality with smaller font sizes but it is not that + // bad with gray-scaled rendering (at least it looks better than OpenGL's + // linear downscaling on minification). + if (UseMipmaps) then + LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; + inherited Create( + TFTFont.Create(Filename, Size, Size * OutsetAmount, LoadFlags), + UseMipmaps); +end; + +function TFTScalableFont.CreateMipmap(Level: integer; Scale: single): TFont; +var + ScaledSize: integer; + BaseFont: TFTFont; +begin + Result := nil; + BaseFont := TFTFont(fBaseFont); + ScaledSize := Round(BaseFont.Size * Scale); + // do not create mipmap fonts < 8 pixels + if (ScaledSize < 8) then + Exit; + Result := TFTFont.Create(BaseFont.fFilename, + ScaledSize, BaseFont.fOutset * Scale, + FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); +end; + +function TFTScalableFont.GetOutset(): single; +begin + Result := TFTFont(fBaseFont).Outset * fScale; +end; + +procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); +end; + + +{* + * TOutlineFont + *} + +constructor TFTOutlineFont.Create( + const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32); +begin + inherited Create(); + + fFilename := Filename; + fSize := Size; + fOutset := Outset; + + fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags); + fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags); + + ResetIntern(); +end; + +destructor TFTOutlineFont.Destroy; +begin + fOutlineFont.Free; + fInnerFont.Free; + inherited; +end; + +procedure TFTOutlineFont.ResetIntern(); +begin + // TODO: maybe swap fInnerFont/fOutlineFont.GlyphSpacing to use the spacing + // of the outline font? + //fInnerFont.GlyphSpacing := fOutset*2; + fOutlineFont.GlyphSpacing := -fOutset*2; + + fLineSpacing := fOutlineFont.LineSpacing; + fReflectionSpacing := fOutlineFont.ReflectionSpacing; + fOutlineColor := NewGLColor(0, 0, 0, 1); +end; + +procedure TFTOutlineFont.Reset(); +begin + inherited; + fInnerFont.Reset(); + fOutlineFont.Reset(); + ResetIntern(); +end; + +procedure TFTOutlineFont.DrawUnderline(const Text: WideString); +begin + glPushAttrib(GL_CURRENT_BIT); + glColor4fv(@fOutlineColor.vals); + fOutlineFont.DrawUnderline(Text); + glPopAttrib(); + + glPushMatrix(); + glTranslatef(fOutset, 0, 0); + fInnerFont.DrawUnderline(Text); + glPopMatrix(); +end; + +procedure TFTOutlineFont.Render(const Text: WideString); +begin + { setup and render outline font } + + // save old color + glPushAttrib(GL_CURRENT_BIT); + glColor4fv(@fOutlineColor.vals); + glPushMatrix(); + fOutlineFont.Render(Text); + glPopMatrix(); + glPopAttrib(); + + { setup and render inner font } + + glPushMatrix(); + glTranslatef(fOutset, fOutset, 0); + fInnerFont.Render(Text); + glPopMatrix(); +end; + +procedure TFTOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); +begin + fOutlineColor := NewGLColor(r, g, b, a); +end; + +procedure TFTOutlineFont.FlushCache(KeepBaseSet: boolean); +begin + fOutlineFont.FlushCache(KeepBaseSet); + fInnerFont.FlushCache(KeepBaseSet); +end; + +function TFTOutlineFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +begin + Result := fOutlineFont.BBox(Text, Advance); +end; + +function TFTOutlineFont.GetHeight(): single; +begin + Result := fOutlineFont.Height; +end; + +function TFTOutlineFont.GetAscender(): single; +begin + Result := fOutlineFont.Ascender; +end; + +function TFTOutlineFont.GetDescender(): single; +begin + Result := fOutlineFont.Descender; +end; + +procedure TFTOutlineFont.SetLineSpacing(Spacing: single); +begin + inherited SetLineSpacing(Spacing); + fInnerFont.LineSpacing := Spacing; + fOutlineFont.LineSpacing := Spacing; +end; + +procedure TFTOutlineFont.SetGlyphSpacing(Spacing: single); +begin + inherited SetGlyphSpacing(Spacing); + fInnerFont.GlyphSpacing := Spacing; + fOutlineFont.GlyphSpacing := Spacing - Outset*2; +end; + +procedure TFTOutlineFont.SetReflectionSpacing(Spacing: single); +begin + inherited SetReflectionSpacing(Spacing); + fInnerFont.ReflectionSpacing := Spacing; + fOutlineFont.ReflectionSpacing := Spacing; +end; + +procedure TFTOutlineFont.SetStyle(Style: TFontStyle); +begin + inherited SetStyle(Style); + fInnerFont.Style := Style; + fOutlineFont.Style := Style; +end; + +function TFTOutlineFont.GetStyle(): TFontStyle; +begin + Result := inherited GetStyle(); +end; + +function TFTOutlineFont.GetUnderlinePosition(): single; +begin + Result := fOutlineFont.GetUnderlinePosition(); +end; + +function TFTOutlineFont.GetUnderlineThickness(): single; +begin + Result := fOutlineFont.GetUnderlinePosition(); +end; + +procedure TFTOutlineFont.SetUseKerning(Enable: boolean); +begin + inherited SetUseKerning(Enable); + fInnerFont.fUseKerning := Enable; + fOutlineFont.fUseKerning := Enable; +end; + +procedure TFTOutlineFont.SetReflectionPass(Enable: boolean); +begin + inherited SetReflectionPass(Enable); + fInnerFont.fReflectionPass := Enable; + fOutlineFont.fReflectionPass := Enable; +end; + +{** + * TScalableOutlineFont + *} + +constructor TFTScalableOutlineFont.Create( + const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean); +var + LoadFlags: FT_Int32; +begin + LoadFlags := FT_LOAD_DEFAULT; + // Disable hinting and grid-fitting (see TFTScalableFont.Create) + if (UseMipmaps) then + LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; + inherited Create( + TFTOutlineFont.Create(Filename, Size, Size*OutsetAmount, LoadFlags), + UseMipmaps); +end; + +function TFTScalableOutlineFont.CreateMipmap(Level: integer; Scale: single): TFont; +var + ScaledSize: integer; + BaseFont: TFTOutlineFont; +begin + Result := nil; + BaseFont := TFTOutlineFont(fBaseFont); + ScaledSize := Round(BaseFont.Size*Scale); + // do not create mipmap fonts < 8 pixels + if (ScaledSize < 8) then + Exit; + Result := TFTOutlineFont.Create(BaseFont.fFilename, + ScaledSize, BaseFont.fOutset*Scale, + FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); +end; + +function TFTScalableOutlineFont.GetOutset(): single; +begin + Result := TFTOutlineFont(fBaseFont).Outset * fScale; +end; + +procedure TFTScalableOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTOutlineFont(fMipmapFonts[Level]).SetOutlineColor(r, g, b, a); +end; + +procedure TFTScalableOutlineFont.FlushCache(KeepBaseSet: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTOutlineFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); +end; + + +{* + * TFTGlyph + *} + +const + {** + * Size of the transparent border surrounding the glyph image in the texture. + * The border is necessary because OpenGL does not smooth texels at the + * border of a texture with the GL_CLAMP or GL_CLAMP_TO_EDGE styles. + * Without the border, magnified glyph textures look very ugly at their edges. + * It looks edgy, as if some pixels are missing especially on the left edge + * (just set cTexSmoothBorder to 0 to see what is meant by this). + * With the border even the glyphs edges are blended to the border (transparent) + * color and everything looks nice. + * + * Note: + * OpenGL already supports texture border by setting the border parameter + * of glTexImage*D() to 1 and using a texture size of 2^m+2b and setting the + * border pixels to the border color. In some forums it is discouraged to use + * the border parameter as only a few of the more modern graphics cards support + * this feature. On an ATI Radeon 9700 card, the slowed down to 0.5 fps and + * the glyph's background got black. So instead of using this feature we + * handle it on our own. The only drawback is that textures might get bigger + * because the border might require a higher power of 2 size instead of just + * two additional pixels. + *} + cTexSmoothBorder = 1; + +procedure TFTGlyph.Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); + + procedure SetToMax(var Val1: GLubyte; Val2: GLubyte); {$IFDEF HasInline}inline;{$ENDIF} + begin + if (Val1 < Val2) then + Val1 := Val2; + end; + +var + I, X, Y: integer; + SrcBuffer,TmpBuffer: TGLubyteDynArray; + TexLine, TexLinePrev, TexLineNext: PGLubyteArray; + SrcLine: PGLubyteArray; + AlphaScale: single; + Value, ValueNeigh, ValueDiag: GLubyte; +const + // square-root of 2 used for diagonal neighbor pixels + cSqrt2 = 1.4142; + // number of ignored pixels on each edge of the bitmap. Consists of: + // - border used for font smoothing and + // - outer (extruded) bitmap pixel (because it is just written but never read) + cBorder = cTexSmoothBorder + 1; +begin + // allocate memory for temporary buffer + SetLength(SrcBuffer, Length(TexBuffer)); + FillChar(SrcBuffer[0], Length(TexBuffer), 0); + + // extrude pixel by pixel + for I := 1 to Ceil(Outset) do + begin + // swap arrays + TmpBuffer := TexBuffer; + TexBuffer := SrcBuffer; + SrcBuffer := TmpBuffer; + + // as long as we add an entire pixel of outset, use a solid color. + // If the fractional part is reached blend, e.g. outline=3.2 -> 3 solid + // pixels and one blended with alpha=0.2. + // For the fractional part I = Ceil(Outset) is always true. + if (I <= Outset) then + AlphaScale := 1 + else + AlphaScale := Outset - Trunc(Outset); + + // copy data to the expanded bitmap. + for Y := cBorder to fTexSize.Height - 2*cBorder do + begin + TexLine := @TexBuffer[Y*fTexSize.Width]; + TexLinePrev := @TexBuffer[(Y-1)*fTexSize.Width]; + TexLineNext := @TexBuffer[(Y+1)*fTexSize.Width]; + SrcLine := @SrcBuffer[Y*fTexSize.Width]; + + // expand current line's pixels + for X := cBorder to fTexSize.Width - 2*cBorder do + begin + Value := SrcLine[X]; + ValueNeigh := Round(Value * AlphaScale); + ValueDiag := Round(ValueNeigh / cSqrt2); + + SetToMax(TexLine[X], Value); + SetToMax(TexLine[X-1], ValueNeigh); + SetToMax(TexLine[X+1], ValueNeigh); + + SetToMax(TexLinePrev[X], ValueNeigh); + SetToMax(TexLinePrev[X-1], ValueDiag); + SetToMax(TexLinePrev[X+1], ValueDiag); + + SetToMax(TexLineNext[X], ValueNeigh); + SetToMax(TexLineNext[X-1], ValueDiag); + SetToMax(TexLineNext[X+1], ValueDiag); + end; + end; + end; + + TmpBuffer := nil; + SetLength(SrcBuffer, 0); +end; + +procedure TFTGlyph.CreateTexture(LoadFlags: FT_Int32); +var + X, Y: integer; + Glyph: FT_Glyph; + BitmapGlyph: FT_BitmapGlyph; + Bitmap: PFT_Bitmap; + BitmapLine: PChar; + BitmapBuffer: PChar; + TexBuffer: TGLubyteDynArray; + TexLine: PGLubyteArray; + CBox: FT_BBox; +begin + // load the Glyph for our character + if (FT_Load_Glyph(fFont.Face, fCharIndex, LoadFlags) <> 0) then + raise Exception.Create('FT_Load_Glyph failed'); + + // move the face's glyph into a Glyph object + if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then + raise Exception.Create('FT_Get_Glyph failed'); + + // store scaled advance width/height in glyph-object + fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2; + fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2; + + // get the contour's bounding box (in 1/64th pixels, not font-units) + FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox); + // convert 1/64th values to double values + fBounds.Left := CBox.xMin / 64; + fBounds.Right := CBox.xMax / 64 + fOutset*2; + fBounds.Bottom := CBox.yMin / 64; + fBounds.Top := CBox.yMax / 64 + fOutset*2; + + // convert the glyph to a bitmap (and destroy original glyph image) + FT_Glyph_To_Bitmap(Glyph, ft_render_mode_normal, nil, 1); + BitmapGlyph := FT_BitmapGlyph(Glyph); + + // get bitmap offsets + fBitmapCoords.Left := BitmapGlyph^.left - cTexSmoothBorder; + // Note: add 1*fOutset for lifting the baseline so outset fonts to not intersect + // with the baseline; Ceil(fOutset) for the outset pixels added to the bitmap. + fBitmapCoords.Top := BitmapGlyph^.top + fOutset+Ceil(fOutset) + cTexSmoothBorder; + + // make accessing the bitmap easier + Bitmap := @BitmapGlyph^.bitmap; + // get bitmap dimensions + fBitmapCoords.Width := Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2; + fBitmapCoords.Height := Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2; + + // get power-of-2 bitmap widths + fTexSize.Width := + NextPowerOf2(Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2); + fTexSize.Height := + NextPowerOf2(Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2); + + // texture-widths ignoring empty (power-of-2) padding space + fTexOffset.X := fBitmapCoords.Width / fTexSize.Width; + fTexOffset.Y := fBitmapCoords.Height / fTexSize.Height; + + // allocate memory for texture data + SetLength(TexBuffer, fTexSize.Width * fTexSize.Height); + FillChar(TexBuffer[0], Length(TexBuffer), 0); + + // Freetype stores the bitmap with either upper (pitch is > 0) or lower + // (pitch < 0) glyphs line first. Set the buffer to the upper line. + // See http://freetype.sourceforge.net/freetype2/docs/glyphs/glyphs-7.html + if (Bitmap.pitch > 0) then + BitmapBuffer := @Bitmap.buffer[0] + else + BitmapBuffer := @Bitmap.buffer[(Bitmap.rows-1) * Abs(Bitmap.pitch)]; + + // copy data to texture bitmap (upper line first). + for Y := 0 to Bitmap.rows-1 do + begin + // set pointer to first pixel in line that holds bitmap data. + // Each line starts with a cTexSmoothBorder pixel and multiple outset pixels + // that are added by Extrude() later. + TexLine := @TexBuffer[(Y + cTexSmoothBorder + Ceil(fOutset)) * fTexSize.Width + + cTexSmoothBorder + Ceil(fOutset)]; + // get next lower line offset, use pitch instead of width as it tells + // us the storage direction of the lines. In addition a line might be padded. + BitmapLine := @BitmapBuffer[Y * Bitmap.pitch]; + for X := 0 to Bitmap.width-1 do + TexLine[X] := GLubyte(BitmapLine[X]); + end; + + if (fOutset > 0) then + Extrude(TexBuffer, fOutset); + + // allocate resources for textures and display lists + glGenTextures(1, @fTexture); + + // setup texture parameters + glBindTexture(GL_TEXTURE_2D, fTexture); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + + glPixelStorei(GL_UNPACK_ALIGNMENT, 1); + // create alpha-map (GL_ALPHA component only). + // TexCoord (0,0) corresponds to the top left pixel of the glyph, + // (1,1) to the bottom right pixel. So the glyph is flipped as OpenGL uses + // a cartesian (y-axis up) coordinate system for textures. + // See the cTexSmoothBorder comment for info on texture borders. + glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, fTexSize.Width, fTexSize.Height, + 0, GL_ALPHA, GL_UNSIGNED_BYTE, @TexBuffer[0]); + + // free expanded data + SetLength(TexBuffer, 0); + + // create the display list + fDisplayList := glGenLists(1); + + // render to display-list + glNewList(fDisplayList, GL_COMPILE); + Render(false); + glEndList(); + + // free glyph data (bitmap, etc.) + FT_Done_Glyph(Glyph); +end; + +constructor TFTGlyph.Create(Font: TFTFont; ch: WideChar; Outset: single; + LoadFlags: FT_Int32); +begin + inherited Create(); + + fFont := Font; + fOutset := Outset; + + // get the Freetype char-index (use default UNICODE charmap) + fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch)); + + CreateTexture(LoadFlags); +end; + +destructor TFTGlyph.Destroy; +begin + if (fDisplayList <> 0) then + glDeleteLists(fDisplayList, 1); + if (fTexture <> 0) then + glDeleteTextures(1, @fTexture); + inherited; +end; + +procedure TFTGlyph.Render(UseDisplayLists: boolean); +begin + // use display-lists if enabled and exit + if (UseDisplayLists) then + begin + glCallList(fDisplayList); + Exit; + end; + + glBindTexture(GL_TEXTURE_2D, fTexture); + glPushMatrix(); + + // move to top left glyph position + glTranslatef(fBitmapCoords.Left, fBitmapCoords.Top, 0); + + // draw glyph texture + glBegin(GL_QUADS); + // top right + glTexCoord2f(fTexOffset.X, 0); + glVertex2f(fBitmapCoords.Width, 0); + + // top left + glTexCoord2f(0, 0); + glVertex2f(0, 0); + + // bottom left + glTexCoord2f(0, fTexOffset.Y); + glVertex2f(0, -fBitmapCoords.Height); + + // bottom right + glTexCoord2f(fTexOffset.X, fTexOffset.Y); + glVertex2f(fBitmapCoords.Width, -fBitmapCoords.Height); + glEnd(); + + glPopMatrix(); +end; + +procedure TFTGlyph.RenderReflection(); +var + Color: TGLColor; + TexUpperPos: single; + TexLowerPos: single; + UpperPos: single; +const + CutOff = 0.6; +begin + glPushMatrix(); + glBindTexture(GL_TEXTURE_2D, fTexture); + glGetFloatv(GL_CURRENT_COLOR, @Color.vals); + + // add extra space to the left of the glyph + glTranslatef(fBitmapCoords.Left, 0, 0); + + // The upper position of the glyph, if CutOff is 1.0, it is fFont.Ascender. + // If CutOff is set to 0.5 only half of the glyph height is displayed. + UpperPos := fFont.Descender + fFont.Height * CutOff; + + // the glyph texture's height is just the height of the glyph but not the font + // height. Setting a color for the upper and lower bounds of the glyph results + // in different color gradients. So we have to set the color values for the + // descender and ascender (as we have a cutoff, for the upper-pos here) as + // these positions are font but not glyph specific. + + // To get the texture positions we have to enhance the texture at the top and + // bottom by the amount from the top to ascender (rather upper-pos here) and + // from the bottom (Height-Top) to descender. Then we have to convert those + // heights to texture coordinates by dividing by the bitmap Height and + // removing the power-of-2 padding space by multiplying with fTexOffset.Y + // (as fBitmapCoords.Height corresponds to fTexOffset.Y and not 1.0). + TexUpperPos := -(UpperPos - fBitmapCoords.Top) / fBitmapCoords.Height * fTexOffset.Y; + TexLowerPos := (-(fFont.Descender + fBitmapCoords.Height - fBitmapCoords.Top) / + fBitmapCoords.Height + 1) * fTexOffset.Y; + + // draw glyph texture + glBegin(GL_QUADS); + // top right + glColor4f(Color.r, Color.g, Color.b, 0); + glTexCoord2f(fTexOffset.X, TexUpperPos); + glVertex2f(fBitmapCoords.Width, UpperPos); + + // top left + glTexCoord2f(0, TexUpperPos); + glVertex2f(0, UpperPos); + + // bottom left + glColor4f(Color.r, Color.g, Color.b, Color.a-0.3); + glTexCoord2f(0, TexLowerPos); + glVertex2f(0, fFont.Descender); + + // bottom right + glTexCoord2f(fTexOffset.X, TexLowerPos); + glVertex2f(fBitmapCoords.Width, fFont.Descender); + glEnd(); + + glPopMatrix(); + + // restore old color + // Note: glPopAttrib(GL_CURRENT_BIT)/glPopAttrib() is much slower then + // glGetFloatv(GL_CURRENT_COLOR, ...)/glColor4fv(...) + glColor4fv(@Color.vals); +end; + +function TFTGlyph.GetAdvance(): TPositionDbl; +begin + Result := fAdvance; +end; + +function TFTGlyph.GetBounds(): TBoundsDbl; +begin + Result := fBounds; +end; + + +{* + * TGlyphCache + *} + +constructor TGlyphCache.Create(); +begin + inherited; + fHash := TList.Create(); +end; + +destructor TGlyphCache.Destroy(); +begin + // free cached glyphs + FlushCache(false); + + // destroy TList + fHash.Free; + + inherited; +end; + +function TGlyphCache.FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; +var + I: integer; + Entry: TGlyphCacheHashEntry; +begin + Result := nil; + + for I := 0 to fHash.Count-1 do + begin + Entry := TGlyphCacheHashEntry(fHash[I]); + + if (Entry.BaseCode > BaseCode) then + begin + InsertPos := I; + Exit; + end; + + if (Entry.BaseCode = BaseCode) then + begin + InsertPos := I; + Result := @Entry.GlyphTable; + Exit; + end; + end; + + InsertPos := fHash.Count; +end; + +function TGlyphCache.AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; +var + BaseCode: cardinal; + GlyphCode: integer; + InsertPos: integer; + GlyphTable: PGlyphTable; + Entry: TGlyphCacheHashEntry; +begin + Result := false; + + BaseCode := cardinal(ch) shr 8; + GlyphTable := FindGlyphTable(BaseCode, InsertPos); + if (GlyphTable = nil) then + begin + Entry := TGlyphCacheHashEntry.Create(BaseCode); + GlyphTable := @Entry.GlyphTable; + fHash.Insert(InsertPos, Entry); + end; + + // get glyph table offset + GlyphCode := cardinal(ch) and $FF; + // insert glyph into table if not present + if (GlyphTable[GlyphCode] = nil) then + begin + GlyphTable[GlyphCode] := Glyph; + Result := true; + end; +end; + +procedure TGlyphCache.DeleteGlyph(ch: WideChar); +var + Table: PGlyphTable; + TableIndex, GlyphIndex: integer; + TableEmpty: boolean; +begin + // find table + Table := FindGlyphTable(cardinal(ch) shr 8, TableIndex); + if (Table = nil) then + Exit; + + // find glyph + GlyphIndex := cardinal(ch) and $FF; + if (Table[GlyphIndex] <> nil) then + begin + // destroy glyph + FreeAndNil(Table[GlyphIndex]); + + // check if table is empty + TableEmpty := true; + for GlyphIndex := 0 to High(Table^) do + begin + if (Table[GlyphIndex] <> nil) then + begin + TableEmpty := false; + Break; + end; + end; + + // free empty table + if (TableEmpty) then + begin + fHash.Delete(TableIndex); + end; + end; +end; + +function TGlyphCache.GetGlyph(ch: WideChar): TGlyph; +var + InsertPos: integer; + Table: PGlyphTable; +begin + Table := FindGlyphTable(cardinal(ch) shr 8, InsertPos); + if (Table = nil) then + Result := nil + else + Result := Table[cardinal(ch) and $FF]; +end; + +function TGlyphCache.HasGlyph(ch: WideChar): boolean; +begin + Result := (GetGlyph(ch) <> nil); +end; + +procedure TGlyphCache.FlushCache(KeepBaseSet: boolean); +var + EntryIndex, TableIndex: integer; + Entry: TGlyphCacheHashEntry; +begin + // destroy cached glyphs + for EntryIndex := 0 to fHash.Count-1 do + begin + Entry := TGlyphCacheHashEntry(fHash[EntryIndex]); + + // the base set (0-255) has BaseCode 0 as the upper bytes are 0. + if KeepBaseSet and (Entry.fBaseCode = 0) then + Continue; + + for TableIndex := 0 to High(Entry.GlyphTable) do + begin + if (Entry.GlyphTable[TableIndex] <> nil) then + FreeAndNil(Entry.GlyphTable[TableIndex]); + end; + FreeAndNil(Entry); + end; +end; + + +{* + * TGlyphCacheEntry + *} + +constructor TGlyphCacheHashEntry.Create(BaseCode: cardinal); +begin + inherited Create(); + fBaseCode := BaseCode; +end; + + +{* + * TFreeType + *} + +class function TFreeType.GetLibrary(): FT_Library; +begin + if (LibraryInst = nil) then + begin + // initialize freetype + if (FT_Init_FreeType(LibraryInst) <> 0) then + raise Exception.Create('FT_Init_FreeType failed'); + end; + Result := LibraryInst; +end; + +class procedure TFreeType.FreeLibrary(); +begin + if (LibraryInst <> nil) then + FT_Done_FreeType(LibraryInst); + LibraryInst := nil; +end; + + +{$IFDEF BITMAP_FONT} +{* + * TBitmapFont + *} + +constructor TBitmapFont.Create(const Filename: string; Outline: integer; + Baseline, Ascender, Descender: integer); +begin + inherited Create(); + + fTex := Texture.LoadTexture(true, Filename, TEXTURE_TYPE_TRANSPARENT, 0); + fTexSize := 1024; + fOutline := Outline; + fBaseline := Baseline; + fAscender := Ascender; + fDescender := Descender; + + LoadFontInfo(ChangeFileExt(Filename, '.dat')); + + ResetIntern(); +end; + +destructor TBitmapFont.Destroy(); +begin + glDeleteTextures(1, @fTex.TexNum); + inherited; +end; + +procedure TBitmapFont.ResetIntern(); +begin + fLineSpacing := Height; +end; + +procedure TBitmapFont.Reset(); +begin + inherited; + ResetIntern(); +end; + +procedure TBitmapFont.CorrectWidths(WidthMult: real; WidthAdd: integer); +var + Count: integer; +begin + for Count := 0 to 255 do + fWidths[Count] := Round(fWidths[Count] * WidthMult) + WidthAdd; +end; + +procedure TBitmapFont.LoadFontInfo(const InfoFile: string); +var + Stream: TFileStream; +begin + FillChar(fWidths[0], Length(fWidths), 0); + + Stream := nil; + try + Stream := TFileStream.Create(InfoFile, fmOpenRead); + Stream.Read(fWidths, 256); + except + raise Exception.Create('Could not read font info file ''' + InfoFile + ''''); + end; + Stream.Free; +end; + +function TBitmapFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +var + LineIndex, CharIndex: integer; + CharCode: cardinal; + Line: WideString; + LineWidth: double; +begin + Result.Left := 0; + Result.Right := 0; + Result.Top := Height; + Result.Bottom := 0; + + for LineIndex := 0 to High(Text) do + begin + Line := Text[LineIndex]; + LineWidth := 0; + for CharIndex := 1 to Length(Line) do + begin + CharCode := Ord(Line[CharIndex]); + if (CharCode < Length(fWidths)) then + LineWidth := LineWidth + fWidths[CharCode]; + end; + if (LineWidth > Result.Right) then + Result.Right := LineWidth; + end; +end; + +procedure TBitmapFont.RenderChar(ch: WideChar; var AdvanceX: real); +var + TexX, TexY: real; + TexR, TexB: real; + GlyphWidth: real; + PL, PT: real; + PR, PB: real; + CharCode: cardinal; +begin + CharCode := Ord(ch); + if (CharCode > High(fWidths)) then + CharCode := 0; + + GlyphWidth := fWidths[CharCode]; + + // set texture positions + TexX := (CharCode mod 16) * 1/16 + 1/32 - (GlyphWidth/2 - fOutline)/fTexSize; + TexY := (CharCode div 16) * 1/16 + {2 texels} 2/fTexSize; + TexR := (CharCode mod 16) * 1/16 + 1/32 + (GlyphWidth/2 + fOutline)/fTexSize; + TexB := (1 + CharCode div 16) * 1/16 - {2 texels} 2/fTexSize; + + // set vector positions + PL := AdvanceX - fOutline; + PR := PL + GlyphWidth + fOutline*2; + PB := -fBaseline; + PT := PB + fTexSize div 16; + + (* + if (Font.Blend) then + begin + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + end; + *) + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, fTex.TexNum); + + if (not ReflectionPass) then + begin + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + glEnd; + end + else + begin + glDepthRange(0, 10); + glDepthFunc(GL_LEQUAL); + glEnable(GL_DEPTH_TEST); + + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + glEnd; + + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + +(* + glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0.7); + glTexCoord2f(TexX, TexB); glVertex3f(PL, PB, 0); + glTexCoord2f(TexR, TexB); glVertex3f(PR, PB, 0); + + glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0); + glTexCoord2f(TexR, (TexY + TexB)/2); glVertex3f(PR, (PT + PB)/2, 0); + glTexCoord2f(TexX, (TexY + TexB)/2); glVertex3f(PL, (PT + PB)/2, 0); +*) + glEnd; + + //write the colour back + glColor4fv(@fTempColor); + + glDisable(GL_DEPTH_TEST); + end; // reflection + + glDisable(GL_TEXTURE_2D); + (* + if (Font.Blend) then + glDisable(GL_BLEND); + *) + + AdvanceX := AdvanceX + GlyphWidth; +end; + +procedure TBitmapFont.Render(const Text: WideString); +var + CharIndex: integer; + AdvanceX: real; +begin + // if there is no text do nothing + if (Text = '') then + Exit; + + //Save the current color and alpha (for reflection) + glGetFloatv(GL_CURRENT_COLOR, @fTempColor); + + AdvanceX := 0; + for CharIndex := 1 to Length(Text) do + begin + RenderChar(Text[CharIndex], AdvanceX); + end; +end; + +function TBitmapFont.GetHeight(): single; +begin + Result := fAscender - fDescender; +end; + +function TBitmapFont.GetAscender(): single; +begin + Result := fAscender; +end; + +function TBitmapFont.GetDescender(): single; +begin + Result := fDescender; +end; + +function TBitmapFont.GetUnderlinePosition(): single; +begin + Result := -2.0; +end; + +function TBitmapFont.GetUnderlineThickness(): single; +begin + Result := 1.0; +end; + +{$ENDIF BITMAP_FONT} + + +initialization + +finalization + TFreeType.FreeLibrary(); + +end. -- cgit v1.2.3 From d6770dd47dcb871f021868dec2b333527ffb8ee8 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 26 Oct 2008 11:54:33 +0000 Subject: git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1479 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 5328 ++++++++++++++++++++++++++-------------------------- 1 file changed, 2690 insertions(+), 2638 deletions(-) (limited to 'src/base/UFont.pas') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 947a1c6f..30be4c3b 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -1,2646 +1,2698 @@ -unit UFont; - -{$IFDEF FPC} - {$mode delphi}{$H+} -{$ENDIF} - -{$DEFINE HasInline} - -interface - -// Flip direction of y-axis. -// Default is a cartesian coordinate system with y-axis in upper direction -// but with USDX the y-axis is in lower direction. -{$DEFINE FLIP_YAXIS} -{$DEFINE BITMAP_FONT} - -uses - FreeType, - gl, - glext, - glu, - sdl, - {$IFDEF BITMAP_FONT} - UTexture, - {$ENDIF} - Math, - Classes, - SysUtils; - -type - - PGLubyteArray = ^TGLubyteArray; - TGLubyteArray = array[0 .. (MaxInt div SizeOf(GLubyte))-1] of GLubyte; - TGLubyteDynArray = array of GLubyte; - - TWideStringArray = array of WideString; - - TGLColor = packed record - case byte of - 0: ( vals: array[0..3] of GLfloat; ); - 1: ( r, g, b, a: GLfloat; ); - end; - - TBoundsDbl = record - Left, Right: double; - Bottom, Top: double; - end; - - TPositionDbl = record - X, Y: double; - end; - - TTextureSize = record - Width, Height: integer; - end; - - TBitmapCoords = record - Left, Top: double; - Width, Height: integer; - end; - - {** - * Abstract base class representing a glyph. - *} - TGlyph = class - protected - function GetAdvance(): TPositionDbl; virtual; abstract; - function GetBounds(): TBoundsDbl; virtual; abstract; - public - procedure Render(UseDisplayLists: boolean); virtual; abstract; - procedure RenderReflection(); virtual; abstract; - - {** Distance to next glyph (in pixels) *} - property Advance: TPositionDbl read GetAdvance; - {** Glyph bounding box (in pixels) *} - property Bounds: TBoundsDbl read GetBounds; - end; - - {** - * Font styles used by TFont.Style - *} - TFontStyle = set of (Italic, Underline, Reflect); - - {** - * Base font class. - *} - TFont = class - private - {** Non-virtual reset-method used in Create() and Reset() } - procedure ResetIntern(); - - protected - fStyle: TFontStyle; - fUseKerning: boolean; - fLineSpacing: single; // must be inited by subclass - fReflectionSpacing: single; // must be inited by subclass to -2*Descender - fGlyphSpacing: single; - fReflectionPass: boolean; - - {** - * Splits lines in Text seperated by newline (char-code #13). - * @param Text UTF-8 encoded string - * @param Lines splitted WideString lines - *} - procedure SplitLines(const Text: UTF8String; var Lines: TWideStringArray); - - {** - * Print an array of WideStrings. Each array-item is a line of text. - * Lines of text are seperated by the line-spacing. - * This is the base function for all text drawing. - *} - procedure Print(const Text: TWideStringArray); overload; virtual; - - {** +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + +unit UFont; + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +interface + +{$IFNDEF FREETYPE_DEMO} + // Flip direction of y-axis. + // Default is a cartesian coordinate system with y-axis in upper direction + // but with USDX the y-axis is in lower direction. + {$DEFINE FLIP_YAXIS} + {$DEFINE BITMAP_FONT} +{$ENDIF} + +uses + FreeType, + gl, + glext, + glu, + sdl, + {$IFDEF BITMAP_FONT} + UTexture, + {$ENDIF} + Math, + Classes, + SysUtils; + +type + + PGLubyteArray = ^TGLubyteArray; + TGLubyteArray = array[0 .. (MaxInt div SizeOf(GLubyte))-1] of GLubyte; + TGLubyteDynArray = array of GLubyte; + + TWideStringArray = array of WideString; + + TGLColor = packed record + case byte of + 0: ( vals: array[0..3] of GLfloat; ); + 1: ( r, g, b, a: GLfloat; ); + end; + + TBoundsDbl = record + Left, Right: double; + Bottom, Top: double; + end; + + TPositionDbl = record + X, Y: double; + end; + + TTextureSize = record + Width, Height: integer; + end; + + TBitmapCoords = record + Left, Top: double; + Width, Height: integer; + end; + + {** + * Abstract base class representing a glyph. + *} + TGlyph = class + protected + function GetAdvance(): TPositionDbl; virtual; abstract; + function GetBounds(): TBoundsDbl; virtual; abstract; + public + procedure Render(UseDisplayLists: boolean); virtual; abstract; + procedure RenderReflection(); virtual; abstract; + + {** Distance to next glyph (in pixels) *} + property Advance: TPositionDbl read GetAdvance; + {** Glyph bounding box (in pixels) *} + property Bounds: TBoundsDbl read GetBounds; + end; + + {** + * Font styles used by TFont.Style + *} + TFontStyle = set of (Italic, Underline, Reflect); + + {** + * Base font class. + *} + TFont = class + private + {** Non-virtual reset-method used in Create() and Reset() } + procedure ResetIntern(); + + protected + fStyle: TFontStyle; + fUseKerning: boolean; + fLineSpacing: single; // must be inited by subclass + fReflectionSpacing: single; // must be inited by subclass to -2*Descender + fGlyphSpacing: single; + fReflectionPass: boolean; + + {** + * Splits lines in Text seperated by newline (char-code #13). + * @param Text UTF-8 encoded string + * @param Lines splitted WideString lines + *} + procedure SplitLines(const Text: UTF8String; var Lines: TWideStringArray); + + {** + * Print an array of WideStrings. Each array-item is a line of text. + * Lines of text are seperated by the line-spacing. + * This is the base function for all text drawing. + *} + procedure Print(const Text: TWideStringArray); overload; virtual; + + {** * Draws an underline. *} - procedure DrawUnderline(const Text: WideString); virtual; - - {** - * Renders (one) line of text. - *} - procedure Render(const Text: WideString); virtual; abstract; - - {** - * Returns the bounds of text-lines contained in Text. - * @param(Advance if true the right bound is set to the advance instead - * of the minimal right bound.) - *} - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract; - - {** - * Resets all user settings to default values. - * Override methods should always call the inherited version. - *} - procedure Reset(); virtual; - - function GetHeight(): single; virtual; abstract; - function GetAscender(): single; virtual; abstract; - function GetDescender(): single; virtual; abstract; - procedure SetLineSpacing(Spacing: single); virtual; - function GetLineSpacing(): single; virtual; - procedure SetGlyphSpacing(Spacing: single); virtual; - function GetGlyphSpacing(): single; virtual; - procedure SetReflectionSpacing(Spacing: single); virtual; - function GetReflectionSpacing(): single; virtual; - procedure SetStyle(Style: TFontStyle); virtual; - function GetStyle(): TFontStyle; virtual; - function GetUnderlinePosition(): single; virtual; abstract; - function GetUnderlineThickness(): single; virtual; abstract; - procedure SetUseKerning(Enable: boolean); virtual; - function GetUseKerning(): boolean; virtual; - procedure SetReflectionPass(Enable: boolean); virtual; - - {** Returns true if the current render-pass is used to draw the reflection } - property ReflectionPass: boolean read fReflectionPass write SetReflectionPass; - - public - constructor Create(); - destructor Destroy(); override; - - {** - * Prints a text. - *} - procedure Print(const Text: WideString); overload; - {** UTF-8 version of @link(Print) } - procedure Print(const Text: string); overload; - - {** - * Calculates the bounding box (width and height) around Text. - * Works with Italic and Underline styles but reflections created - * with the Reflect style are not considered. - * Note that the width might differ due to kerning with appended text, - * e.g. Width('VA') <= Width('V') + Width('A'). - * @param Advance if set to true, Result.Right is set to the advance of - * the given text rather than the min. right border. The advance width is - * bigger than the text's width as it additionally contains the advance - * and glyph-spacing of the last character. - *} - function BBox(const Text: WideString; Advance: boolean = false): TBoundsDbl; overload; - {** UTF-8 version of @link(BBox) } - function BBox(const Text: UTF8String; Advance: boolean = false): TBoundsDbl; overload; - - {** Font height } - property Height: single read GetHeight; - {** Vertical distance from baseline to top of glyph } - property Ascender: single read GetAscender; - {** Vertical distance from baseline to bottom of glyph } - property Descender: single read GetDescender; - {** Vertical distance between two baselines } - property LineSpacing: single read GetLineSpacing write SetLineSpacing; - {** Space between end and start of next glyph added to the advance width } - property GlyphSpacing: single read GetGlyphSpacing write SetGlyphSpacing; - {** Distance between normal baseline and baseline of the reflection } - property ReflectionSpacing: single read GetReflectionSpacing write SetReflectionSpacing; - {** Font style (italic/underline/...) } - property Style: TFontStyle read GetStyle write SetStyle; - {** If set to true (default) kerning will be used if available } - property UseKerning: boolean read GetUseKerning write SetUseKerning; - end; - -const - //** Max. number of mipmap levels that a TScalableFont can contain - cMaxMipmapLevel = 5; - -type - {** - * Wrapper around TFont to allow font size changes. - * The font is scaled to the requested size by a modelview matrix - * transformation (glScale) and not by rescaling the internal bitmap - * representation. This way changing the size is really fast but the result - * may lack quality on large or small scale factors. - *} - TScalableFont = class(TFont) - private - procedure ResetIntern(); - - protected - fScale: single; //**< current height to base-font height ratio - fAspect: single; //**< width to height aspect - fBaseFont: TFont; //**< shortcut for fMipmapFonts[0] - fUseMipmaps: boolean; //**< true if mipmap fonts are generated - /// Mipmap fonts (size[level+1] = size[level]/2) - fMipmapFonts: array[0..cMaxMipmapLevel] of TFont; - - procedure Render(const Text: WideString); override; - procedure Print(const Text: TWideStringArray); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; - - {** - * Callback called for creation of each mipmap font. - * Must be defined by the subclass. - * Mipmaps created by this method are managed and freed by TScalableFont. - *} - function CreateMipmap(Level: integer; Scale: single): TFont; virtual; abstract; - - {** - * Returns the mipmap level considering the current scale and projection - * matrix. - *} - function GetMipmapLevel(): integer; - - {** - * Returns the scale applied to the given mipmap font. - * fScale * fBaseFont.Height / fMipmapFont[Level].Height - *} - function GetMipmapScale(Level: integer): single; - - {** - * Chooses the mipmap that looks nicest with current scale and projection - * matrix. - *} - function ChooseMipmapFont(): TFont; - - procedure SetHeight(Height: single); virtual; - function GetHeight(): single; override; - procedure SetAspect(Aspect: single); virtual; - function GetAspect(): single; virtual; - function GetAscender(): single; override; - function GetDescender(): single; override; - procedure SetLineSpacing(Spacing: single); override; - function GetLineSpacing(): single; override; - procedure SetGlyphSpacing(Spacing: single); override; - function GetGlyphSpacing(): single; override; - procedure SetReflectionSpacing(Spacing: single); override; - function GetReflectionSpacing(): single; override; - procedure SetStyle(Style: TFontStyle); override; - function GetStyle(): TFontStyle; override; - function GetUnderlinePosition(): single; override; - function GetUnderlineThickness(): single; override; - procedure SetUseKerning(Enable: boolean); override; - - public - {** - * Creates a wrapper to make the base-font Font scalable. - * If UseMipmaps is set to true smaller fonts are created so that a - * resized (Height property changed) font looks nicer. - * The font passed is managed and freed by TScalableFont. - *} - constructor Create(Font: TFont; UseMipmaps: boolean); overload; - - {** - * Frees memory. The fonts passed on Create() and mipmap creation - * are freed too. - *} - destructor Destroy(); override; - - {** @seealso TFont.Reset } - procedure Reset(); override; - - {** Font height } - property Height: single read GetHeight write SetHeight; - {** Factor for font stretching (NewWidth = Width*Aspect), 1.0 by default } - property Aspect: single read GetAspect write SetAspect; - end; - - {** - * Table for storage of max. 256 glyphs. - * Used for the second cache level. Indexed by the LSB of the WideChar - * char-code. - *} - PGlyphTable = ^TGlyphTable; - TGlyphTable = array[0..255] of TGlyph; - - {** - * Cache for glyphs of a single font. - * The cached glyphs are stored inside a hash-list. - * Hashing is performed in two steps: - * 1. the least significant byte (LSB) of the WideChar character code - * is removed (shr 8) and the result (we call it BaseCode here) looked up in - * the hash-list. - * 2. Each entry of the hash-list contains a table with max. 256 entries. - * The LSB of the char-code of a glyph is the table-offset of that glyph. - *} - TGlyphCache = class - private - fHash: TList; - - {** - * Finds a glyph-table storing cached glyphs with base-code BaseCode - * (= upper char-code bytes) in the hash-list and returns the table and - * its index. - * @param(InsertPos the position of the tyble in the list if it was found, - * otherwise the position the table should be inserted) - *} - function FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; - - public - constructor Create(); - destructor Destroy(); override; - - {** - * Add glyph Glyph with char-code ch to the cache. - * @returns @true on success, @false otherwise - *} - function AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; - - {** - * Removes the glyph with char-code ch from the cache. - *} - procedure DeleteGlyph(ch: WideChar); - - {** - * Removes the glyph with char-code ch from the cache. - *} - function GetGlyph(ch: WideChar): TGlyph; - - {** - * Checks if a glyph with char-code ch is cached. - *} - function HasGlyph(ch: WideChar): boolean; - - {** - * Remove and free all cached glyphs. If KeepBaseSet is set to - * true, cached characters in the range 0..255 will not be flushed. - *} - procedure FlushCache(KeepBaseSet: boolean); - end; - - {** - * Entry of a glyph-cache's (TGlyphCache) hash. - * Stores a BaseCode (upper-bytes of a glyph's char-code) and a table - * with all glyphs cached at the moment with that BaseCode. - *} - TGlyphCacheHashEntry = class - private - fBaseCode: cardinal; - public - GlyphTable: TGlyphTable; - - constructor Create(BaseCode: cardinal); - - {** Base-code (upper-bytes) of the glyphs stored in this entry's table } - property BaseCode: cardinal read fBaseCode; - end; - - TCachedFont = class(TFont) - protected - fCache: TGlyphCache; - - {** - * Retrieves a cached glyph with char-code ch from cache. - * If the glyph is not already cached, it is loaded with LoadGlyph(). - *} - function GetGlyph(ch: WideChar): TGlyph; - - {** - * Callback to create (load) a glyph with char-code ch. - * Implemented by subclasses. - *} - function LoadGlyph(ch: WideChar): TGlyph; virtual; abstract; - - public - constructor Create(); - destructor Destroy(); override; - - {** - * Remove and free all cached glyphs. If KeepBaseSet is set to - * true, the base glyphs are not be flushed. - * @seealso TGlyphCache.FlushCache - *} - procedure FlushCache(KeepBaseSet: boolean); - end; - - TFTFont = class; - - {** - * Freetype glyph. - * Each glyph stores a texture with the glyph's image. - *} - TFTGlyph = class(TGlyph) - private - fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code) - fDisplayList: GLuint; //**< Display-list ID - fTexture: GLuint; //**< Texture ID - fBitmapCoords: TBitmapCoords; //**< Left/Top offset and Width/Height of the bitmap (in pixels) - fTexOffset: TPositionDbl; //**< Right and bottom texture offset for removal of power-of-2 padding - fTexSize: TTextureSize; //**< Texture size in pixels - - fFont: TFTFont; //**< Font associated with this glyph - fAdvance: TPositionDbl; //**< Advance width of this glyph - fBounds: TBoundsDbl; //**< Glyph bounds - fOutset: single; //**< Extrusion outset - - {** - * Extrudes the outline of a glyph's bitmap stored in TexBuffer with size - * fTexSize by Outset pixels. - * This is useful to create bold or outlined fonts. - * TexBuffer must be 2*Ceil(Outset) pixels higher and wider than the - * original glyph bitmap, otherwise the glyph borders cannot be extruded - * correctly. - * The bitmap must be 2* pixels wider and higher than the - * original glyph's bitmap with the latter centered in it. - *} - procedure Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); - - {** - * Creates an OpenGL texture (and display list) for the glyph. - * The glyph's and bitmap's metrics are set correspondingly. - * @param LoadFlags flags passed to FT_Load_Glyph() - * @raises Exception if the glyph could not be initialized - *} - procedure CreateTexture(LoadFlags: FT_Int32); - - protected - function GetAdvance(): TPositionDbl; override; - function GetBounds(): TBoundsDbl; override; - - public - {** - * Creates a glyph with char-code ch from font Font. - * @param LoadFlags flags passed to FT_Load_Glyph() - *} - constructor Create(Font: TFTFont; ch: WideChar; Outset: single; - LoadFlags: FT_Int32); - destructor Destroy(); override; - - {** Renders the glyph (normal render pass) } - procedure Render(UseDisplayLists: boolean); override; - {** Renders the glyph's reflection } - procedure RenderReflection(); override; - - {** Freetype specific char-index (<> char-code) } - property CharIndex: FT_UInt read fCharIndex; - end; - - {** - * Freetype font class. - *} - TFTFont = class(TCachedFont) - private - procedure ResetIntern(); - - protected - fFilename: string; //**< filename of the font-file - fSize: integer; //**< Font base size (in pixels) - fOutset: single; //**< size of outset extrusion (in pixels) - fFace: FT_Face; //**< Holds the height of the font - fLoadFlags: FT_Int32; //**< FT glpyh load-flags - fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio - fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing - - {** @seealso TCachedFont.LoadGlyph } - function LoadGlyph(ch: WideChar): TGlyph; override; - - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; - - function GetHeight(): single; override; - function GetAscender(): single; override; - function GetDescender(): single; override; - function GetUnderlinePosition(): single; override; - function GetUnderlineThickness(): single; override; - - property Face: FT_Face read fFace; - - public - {** - * Creates a font of size Size (in pixels) from the file Filename. - * If Outset (in pixels) is set to a value > 0 the glyphs will be extruded - * at their borders. Use it for e.g. a bold effect. - * @param LoadFlags flags passed to FT_Load_Glyph() - * @raises Exception if the font-file could not be loaded - *} - constructor Create(const Filename: string; - Size: integer; Outset: single = 0.0; - LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); - - {** - * Frees all resources associated with the font. - *} - destructor Destroy(); override; - - {** @seealso TFont.Reset } - procedure Reset(); override; - - {** Size of the base font } - property Size: integer read fSize; - {** Outset size } - property Outset: single read fOutset; - end; - - TFTScalableFont = class(TScalableFont) - protected - function GetOutset(): single; virtual; - function CreateMipmap(Level: integer; Scale: single): TFont; override; - - public - {** - * Creates a scalable font of size Size (in pixels) from the file Filename. - * OutsetAmount is the ratio of the glyph extrusion. - * The extrusion in pixels is Size*OutsetAmount - * (0.0 -> no extrusion, 0.1 -> 10%). - *} - constructor Create(const Filename: string; - Size: integer; OutsetAmount: single = 0.0; - UseMipmaps: boolean = true); - - {** @seealso TGlyphCache.FlushCache } - procedure FlushCache(KeepBaseSet: boolean); - - {** Outset size (in pixels) of the scaled font } - property Outset: single read GetOutset; - end; - - - {** - * Represents a freetype font with an additional outline around its glyphs. - * The outline size is passed on creation and cannot be changed later. - *} - TFTOutlineFont = class(TFont) - private - fFilename: string; - fSize: integer; - fOutset: single; - fInnerFont, fOutlineFont: TFTFont; - fOutlineColor: TGLColor; - - procedure ResetIntern(); - - protected - procedure DrawUnderline(const Text: WideString); override; - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; - - function GetHeight(): single; override; - function GetAscender(): single; override; - function GetDescender(): single; override; - procedure SetLineSpacing(Spacing: single); override; - procedure SetGlyphSpacing(Spacing: single); override; - procedure SetReflectionSpacing(Spacing: single); override; - procedure SetStyle(Style: TFontStyle); override; - function GetStyle(): TFontStyle; override; - function GetUnderlinePosition(): single; override; - function GetUnderlineThickness(): single; override; - procedure SetUseKerning(Enable: boolean); override; - procedure SetReflectionPass(Enable: boolean); override; - - public - constructor Create(const Filename: string; - Size: integer; Outset: single; - LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); - destructor Destroy; override; - - {** Sets the color of the outline } - procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = 1.0); - - {** @seealso TGlyphCache.FlushCache } - procedure FlushCache(KeepBaseSet: boolean); - - {** @seealso TFont.Reset } - procedure Reset(); override; - - {** Size of the base font } - property Size: integer read fSize; - {** Outset size } - property Outset: single read fOutset; - end; - - {** - * Wrapper around TOutlineFont to allow font resizing. - * @seealso TScalableFont - *} - TFTScalableOutlineFont = class(TScalableFont) - protected - function GetOutset(): single; virtual; - function CreateMipmap(Level: integer; Scale: single): TFont; override; - - public - constructor Create(const Filename: string; - Size: integer; OutsetAmount: single; - UseMipmaps: boolean = true); - - {** Sets the color of the outline } - procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = 1.0); - - {** @seealso TGlyphCache.FlushCache } - procedure FlushCache(KeepBaseSet: boolean); - - {** Outset size } - property Outset: single read GetOutset; - end; - -{$IFDEF BITMAP_FONT} - - {** - * A bitmapped font loads it's glyphs from a bitmap and stores them in a - * texture. Unicode characters are not supported (but could be by supporting - * multiple textures each storing a subset of unicode glyphs). - * For backward compatibility only. - *} - TBitmapFont = class(TFont) - private - fTex: TTexture; - fTexSize: integer; - fBaseline: integer; - fAscender: integer; - fDescender: integer; - fWidths: array[0..255] of byte; //**< half widths - fOutline: integer; - fTempColor: TGLColor; //**< colours for the reflection - - procedure ResetIntern(); - - procedure RenderChar(ch: WideChar; var AdvanceX: real); - - {** - * Load font widths from an info file. - * @param InfoFile the name of the info (.dat) file - * @raises Exception if the file is corrupted - *} - procedure LoadFontInfo(const InfoFile: string); - - protected - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; - - function GetHeight(): single; override; - function GetAscender(): single; override; - function GetDescender(): single; override; - function GetUnderlinePosition(): single; override; - function GetUnderlineThickness(): single; override; - - public - {** - * Creates a bitmapped font from image Filename and font width info - * loaded from the corresponding file with ending .dat. - * @param(Baseline y-coord of the baseline given in cartesian coords - * (y-axis up) and from the lower edge of the glyphs bounding box) - * @param(Ascender pixels from baseline to top of highest glyph) - *} - constructor Create(const Filename: string; Outline: integer; - Baseline, Ascender, Descender: integer); - destructor Destroy(); override; - - {** - * Corrects font widths provided by the info file. - * NewWidth := Width * WidthMult + WidthAdd - *} - procedure CorrectWidths(WidthMult: real; WidthAdd: integer); - - {** @seealso TFont.Reset } - procedure Reset(); override; - end; - -{$ENDIF BITMAP_FONT} - - TFreeType = class - public - {** - * Returns a pointer to the freetype library singleton. - * If non exists, freetype will be initialized. - * @raises Exception if initialization failed - *} - class function GetLibrary(): FT_Library; - class procedure FreeLibrary(); - end; - - -implementation - -uses Types; - -const - //** shear factor used for the italic effect (bigger value -> more bending) - cShearFactor = 0.25; - cShearMatrix: array[0..15] of GLfloat = ( - 1, 0, 0, 0, - cShearFactor, 1, 0, 0, - 0, 0, 1, 0, - 0, 0, 0, 1 - ); - cShearMatrixInv: array[0..15] of GLfloat = ( - 1, 0, 0, 0, - -cShearFactor, 1, 0, 0, - 0, 0, 1, 0, - 0, 0, 0, 1 - ); - -var - LibraryInst: FT_Library; - -function NewGLColor(r, g, b, a: GLfloat): TGLColor; -begin - Result.r := r; - Result.g := g; - Result.b := b; - Result.a := a; -end; - -{** - * Returns the first power of 2 >= Value. - *} -function NextPowerOf2(Value: integer): integer; {$IFDEF HasInline}inline;{$ENDIF} -begin - Result := 1; - while (Result < Value) do - Result := Result shl 1; -end; - - -{* - * TFont - *} - -constructor TFont.Create(); -begin - inherited; - ResetIntern(); -end; - -destructor TFont.Destroy(); -begin - inherited; -end; - -procedure TFont.ResetIntern(); -begin - fStyle := []; - fUseKerning := true; - fGlyphSpacing := 0.0; - fReflectionPass := false; - - // must be set by subclasses - fLineSpacing := 0.0; - fReflectionSpacing := 0.0; -end; - -procedure TFont.Reset(); -begin - ResetIntern(); -end; - -procedure TFont.SplitLines(const Text: UTF8String; var Lines: TWideStringArray); -var - LineList: TStringList; - LineIndex: integer; -begin - // split lines on newline (there is no WideString version of ExtractStrings) - LineList := TStringList.Create(); - ExtractStrings([#13], [], PChar(Text), LineList); - - // create an array of WideStrins from the UTF-8 string-list - SetLength(Lines, LineList.Count); - for LineIndex := 0 to LineList.Count-1 do - Lines[LineIndex] := UTF8Decode(LineList[LineIndex]); - LineList.Free(); -end; - -function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl; -var - LineArray: TWideStringArray; -begin - SplitLines(Text, LineArray); - Result := BBox(LineArray, Advance); - SetLength(LineArray, 0); -end; - -function TFont.BBox(const Text: WideString; Advance: boolean): TBoundsDbl; -begin - Result := BBox(UTF8Encode(Text), Advance); -end; - -procedure TFont.Print(const Text: TWideStringArray); -var - LineIndex: integer; -begin - // recursively call this function to draw reflected text - if ((Reflect in Style) and not ReflectionPass) then - begin - ReflectionPass := true; - Print(Text); - ReflectionPass := false; - end; - - // store current color, enable-flags, matrix-mode - glPushAttrib(GL_CURRENT_BIT or GL_ENABLE_BIT or GL_TRANSFORM_BIT); - - // set OpenGL state - glMatrixMode(GL_MODELVIEW); - glDisable(GL_DEPTH_TEST); - glEnable(GL_BLEND); - glEnable(GL_TEXTURE_2D); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - { - // TODO: just draw texels with alpha > 0 to avoid setting z-buffer for them? - glAlphaFunc(GL_GREATER, 0); - glEnable(GL_ALPHA_TEST); - - //TODO: Do we need depth-testing? - if (ReflectionPass) then - begin - glDepthMask(0); - glEnable(GL_DEPTH_TEST); - end; - } - - {$IFDEF FLIP_YAXIS} - glPushMatrix(); - glScalef(1, -1, 1); - {$ENDIF} - - // display text - for LineIndex := 0 to High(Text) do - begin - glPushMatrix(); - - // move to baseline - glTranslatef(0, -LineSpacing*LineIndex, 0); - - if ((Underline in Style) and not ReflectionPass) then - begin - glDisable(GL_TEXTURE_2D); - DrawUnderline(Text[LineIndex]); - glEnable(GL_TEXTURE_2D); - end; - - // draw reflection - if (ReflectionPass) then - begin - // set reflection spacing - glTranslatef(0, -ReflectionSpacing, 0); - // flip y-axis - glScalef(1, -1, 1); - end; - - // shear for italic effect - if (Italic in Style) then - glMultMatrixf(@cShearMatrix); - + procedure DrawUnderline(const Text: WideString); virtual; + + {** + * Renders (one) line of text. + *} + procedure Render(const Text: WideString); virtual; abstract; + + {** + * Returns the bounds of text-lines contained in Text. + * @param(Advance if true the right bound is set to the advance instead + * of the minimal right bound.) + *} + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract; + + {** + * Resets all user settings to default values. + * Override methods should always call the inherited version. + *} + procedure Reset(); virtual; + + function GetHeight(): single; virtual; abstract; + function GetAscender(): single; virtual; abstract; + function GetDescender(): single; virtual; abstract; + procedure SetLineSpacing(Spacing: single); virtual; + function GetLineSpacing(): single; virtual; + procedure SetGlyphSpacing(Spacing: single); virtual; + function GetGlyphSpacing(): single; virtual; + procedure SetReflectionSpacing(Spacing: single); virtual; + function GetReflectionSpacing(): single; virtual; + procedure SetStyle(Style: TFontStyle); virtual; + function GetStyle(): TFontStyle; virtual; + function GetUnderlinePosition(): single; virtual; abstract; + function GetUnderlineThickness(): single; virtual; abstract; + procedure SetUseKerning(Enable: boolean); virtual; + function GetUseKerning(): boolean; virtual; + procedure SetReflectionPass(Enable: boolean); virtual; + + {** Returns true if the current render-pass is used to draw the reflection } + property ReflectionPass: boolean read fReflectionPass write SetReflectionPass; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Prints a text. + *} + procedure Print(const Text: WideString); overload; + {** UTF-8 version of @link(Print) } + procedure Print(const Text: string); overload; + + {** + * Calculates the bounding box (width and height) around Text. + * Works with Italic and Underline styles but reflections created + * with the Reflect style are not considered. + * Note that the width might differ due to kerning with appended text, + * e.g. Width('VA') <= Width('V') + Width('A'). + * @param Advance if set to true, Result.Right is set to the advance of + * the given text rather than the min. right border. The advance width is + * bigger than the text's width as it additionally contains the advance + * and glyph-spacing of the last character. + *} + function BBox(const Text: WideString; Advance: boolean = true): TBoundsDbl; overload; + {** UTF-8 version of @link(BBox) } + function BBox(const Text: UTF8String; Advance: boolean = true): TBoundsDbl; overload; + + {** Font height } + property Height: single read GetHeight; + {** Vertical distance from baseline to top of glyph } + property Ascender: single read GetAscender; + {** Vertical distance from baseline to bottom of glyph } + property Descender: single read GetDescender; + {** Vertical distance between two baselines } + property LineSpacing: single read GetLineSpacing write SetLineSpacing; + {** Space between end and start of next glyph added to the advance width } + property GlyphSpacing: single read GetGlyphSpacing write SetGlyphSpacing; + {** Distance between normal baseline and baseline of the reflection } + property ReflectionSpacing: single read GetReflectionSpacing write SetReflectionSpacing; + {** Font style (italic/underline/...) } + property Style: TFontStyle read GetStyle write SetStyle; + {** If set to true (default) kerning will be used if available } + property UseKerning: boolean read GetUseKerning write SetUseKerning; + end; + +const + //** Max. number of mipmap levels that a TScalableFont can contain + cMaxMipmapLevel = 5; + +type + {** + * Wrapper around TFont to allow font size changes. + * The font is scaled to the requested size by a modelview matrix + * transformation (glScale) and not by rescaling the internal bitmap + * representation. This way changing the size is really fast but the result + * may lack quality on large or small scale factors. + *} + TScalableFont = class(TFont) + private + procedure ResetIntern(); + + protected + fScale: single; //**< current height to base-font height ratio + fAspect: single; //**< width to height aspect + fBaseFont: TFont; //**< shortcut for fMipmapFonts[0] + fUseMipmaps: boolean; //**< true if mipmap fonts are generated + /// Mipmap fonts (size[level+1] = size[level]/2) + fMipmapFonts: array[0..cMaxMipmapLevel] of TFont; + + procedure Render(const Text: WideString); override; + procedure Print(const Text: TWideStringArray); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + {** + * Callback called for creation of each mipmap font. + * Must be defined by the subclass. + * Mipmaps created by this method are managed and freed by TScalableFont. + *} + function CreateMipmap(Level: integer; Scale: single): TFont; virtual; abstract; + + {** + * Returns the mipmap level considering the current scale and projection + * matrix. + *} + function GetMipmapLevel(): integer; + + {** + * Returns the scale applied to the given mipmap font. + * fScale * fBaseFont.Height / fMipmapFont[Level].Height + *} + function GetMipmapScale(Level: integer): single; + + {** + * Chooses the mipmap that looks nicest with current scale and projection + * matrix. + *} + function ChooseMipmapFont(): TFont; + + procedure SetHeight(Height: single); virtual; + function GetHeight(): single; override; + procedure SetAspect(Aspect: single); virtual; + function GetAspect(): single; virtual; + function GetAscender(): single; override; + function GetDescender(): single; override; + procedure SetLineSpacing(Spacing: single); override; + function GetLineSpacing(): single; override; + procedure SetGlyphSpacing(Spacing: single); override; + function GetGlyphSpacing(): single; override; + procedure SetReflectionSpacing(Spacing: single); override; + function GetReflectionSpacing(): single; override; + procedure SetStyle(Style: TFontStyle); override; + function GetStyle(): TFontStyle; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + procedure SetUseKerning(Enable: boolean); override; + + public + {** + * Creates a wrapper to make the base-font Font scalable. + * If UseMipmaps is set to true smaller fonts are created so that a + * resized (Height property changed) font looks nicer. + * The font passed is managed and freed by TScalableFont. + *} + constructor Create(Font: TFont; UseMipmaps: boolean); overload; + + {** + * Frees memory. The fonts passed on Create() and mipmap creation + * are freed too. + *} + destructor Destroy(); override; + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Font height } + property Height: single read GetHeight write SetHeight; + {** Factor for font stretching (NewWidth = Width*Aspect), 1.0 by default } + property Aspect: single read GetAspect write SetAspect; + end; + + {** + * Table for storage of max. 256 glyphs. + * Used for the second cache level. Indexed by the LSB of the WideChar + * char-code. + *} + PGlyphTable = ^TGlyphTable; + TGlyphTable = array[0..255] of TGlyph; + + {** + * Cache for glyphs of a single font. + * The cached glyphs are stored inside a hash-list. + * Hashing is performed in two steps: + * 1. the least significant byte (LSB) of the WideChar character code + * is removed (shr 8) and the result (we call it BaseCode here) looked up in + * the hash-list. + * 2. Each entry of the hash-list contains a table with max. 256 entries. + * The LSB of the char-code of a glyph is the table-offset of that glyph. + *} + TGlyphCache = class + private + fHash: TList; + + {** + * Finds a glyph-table storing cached glyphs with base-code BaseCode + * (= upper char-code bytes) in the hash-list and returns the table and + * its index. + * @param(InsertPos the position of the tyble in the list if it was found, + * otherwise the position the table should be inserted) + *} + function FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Add glyph Glyph with char-code ch to the cache. + * @returns @true on success, @false otherwise + *} + function AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; + + {** + * Removes the glyph with char-code ch from the cache. + *} + procedure DeleteGlyph(ch: WideChar); + + {** + * Removes the glyph with char-code ch from the cache. + *} + function GetGlyph(ch: WideChar): TGlyph; + + {** + * Checks if a glyph with char-code ch is cached. + *} + function HasGlyph(ch: WideChar): boolean; + + {** + * Remove and free all cached glyphs. If KeepBaseSet is set to + * true, cached characters in the range 0..255 will not be flushed. + *} + procedure FlushCache(KeepBaseSet: boolean); + end; + + {** + * Entry of a glyph-cache's (TGlyphCache) hash. + * Stores a BaseCode (upper-bytes of a glyph's char-code) and a table + * with all glyphs cached at the moment with that BaseCode. + *} + TGlyphCacheHashEntry = class + private + fBaseCode: cardinal; + public + GlyphTable: TGlyphTable; + + constructor Create(BaseCode: cardinal); + + {** Base-code (upper-bytes) of the glyphs stored in this entry's table } + property BaseCode: cardinal read fBaseCode; + end; + + TCachedFont = class(TFont) + protected + fCache: TGlyphCache; + + {** + * Retrieves a cached glyph with char-code ch from cache. + * If the glyph is not already cached, it is loaded with LoadGlyph(). + *} + function GetGlyph(ch: WideChar): TGlyph; + + {** + * Callback to create (load) a glyph with char-code ch. + * Implemented by subclasses. + *} + function LoadGlyph(ch: WideChar): TGlyph; virtual; abstract; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Remove and free all cached glyphs. If KeepBaseSet is set to + * true, the base glyphs are not be flushed. + * @seealso TGlyphCache.FlushCache + *} + procedure FlushCache(KeepBaseSet: boolean); + end; + + TFTFont = class; + + {** + * Freetype glyph. + * Each glyph stores a texture with the glyph's image. + *} + TFTGlyph = class(TGlyph) + private + fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code) + fDisplayList: GLuint; //**< Display-list ID + fTexture: GLuint; //**< Texture ID + fBitmapCoords: TBitmapCoords; //**< Left/Top offset and Width/Height of the bitmap (in pixels) + fTexOffset: TPositionDbl; //**< Right and bottom texture offset for removal of power-of-2 padding + fTexSize: TTextureSize; //**< Texture size in pixels + + fFont: TFTFont; //**< Font associated with this glyph + fAdvance: TPositionDbl; //**< Advance width of this glyph + fBounds: TBoundsDbl; //**< Glyph bounds + fOutset: single; //**< Extrusion outset + + {** + * Extrudes the outline of a glyph's bitmap stored in TexBuffer with size + * fTexSize by Outset pixels. + * This is useful to create bold or outlined fonts. + * TexBuffer must be 2*Ceil(Outset) pixels higher and wider than the + * original glyph bitmap, otherwise the glyph borders cannot be extruded + * correctly. + * The bitmap must be 2* pixels wider and higher than the + * original glyph's bitmap with the latter centered in it. + *} + procedure Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); + + {** + * Creates an OpenGL texture (and display list) for the glyph. + * The glyph's and bitmap's metrics are set correspondingly. + * @param LoadFlags flags passed to FT_Load_Glyph() + * @raises Exception if the glyph could not be initialized + *} + procedure CreateTexture(LoadFlags: FT_Int32); + + protected + function GetAdvance(): TPositionDbl; override; + function GetBounds(): TBoundsDbl; override; + + public + {** + * Creates a glyph with char-code ch from font Font. + * @param LoadFlags flags passed to FT_Load_Glyph() + *} + constructor Create(Font: TFTFont; ch: WideChar; Outset: single; + LoadFlags: FT_Int32); + destructor Destroy(); override; + + {** Renders the glyph (normal render pass) } + procedure Render(UseDisplayLists: boolean); override; + {** Renders the glyph's reflection } + procedure RenderReflection(); override; + + {** Freetype specific char-index (<> char-code) } + property CharIndex: FT_UInt read fCharIndex; + end; + + {** + * Freetype font class. + *} + TFTFont = class(TCachedFont) + private + procedure ResetIntern(); + + protected + fFilename: string; //**< filename of the font-file + fSize: integer; //**< Font base size (in pixels) + fOutset: single; //**< size of outset extrusion (in pixels) + fFace: FT_Face; //**< Holds the height of the font + fLoadFlags: FT_Int32; //**< FT glpyh load-flags + fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio + fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing + + {** @seealso TCachedFont.LoadGlyph } + function LoadGlyph(ch: WideChar): TGlyph; override; + + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + + property Face: FT_Face read fFace; + + public + {** + * Creates a font of size Size (in pixels) from the file Filename. + * If Outset (in pixels) is set to a value > 0 the glyphs will be extruded + * at their borders. Use it for e.g. a bold effect. + * @param LoadFlags flags passed to FT_Load_Glyph() + * @raises Exception if the font-file could not be loaded + *} + constructor Create(const Filename: string; + Size: integer; Outset: single = 0.0; + LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); + + {** + * Frees all resources associated with the font. + *} + destructor Destroy(); override; + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Size of the base font } + property Size: integer read fSize; + {** Outset size } + property Outset: single read fOutset; + end; + + TFTScalableFont = class(TScalableFont) + protected + function GetOutset(): single; virtual; + function CreateMipmap(Level: integer; Scale: single): TFont; override; + + public + {** + * Creates a scalable font of size Size (in pixels) from the file Filename. + * OutsetAmount is the ratio of the glyph extrusion. + * The extrusion in pixels is Size*OutsetAmount + * (0.0 -> no extrusion, 0.1 -> 10%). + *} + constructor Create(const Filename: string; + Size: integer; OutsetAmount: single = 0.0; + UseMipmaps: boolean = true); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** Outset size (in pixels) of the scaled font } + property Outset: single read GetOutset; + end; + + + {** + * Represents a freetype font with an additional outline around its glyphs. + * The outline size is passed on creation and cannot be changed later. + *} + TFTOutlineFont = class(TFont) + private + fFilename: string; + fSize: integer; + fOutset: single; + fInnerFont, fOutlineFont: TFTFont; + fOutlineColor: TGLColor; + + procedure ResetIntern(); + + protected + procedure DrawUnderline(const Text: WideString); override; + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + procedure SetLineSpacing(Spacing: single); override; + procedure SetGlyphSpacing(Spacing: single); override; + procedure SetReflectionSpacing(Spacing: single); override; + procedure SetStyle(Style: TFontStyle); override; + function GetStyle(): TFontStyle; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + procedure SetUseKerning(Enable: boolean); override; + procedure SetReflectionPass(Enable: boolean); override; + + public + constructor Create(const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); + destructor Destroy; override; + + {** + * Sets the color of the outline. + * If the alpha component is < 0, OpenGL's current alpha value will be + * used. + *} + procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = -1.0); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Size of the base font } + property Size: integer read fSize; + {** Outset size } + property Outset: single read fOutset; + end; + + {** + * Wrapper around TOutlineFont to allow font resizing. + * @seealso TScalableFont + *} + TFTScalableOutlineFont = class(TScalableFont) + protected + function GetOutset(): single; virtual; + function CreateMipmap(Level: integer; Scale: single): TFont; override; + + public + constructor Create(const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean = true); + + {** @seealso TFTOutlineFont.SetOutlineColor } + procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = -1.0); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** Outset size } + property Outset: single read GetOutset; + end; + +{$IFDEF BITMAP_FONT} + + {** + * A bitmapped font loads it's glyphs from a bitmap and stores them in a + * texture. Unicode characters are not supported (but could be by supporting + * multiple textures each storing a subset of unicode glyphs). + * For backward compatibility only. + *} + TBitmapFont = class(TFont) + private + fTex: TTexture; + fTexSize: integer; + fBaseline: integer; + fAscender: integer; + fDescender: integer; + fWidths: array[0..255] of byte; //**< half widths + fOutline: integer; + fTempColor: TGLColor; //**< colours for the reflection + + procedure ResetIntern(); + + procedure RenderChar(ch: WideChar; var AdvanceX: real); + + {** + * Load font widths from an info file. + * @param InfoFile the name of the info (.dat) file + * @raises Exception if the file is corrupted + *} + procedure LoadFontInfo(const InfoFile: string); + + protected + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + + public + {** + * Creates a bitmapped font from image Filename and font width info + * loaded from the corresponding file with ending .dat. + * @param(Baseline y-coord of the baseline given in cartesian coords + * (y-axis up) and from the lower edge of the glyphs bounding box) + * @param(Ascender pixels from baseline to top of highest glyph) + *} + constructor Create(const Filename: string; Outline: integer; + Baseline, Ascender, Descender: integer); + destructor Destroy(); override; + + {** + * Corrects font widths provided by the info file. + * NewWidth := Width * WidthMult + WidthAdd + *} + procedure CorrectWidths(WidthMult: real; WidthAdd: integer); + + {** @seealso TFont.Reset } + procedure Reset(); override; + end; + +{$ENDIF BITMAP_FONT} + + TFreeType = class + public + {** + * Returns a pointer to the freetype library singleton. + * If non exists, freetype will be initialized. + * @raises Exception if initialization failed + *} + class function GetLibrary(): FT_Library; + class procedure FreeLibrary(); + end; + + +implementation + +uses Types; + +const + //** shear factor used for the italic effect (bigger value -> more bending) + cShearFactor = 0.25; + cShearMatrix: array[0..15] of GLfloat = ( + 1, 0, 0, 0, + cShearFactor, 1, 0, 0, + 0, 0, 1, 0, + 0, 0, 0, 1 + ); + cShearMatrixInv: array[0..15] of GLfloat = ( + 1, 0, 0, 0, + -cShearFactor, 1, 0, 0, + 0, 0, 1, 0, + 0, 0, 0, 1 + ); + +var + LibraryInst: FT_Library; + +function NewGLColor(r, g, b, a: GLfloat): TGLColor; +begin + Result.r := r; + Result.g := g; + Result.b := b; + Result.a := a; +end; + +{** + * Returns the first power of 2 >= Value. + *} +function NextPowerOf2(Value: integer): integer; {$IFDEF HasInline}inline;{$ENDIF} +begin + Result := 1; + while (Result < Value) do + Result := Result shl 1; +end; + + +{* + * TFont + *} + +constructor TFont.Create(); +begin + inherited; + ResetIntern(); +end; + +destructor TFont.Destroy(); +begin + inherited; +end; + +procedure TFont.ResetIntern(); +begin + fStyle := []; + fUseKerning := true; + fGlyphSpacing := 0.0; + fReflectionPass := false; + + // must be set by subclasses + fLineSpacing := 0.0; + fReflectionSpacing := 0.0; +end; + +procedure TFont.Reset(); +begin + ResetIntern(); +end; + +procedure TFont.SplitLines(const Text: UTF8String; var Lines: TWideStringArray); +var + LineList: TStringList; + LineIndex: integer; +begin + // split lines on newline (there is no WideString version of ExtractStrings) + LineList := TStringList.Create(); + ExtractStrings([#13], [], PChar(Text), LineList); + + // create an array of WideStrins from the UTF-8 string-list + SetLength(Lines, LineList.Count); + for LineIndex := 0 to LineList.Count-1 do + Lines[LineIndex] := UTF8Decode(LineList[LineIndex]); + LineList.Free(); +end; + +function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl; +var + LineArray: TWideStringArray; +begin + SplitLines(Text, LineArray); + Result := BBox(LineArray, Advance); + SetLength(LineArray, 0); +end; + +function TFont.BBox(const Text: WideString; Advance: boolean): TBoundsDbl; +begin + Result := BBox(UTF8Encode(Text), Advance); +end; + +procedure TFont.Print(const Text: TWideStringArray); +var + LineIndex: integer; +begin + // recursively call this function to draw reflected text + if ((Reflect in Style) and not ReflectionPass) then + begin + ReflectionPass := true; + Print(Text); + ReflectionPass := false; + end; + + // store current color, enable-flags, matrix-mode + glPushAttrib(GL_CURRENT_BIT or GL_ENABLE_BIT or GL_TRANSFORM_BIT); + + // set OpenGL state + glMatrixMode(GL_MODELVIEW); + glDisable(GL_DEPTH_TEST); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + { + // TODO: just draw texels with alpha > 0 to avoid setting z-buffer for them? + glAlphaFunc(GL_GREATER, 0); + glEnable(GL_ALPHA_TEST); + + //TODO: Do we need depth-testing? + if (ReflectionPass) then + begin + glDepthMask(0); + glEnable(GL_DEPTH_TEST); + end; + } + + {$IFDEF FLIP_YAXIS} + glPushMatrix(); + glScalef(1, -1, 1); + {$ENDIF} + + // display text + for LineIndex := 0 to High(Text) do + begin + glPushMatrix(); + + // move to baseline + glTranslatef(0, -LineSpacing*LineIndex, 0); + + if ((Underline in Style) and not ReflectionPass) then + begin + glDisable(GL_TEXTURE_2D); + DrawUnderline(Text[LineIndex]); + glEnable(GL_TEXTURE_2D); + end; + + // draw reflection + if (ReflectionPass) then + begin + // set reflection spacing + glTranslatef(0, -ReflectionSpacing, 0); + // flip y-axis + glScalef(1, -1, 1); + end; + + // shear for italic effect + if (Italic in Style) then + glMultMatrixf(@cShearMatrix); + // render text line - Render(Text[LineIndex]); - - glPopMatrix(); - end; - - // restore settings - {$IFDEF FLIP_YAXIS} - glPopMatrix(); - {$ENDIF} - glPopAttrib(); -end; - -procedure TFont.Print(const Text: string); -var - LineArray: TWideStringArray; -begin - SplitLines(Text, LineArray); - Print(LineArray); - SetLength(LineArray, 0); -end; - -procedure TFont.Print(const Text: WideString); -begin - Print(UTF8Encode(Text)); -end; - -procedure TFont.DrawUnderline(const Text: WideString); + Render(Text[LineIndex]); + + glPopMatrix(); + end; + + // restore settings + {$IFDEF FLIP_YAXIS} + glPopMatrix(); + {$ENDIF} + glPopAttrib(); +end; + +procedure TFont.Print(const Text: string); +var + LineArray: TWideStringArray; +begin + SplitLines(Text, LineArray); + Print(LineArray); + SetLength(LineArray, 0); +end; + +procedure TFont.Print(const Text: WideString); +begin + Print(UTF8Encode(Text)); +end; + +procedure TFont.DrawUnderline(const Text: WideString); var UnderlineY1, UnderlineY2: single; Bounds: TBoundsDbl; begin - UnderlineY1 := GetUnderlinePosition(); - UnderlineY2 := UnderlineY1 + GetUnderlineThickness(); - Bounds := BBox(Text); - glRectf(Bounds.Left, UnderlineY1, Bounds.Right, UnderlineY2); -end; - -procedure TFont.SetStyle(Style: TFontStyle); -begin - fStyle := Style; -end; - -function TFont.GetStyle(): TFontStyle; -begin - Result := fStyle; -end; - -procedure TFont.SetLineSpacing(Spacing: single); -begin - fLineSpacing := Spacing; -end; - -function TFont.GetLineSpacing(): single; -begin - Result := fLineSpacing; -end; - -procedure TFont.SetGlyphSpacing(Spacing: single); -begin - fGlyphSpacing := Spacing; -end; - -function TFont.GetGlyphSpacing(): single; -begin - Result := fGlyphSpacing; -end; - -procedure TFont.SetReflectionSpacing(Spacing: single); -begin - fReflectionSpacing := Spacing; -end; - -function TFont.GetReflectionSpacing(): single; -begin - Result := fReflectionSpacing; -end; - -procedure TFont.SetUseKerning(Enable: boolean); -begin - fUseKerning := Enable; -end; - -function TFont.GetUseKerning(): boolean; -begin - Result := fUseKerning; -end; - -procedure TFont.SetReflectionPass(Enable: boolean); -begin - fReflectionPass := Enable; -end; - - -{* - * TScalableFont - *} - -constructor TScalableFont.Create(Font: TFont; UseMipmaps: boolean); -var - MipmapLevel: integer; -begin - inherited Create(); - - fBaseFont := Font; - fMipmapFonts[0] := Font; - fUseMipmaps := UseMipmaps; - ResetIntern(); - - // create mipmap fonts if requested - if (UseMipmaps) then - begin - for MipmapLevel := 1 to cMaxMipmapLevel do - begin - fMipmapFonts[MipmapLevel] := CreateMipmap(MipmapLevel, 1/(1 shl MipmapLevel)); - // stop if no smaller mipmap font is returned - if (fMipmapFonts[MipmapLevel] = nil) then - Break; - end; - end; -end; - -destructor TScalableFont.Destroy(); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - fMipmapFonts[Level].Free; - inherited; -end; - -procedure TScalableFont.ResetIntern(); -begin - fScale := 1.0; - fAspect := 1.0; -end; - -procedure TScalableFont.Reset(); -var - Level: integer; -begin - inherited; - ResetIntern(); - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].Reset(); -end; - -{** - * Returns the mipmap level to use with regard to the current projection - * and modelview matrix, font scale and aspect. - * - * Note: - * - for Freetype fonts, hinting and grid-fitting must be disabled, otherwise - * the glyph widths/heights ratios and advance widths of the mipmap fonts - * do not match as they are adjusted sligthly (e.g. an 'a' at size 12px has - * width 12px, but at size 6px width 8px). - * - returned mipmap-level is used for all glyphs of the current text to print. - * This is faster, much easier to handle, since we just need to create - * multiple sized fonts and select the one we need for the mipmap-level and - * it avoids that neighbored glyphs use different mipmap-level which might - * look odd because one glyph might look blurry and the other sharp. - * - * Motivation: - * We do not use OpenGL for mipmapping as the results are very bad. At least - * with automatic mipmap generation (gluBuildMipmaps) the fonts look rather - * blurry. - * Defining our own mipmaps by creating multiple textures with - * for different mimap levels is a pain, as the font size passed to freetype - * is not the size of the bitmaps created and it does not guarantee that a - * glyph bitmap of a font with font-size s/2 is half the size of the font with - * font-size s. If the bitmap size is just a single pixel bigger than the half - * we might need a texture of the next power-of-2 and the texture would not be - * half of the size of the next bigger mipmap. In addition we use a fixed one - * pixel sized border to smooth the texture (see cTexSmoothBorder) and maybe - * an outset that is added to the font, so creating a glyph mipmap that is - * exactly half the size of the next bigger one is a very difficult task. - * - * Solution: - * Use mipmap textures that are not exactly half the size of the next mipmap - * level. OpenGL does not support this (at least not without extensions). - * The trickiest task is to determine the mipmap to use by calculating the - * amount of minification that is performed in this function. - *} -function TScalableFont.GetMipmapLevel(): integer; -var - ModelMatrix, ProjMatrix: T16dArray; - WinCoords: array[0..2, 0..2] of GLdouble; - ViewPortArray: TViewPortArray; - Dist, Dist2: double; - WidthScale, HeightScale: double; -const - // width/height of square used for determining the scale - cTestSize = 10.0; - // an offset to the mipmap-level to adjust the change-over of two consecutive - // mipmap levels. If for example the bias is 0.1 and unbiased level is 1.9 - // the result level will be 2. A bias of 0.5 is equal to rounding. - // With bias=0.1 we prefer larger mipmaps over smaller ones. - cBias = 0.2; -begin - // 1. retrieve current transformation matrices for gluProject - glGetDoublev(GL_MODELVIEW_MATRIX, @ModelMatrix); - glGetDoublev(GL_PROJECTION_MATRIX, @ProjMatrix); - glGetIntegerv(GL_VIEWPORT, @ViewPortArray); - - // 2. project three of the corner points of a square with size cTestSize - // to window coordinates (the square is just a dummy for a glyph) - - // project point (x1, y1) to window corrdinates - gluProject(0, 0, 0, - ModelMatrix, ProjMatrix, ViewPortArray, - @WinCoords[0][0], @WinCoords[0][1], @WinCoords[0][2]); - // project point (x2, y1) to window corrdinates - gluProject(cTestSize, 0, 0, - ModelMatrix, ProjMatrix, ViewPortArray, - @WinCoords[1][0], @WinCoords[1][1], @WinCoords[1][2]); - // project point (x1, y2) to window corrdinates - gluProject(0, cTestSize, 0, - ModelMatrix, ProjMatrix, ViewPortArray, - @WinCoords[2][0], @WinCoords[2][1], @WinCoords[2][2]); - - // 3. Lets see how much the width and height of the square changed. - // Calculate the width and height as displayed on the screen in window - // coordinates and calculate the ratio to the original coordinates in - // modelview space so the ratio gives us the scale (minification here). - - // projected width ||(x1, y1) - (x2, y1)|| - Dist := (WinCoords[0][0] - WinCoords[1][0]); - Dist2 := (WinCoords[0][1] - WinCoords[1][1]); - WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); - - // projected height ||(x1, y1) - (x1, y2)|| - Dist := (WinCoords[0][0] - WinCoords[2][0]); - Dist2 := (WinCoords[0][1] - WinCoords[2][1]); - HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); - - //writeln(Format('Scale %f, %f', [WidthScale, HeightScale])); - - // 4. Now that we have got the scale, take the bigger minification scale - // and get it to a logarithmic scale as each mipmap is 1/2 the size of its - // predecessor (Mipmap_size[i] = Mipmap_size[i-1]/2). - // The result is our mipmap-level = the index of the mipmap to use. - - // Level > 0: Minification; < 0: Magnification - Result := Trunc(Log2(Max(WidthScale, HeightScale)) + cBias); - - // clamp to valid range - if (Result < 0) then - Result := 0; - if (Result > High(fMipmapFonts)) then - Result := High(fMipmapFonts); -end; - -function TScalableFont.GetMipmapScale(Level: integer): single; -begin - if (fMipmapFonts[Level] = nil) then - begin - Result := -1; - Exit; - end; - - Result := fScale * fMipmapFonts[0].Height / fMipmapFonts[Level].Height; -end; - -{** - * Returns the correct mipmap font for the current scale and projection - * matrix. The modelview scale is adjusted to the mipmap level, so - * Result.Print() will display the font in the correct size. - *} -function TScalableFont.ChooseMipmapFont(): TFont; -var - DesiredLevel: integer; - Level: integer; - MipmapScale: single; -begin - Result := nil; - DesiredLevel := GetMipmapLevel(); - - // get the smallest mipmap available for the desired level - // as not all levels must be assigned to a font. - for Level := DesiredLevel downto 0 do - begin - if (fMipmapFonts[Level] <> nil) then - begin - Result := fMipmapFonts[Level]; - Break; - end; - end; - - // since the mipmap font (if level > 0) is smaller than the base-font - // we have to scale to get its size right. - MipmapScale := fMipmapFonts[0].Height/Result.Height; - glScalef(MipmapScale, MipmapScale, 0); -end; - -procedure TScalableFont.Print(const Text: TWideStringArray); -begin - glPushMatrix(); - - // set scale and stretching - glScalef(fScale * fAspect, fScale, 0); - - // print text - if (fUseMipmaps) then - ChooseMipmapFont().Print(Text) - else - fBaseFont.Print(Text); - - glPopMatrix(); -end; - -procedure TScalableFont.Render(const Text: WideString); -begin - Assert(false, 'Unused TScalableFont.Render() was called'); -end; - -function TScalableFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; -begin - Result := fBaseFont.BBox(Text, Advance); - Result.Left := Result.Left * fScale * fAspect; - Result.Right := Result.Right * fScale * fAspect; - Result.Top := Result.Top * fScale; - Result.Bottom := Result.Bottom * fScale; -end; - -procedure TScalableFont.SetHeight(Height: single); -begin - fScale := Height / fBaseFont.GetHeight(); -end; - -function TScalableFont.GetHeight(): single; -begin - Result := fBaseFont.GetHeight() * fScale; -end; - -procedure TScalableFont.SetAspect(Aspect: single); -begin - fAspect := Aspect; -end; - -function TScalableFont.GetAspect(): single; -begin - Result := fAspect; -end; - -function TScalableFont.GetAscender(): single; -begin - Result := fBaseFont.GetAscender() * fScale; -end; - -function TScalableFont.GetDescender(): single; -begin - Result := fBaseFont.GetDescender() * fScale; -end; - -procedure TScalableFont.SetLineSpacing(Spacing: single); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetLineSpacing(Spacing / GetMipmapScale(Level)); -end; - -function TScalableFont.GetLineSpacing(): single; -begin - Result := fBaseFont.GetLineSpacing() * fScale; -end; - -procedure TScalableFont.SetGlyphSpacing(Spacing: single); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetGlyphSpacing(Spacing / GetMipmapScale(Level)); -end; - -function TScalableFont.GetGlyphSpacing(): single; -begin - Result := fBaseFont.GetGlyphSpacing() * fScale; -end; - -procedure TScalableFont.SetReflectionSpacing(Spacing: single); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetReflectionSpacing(Spacing / GetMipmapScale(Level)); -end; - -function TScalableFont.GetReflectionSpacing(): single; -begin - Result := fBaseFont.GetLineSpacing() * fScale; -end; - -procedure TScalableFont.SetStyle(Style: TFontStyle); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetStyle(Style); -end; - -function TScalableFont.GetStyle(): TFontStyle; -begin - Result := fBaseFont.GetStyle(); -end; - -function TScalableFont.GetUnderlinePosition(): single; -begin - Result := fBaseFont.GetUnderlinePosition(); -end; - -function TScalableFont.GetUnderlineThickness(): single; -begin - Result := fBaseFont.GetUnderlinePosition(); -end; - -procedure TScalableFont.SetUseKerning(Enable: boolean); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetUseKerning(Enable); -end; - - -{* - * TCachedFont - *} - -constructor TCachedFont.Create(); -begin - inherited; - fCache := TGlyphCache.Create(); -end; - -destructor TCachedFont.Destroy(); -begin - fCache.Free; - inherited; -end; - -function TCachedFont.GetGlyph(ch: WideChar): TGlyph; -begin - Result := fCache.GetGlyph(ch); - if (Result = nil) then - begin - Result := LoadGlyph(ch); - if (not fCache.AddGlyph(ch, Result)) then - Result.Free; - end; -end; - -procedure TCachedFont.FlushCache(KeepBaseSet: boolean); -begin - fCache.FlushCache(KeepBaseSet); -end; - - -{* - * TFTFont - *} - -constructor TFTFont.Create( - const Filename: string; - Size: integer; Outset: single; - LoadFlags: FT_Int32); -var - i: WideChar; -begin - inherited Create(); - - fFilename := Filename; - fSize := Size; - fOutset := Outset; - fLoadFlags := LoadFlags; - fUseDisplayLists := true; - - // load font information - if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename), 0, fFace) <> 0) then - raise Exception.Create('FT_New_Face: Could not load font ''' + Filename + ''''); - - // support scalable fonts only - if (not FT_IS_SCALABLE(fFace)) then - raise Exception.Create('Font is not scalable'); - - if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then - raise Exception.Create('FT_Set_Pixel_Sizes failes'); - - // get scale factor for font-unit to pixel-size transformation - fFontUnitScale.X := fFace.size.metrics.x_ppem / fFace.units_per_EM; - fFontUnitScale.Y := fFace.size.metrics.y_ppem / fFace.units_per_EM; - - ResetIntern(); - - // pre-cache some commonly used glyphs (' ' - '~') - for i := #32 to #126 do - fCache.AddGlyph(i, TFTGlyph.Create(Self, i, Outset, LoadFlags)); -end; - -destructor TFTFont.Destroy(); -begin - // free face - FT_Done_Face(fFace); - inherited; -end; - -procedure TFTFont.ResetIntern(); -begin - // Note: outset and non outset fonts use same spacing - fLineSpacing := fFace.height * fFontUnitScale.Y; - fReflectionSpacing := -2*fFace.descender * fFontUnitScale.Y; -end; - -procedure TFTFont.Reset(); -begin - inherited; - ResetIntern(); -end; - -function TFTFont.LoadGlyph(ch: WideChar): TGlyph; -begin - Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags); -end; - -function TFTFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; -var - Glyph, PrevGlyph: TFTGlyph; - TextLine: WideString; - LineYOffset: single; - LineIndex, CharIndex: integer; - LineBounds: TBoundsDbl; - KernDelta: FT_Vector; - UnderlinePos: double; -begin - // Reset global bounds - Result.Left := Infinity; - Result.Right := 0; - Result.Bottom := Infinity; - Result.Top := 0; - - // reset last glyph - PrevGlyph := nil; - - // display text - for LineIndex := 0 to High(Text) do - begin - // get next text line - TextLine := Text[LineIndex]; - LineYOffset := -LineSpacing * LineIndex; - - // reset line bounds - LineBounds.Left := Infinity; - LineBounds.Right := 0; - LineBounds.Bottom := Infinity; - LineBounds.Top := 0; - - // for each glyph image, compute its bounding box - for CharIndex := 1 to Length(TextLine) do - begin - Glyph := TFTGlyph(GetGlyph(TextLine[CharIndex])); - if (Glyph <> nil) then - begin - // get kerning - if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then - begin - FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, - FT_KERNING_UNSCALED, KernDelta); - LineBounds.Right := LineBounds.Right + KernDelta.x * fFontUnitScale.X; - end; - - // update left bound (must be done before right bound is updated) - if (LineBounds.Right + Glyph.Bounds.Left < LineBounds.Left) then - LineBounds.Left := LineBounds.Right + Glyph.Bounds.Left; - - // update right bound - if (CharIndex < Length(TextLine)) or // not the last character - (TextLine[CharIndex] = ' ') or // on space char (Bounds.Right = 0) - Advance then // or in advance mode - begin - // add advance and glyph spacing - LineBounds.Right := LineBounds.Right + Glyph.Advance.x + GlyphSpacing - end - else - begin - // add glyph's right bound - LineBounds.Right := LineBounds.Right + Glyph.Bounds.Right; - end; - - // update bottom and top bounds - if (Glyph.Bounds.Bottom < LineBounds.Bottom) then - LineBounds.Bottom := Glyph.Bounds.Bottom; - if (Glyph.Bounds.Top > LineBounds.Top) then - LineBounds.Top := Glyph.Bounds.Top; - end; - - PrevGlyph := Glyph; - end; - - // handle italic font style - if (Italic in Style) then - begin - LineBounds.Left := LineBounds.Left + LineBounds.Bottom * cShearFactor; - LineBounds.Right := LineBounds.Right + LineBounds.Top * cShearFactor; - end; - - // handle underlined font style - if (Underline in Style) then - begin - UnderlinePos := GetUnderlinePosition(); - if (UnderlinePos < LineBounds.Bottom) then - LineBounds.Bottom := UnderlinePos; - end; - - // add line offset - LineBounds.Bottom := LineBounds.Bottom + LineYOffset; - LineBounds.Top := LineBounds.Top + LineYOffset; - - // adjust global bounds - if (Result.Left > LineBounds.Left) then - Result.Left := LineBounds.Left; - if (Result.Right < LineBounds.Right) then - Result.Right := LineBounds.Right; - if (Result.Bottom > LineBounds.Bottom) then - Result.Bottom := LineBounds.Bottom; - if (Result.Top < LineBounds.Top) then - Result.Top := LineBounds.Top; - end; - - // if left or bottom bound was not set, set them to 0 - if (Result.Left = Infinity) then - Result.Left := 0.0; - if (Result.Bottom = Infinity) then - Result.Bottom := 0.0; -end; - -procedure TFTFont.Render(const Text: WideString); + UnderlineY1 := GetUnderlinePosition(); + UnderlineY2 := UnderlineY1 + GetUnderlineThickness(); + Bounds := BBox(Text, false); + glRectf(Bounds.Left, UnderlineY1, Bounds.Right, UnderlineY2); +end; + +procedure TFont.SetStyle(Style: TFontStyle); +begin + fStyle := Style; +end; + +function TFont.GetStyle(): TFontStyle; +begin + Result := fStyle; +end; + +procedure TFont.SetLineSpacing(Spacing: single); +begin + fLineSpacing := Spacing; +end; + +function TFont.GetLineSpacing(): single; +begin + Result := fLineSpacing; +end; + +procedure TFont.SetGlyphSpacing(Spacing: single); +begin + fGlyphSpacing := Spacing; +end; + +function TFont.GetGlyphSpacing(): single; +begin + Result := fGlyphSpacing; +end; + +procedure TFont.SetReflectionSpacing(Spacing: single); +begin + fReflectionSpacing := Spacing; +end; + +function TFont.GetReflectionSpacing(): single; +begin + Result := fReflectionSpacing; +end; + +procedure TFont.SetUseKerning(Enable: boolean); +begin + fUseKerning := Enable; +end; + +function TFont.GetUseKerning(): boolean; +begin + Result := fUseKerning; +end; + +procedure TFont.SetReflectionPass(Enable: boolean); +begin + fReflectionPass := Enable; +end; + + +{* + * TScalableFont + *} + +constructor TScalableFont.Create(Font: TFont; UseMipmaps: boolean); +var + MipmapLevel: integer; +begin + inherited Create(); + + fBaseFont := Font; + fMipmapFonts[0] := Font; + fUseMipmaps := UseMipmaps; + ResetIntern(); + + // create mipmap fonts if requested + if (UseMipmaps) then + begin + for MipmapLevel := 1 to cMaxMipmapLevel do + begin + fMipmapFonts[MipmapLevel] := CreateMipmap(MipmapLevel, 1/(1 shl MipmapLevel)); + // stop if no smaller mipmap font is returned + if (fMipmapFonts[MipmapLevel] = nil) then + Break; + end; + end; +end; + +destructor TScalableFont.Destroy(); var - CharIndex: integer; - Glyph, PrevGlyph: TFTGlyph; - KernDelta: FT_Vector; -begin - // reset last glyph - PrevGlyph := nil; - - // draw current line - for CharIndex := 1 to Length(Text) do - begin - Glyph := TFTGlyph(GetGlyph(Text[CharIndex])); - if (Assigned(Glyph)) then - begin - // get kerning - if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then - begin - FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, - FT_KERNING_UNSCALED, KernDelta); - glTranslatef(KernDelta.x * fFontUnitScale.X, 0, 0); - end; - - if (ReflectionPass) then - Glyph.RenderReflection() - else - Glyph.Render(fUseDisplayLists); - - glTranslatef(Glyph.Advance.x + fGlyphSpacing, 0, 0); - end; - - PrevGlyph := Glyph; - end; -end; - -function TFTFont.GetHeight(): single; -begin - Result := Ascender - Descender; -end; - -function TFTFont.GetAscender(): single; -begin - Result := fFace.ascender * fFontUnitScale.Y + Outset*2; -end; - -function TFTFont.GetDescender(): single; -begin - // Note: outset is not part of the descender as the baseline is lifted - Result := fFace.descender * fFontUnitScale.Y; -end; - -function TFTFont.GetUnderlinePosition(): single; -begin - Result := fFace.underline_position * fFontUnitScale.Y - Outset; -end; - -function TFTFont.GetUnderlineThickness(): single; -begin - Result := fFace.underline_thickness * fFontUnitScale.Y + Outset*2; -end; - - -{* - * TFTScalableFont - *} - -constructor TFTScalableFont.Create(const Filename: string; - Size: integer; OutsetAmount: single; - UseMipmaps: boolean); -var - LoadFlags: FT_Int32; -begin - LoadFlags := FT_LOAD_DEFAULT; - // Disable hinting and grid-fitting to preserve font outlines at each font - // size, otherwise the font widths/heights do not match resulting in ugly - // text size changes during zooming. - // A drawback is a reduced quality with smaller font sizes but it is not that - // bad with gray-scaled rendering (at least it looks better than OpenGL's - // linear downscaling on minification). - if (UseMipmaps) then - LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; - inherited Create( - TFTFont.Create(Filename, Size, Size * OutsetAmount, LoadFlags), - UseMipmaps); -end; - -function TFTScalableFont.CreateMipmap(Level: integer; Scale: single): TFont; -var - ScaledSize: integer; - BaseFont: TFTFont; -begin - Result := nil; - BaseFont := TFTFont(fBaseFont); - ScaledSize := Round(BaseFont.Size * Scale); - // do not create mipmap fonts < 8 pixels - if (ScaledSize < 8) then - Exit; - Result := TFTFont.Create(BaseFont.fFilename, - ScaledSize, BaseFont.fOutset * Scale, - FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); -end; - -function TFTScalableFont.GetOutset(): single; -begin - Result := TFTFont(fBaseFont).Outset * fScale; -end; - -procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - TFTFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); -end; - - -{* - * TOutlineFont - *} - -constructor TFTOutlineFont.Create( - const Filename: string; - Size: integer; Outset: single; - LoadFlags: FT_Int32); -begin - inherited Create(); - - fFilename := Filename; - fSize := Size; - fOutset := Outset; - - fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags); - fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags); - - ResetIntern(); -end; - -destructor TFTOutlineFont.Destroy; -begin - fOutlineFont.Free; - fInnerFont.Free; - inherited; -end; - -procedure TFTOutlineFont.ResetIntern(); -begin - // TODO: maybe swap fInnerFont/fOutlineFont.GlyphSpacing to use the spacing - // of the outline font? - //fInnerFont.GlyphSpacing := fOutset*2; - fOutlineFont.GlyphSpacing := -fOutset*2; - - fLineSpacing := fOutlineFont.LineSpacing; - fReflectionSpacing := fOutlineFont.ReflectionSpacing; - fOutlineColor := NewGLColor(0, 0, 0, 1); -end; - -procedure TFTOutlineFont.Reset(); -begin - inherited; - fInnerFont.Reset(); - fOutlineFont.Reset(); - ResetIntern(); -end; - -procedure TFTOutlineFont.DrawUnderline(const Text: WideString); -begin - glPushAttrib(GL_CURRENT_BIT); - glColor4fv(@fOutlineColor.vals); - fOutlineFont.DrawUnderline(Text); - glPopAttrib(); - - glPushMatrix(); - glTranslatef(fOutset, 0, 0); - fInnerFont.DrawUnderline(Text); - glPopMatrix(); -end; - -procedure TFTOutlineFont.Render(const Text: WideString); -begin - { setup and render outline font } - - // save old color - glPushAttrib(GL_CURRENT_BIT); - glColor4fv(@fOutlineColor.vals); - glPushMatrix(); - fOutlineFont.Render(Text); - glPopMatrix(); - glPopAttrib(); - - { setup and render inner font } - - glPushMatrix(); - glTranslatef(fOutset, fOutset, 0); - fInnerFont.Render(Text); - glPopMatrix(); -end; - -procedure TFTOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); -begin - fOutlineColor := NewGLColor(r, g, b, a); -end; - -procedure TFTOutlineFont.FlushCache(KeepBaseSet: boolean); -begin - fOutlineFont.FlushCache(KeepBaseSet); - fInnerFont.FlushCache(KeepBaseSet); -end; - -function TFTOutlineFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; -begin - Result := fOutlineFont.BBox(Text, Advance); -end; - -function TFTOutlineFont.GetHeight(): single; -begin - Result := fOutlineFont.Height; -end; - -function TFTOutlineFont.GetAscender(): single; -begin - Result := fOutlineFont.Ascender; -end; - -function TFTOutlineFont.GetDescender(): single; -begin - Result := fOutlineFont.Descender; -end; - -procedure TFTOutlineFont.SetLineSpacing(Spacing: single); -begin - inherited SetLineSpacing(Spacing); - fInnerFont.LineSpacing := Spacing; - fOutlineFont.LineSpacing := Spacing; -end; - -procedure TFTOutlineFont.SetGlyphSpacing(Spacing: single); -begin - inherited SetGlyphSpacing(Spacing); - fInnerFont.GlyphSpacing := Spacing; - fOutlineFont.GlyphSpacing := Spacing - Outset*2; -end; - -procedure TFTOutlineFont.SetReflectionSpacing(Spacing: single); -begin - inherited SetReflectionSpacing(Spacing); - fInnerFont.ReflectionSpacing := Spacing; - fOutlineFont.ReflectionSpacing := Spacing; -end; - -procedure TFTOutlineFont.SetStyle(Style: TFontStyle); -begin - inherited SetStyle(Style); - fInnerFont.Style := Style; - fOutlineFont.Style := Style; -end; - -function TFTOutlineFont.GetStyle(): TFontStyle; -begin - Result := inherited GetStyle(); -end; - -function TFTOutlineFont.GetUnderlinePosition(): single; -begin - Result := fOutlineFont.GetUnderlinePosition(); -end; - -function TFTOutlineFont.GetUnderlineThickness(): single; -begin - Result := fOutlineFont.GetUnderlinePosition(); -end; - -procedure TFTOutlineFont.SetUseKerning(Enable: boolean); -begin - inherited SetUseKerning(Enable); - fInnerFont.fUseKerning := Enable; - fOutlineFont.fUseKerning := Enable; -end; - -procedure TFTOutlineFont.SetReflectionPass(Enable: boolean); -begin - inherited SetReflectionPass(Enable); - fInnerFont.fReflectionPass := Enable; - fOutlineFont.fReflectionPass := Enable; -end; - -{** - * TScalableOutlineFont - *} - -constructor TFTScalableOutlineFont.Create( - const Filename: string; - Size: integer; OutsetAmount: single; - UseMipmaps: boolean); -var - LoadFlags: FT_Int32; -begin - LoadFlags := FT_LOAD_DEFAULT; - // Disable hinting and grid-fitting (see TFTScalableFont.Create) - if (UseMipmaps) then - LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; - inherited Create( - TFTOutlineFont.Create(Filename, Size, Size*OutsetAmount, LoadFlags), - UseMipmaps); -end; - -function TFTScalableOutlineFont.CreateMipmap(Level: integer; Scale: single): TFont; -var - ScaledSize: integer; - BaseFont: TFTOutlineFont; -begin - Result := nil; - BaseFont := TFTOutlineFont(fBaseFont); - ScaledSize := Round(BaseFont.Size*Scale); - // do not create mipmap fonts < 8 pixels - if (ScaledSize < 8) then - Exit; - Result := TFTOutlineFont.Create(BaseFont.fFilename, - ScaledSize, BaseFont.fOutset*Scale, - FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); -end; - -function TFTScalableOutlineFont.GetOutset(): single; -begin - Result := TFTOutlineFont(fBaseFont).Outset * fScale; -end; - -procedure TFTScalableOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - TFTOutlineFont(fMipmapFonts[Level]).SetOutlineColor(r, g, b, a); -end; - -procedure TFTScalableOutlineFont.FlushCache(KeepBaseSet: boolean); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - TFTOutlineFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); -end; - - -{* - * TFTGlyph - *} - -const - {** - * Size of the transparent border surrounding the glyph image in the texture. - * The border is necessary because OpenGL does not smooth texels at the - * border of a texture with the GL_CLAMP or GL_CLAMP_TO_EDGE styles. - * Without the border, magnified glyph textures look very ugly at their edges. - * It looks edgy, as if some pixels are missing especially on the left edge - * (just set cTexSmoothBorder to 0 to see what is meant by this). - * With the border even the glyphs edges are blended to the border (transparent) - * color and everything looks nice. - * - * Note: - * OpenGL already supports texture border by setting the border parameter - * of glTexImage*D() to 1 and using a texture size of 2^m+2b and setting the - * border pixels to the border color. In some forums it is discouraged to use - * the border parameter as only a few of the more modern graphics cards support - * this feature. On an ATI Radeon 9700 card, the slowed down to 0.5 fps and - * the glyph's background got black. So instead of using this feature we - * handle it on our own. The only drawback is that textures might get bigger - * because the border might require a higher power of 2 size instead of just - * two additional pixels. - *} - cTexSmoothBorder = 1; - -procedure TFTGlyph.Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); - - procedure SetToMax(var Val1: GLubyte; Val2: GLubyte); {$IFDEF HasInline}inline;{$ENDIF} - begin - if (Val1 < Val2) then - Val1 := Val2; - end; - -var - I, X, Y: integer; - SrcBuffer,TmpBuffer: TGLubyteDynArray; - TexLine, TexLinePrev, TexLineNext: PGLubyteArray; - SrcLine: PGLubyteArray; - AlphaScale: single; - Value, ValueNeigh, ValueDiag: GLubyte; -const - // square-root of 2 used for diagonal neighbor pixels - cSqrt2 = 1.4142; - // number of ignored pixels on each edge of the bitmap. Consists of: - // - border used for font smoothing and - // - outer (extruded) bitmap pixel (because it is just written but never read) - cBorder = cTexSmoothBorder + 1; -begin - // allocate memory for temporary buffer - SetLength(SrcBuffer, Length(TexBuffer)); - FillChar(SrcBuffer[0], Length(TexBuffer), 0); - - // extrude pixel by pixel - for I := 1 to Ceil(Outset) do - begin - // swap arrays - TmpBuffer := TexBuffer; - TexBuffer := SrcBuffer; - SrcBuffer := TmpBuffer; - - // as long as we add an entire pixel of outset, use a solid color. - // If the fractional part is reached blend, e.g. outline=3.2 -> 3 solid - // pixels and one blended with alpha=0.2. - // For the fractional part I = Ceil(Outset) is always true. - if (I <= Outset) then - AlphaScale := 1 - else - AlphaScale := Outset - Trunc(Outset); - - // copy data to the expanded bitmap. - for Y := cBorder to fTexSize.Height - 2*cBorder do - begin - TexLine := @TexBuffer[Y*fTexSize.Width]; - TexLinePrev := @TexBuffer[(Y-1)*fTexSize.Width]; - TexLineNext := @TexBuffer[(Y+1)*fTexSize.Width]; - SrcLine := @SrcBuffer[Y*fTexSize.Width]; - - // expand current line's pixels - for X := cBorder to fTexSize.Width - 2*cBorder do - begin - Value := SrcLine[X]; - ValueNeigh := Round(Value * AlphaScale); - ValueDiag := Round(ValueNeigh / cSqrt2); - - SetToMax(TexLine[X], Value); - SetToMax(TexLine[X-1], ValueNeigh); - SetToMax(TexLine[X+1], ValueNeigh); - - SetToMax(TexLinePrev[X], ValueNeigh); - SetToMax(TexLinePrev[X-1], ValueDiag); - SetToMax(TexLinePrev[X+1], ValueDiag); - - SetToMax(TexLineNext[X], ValueNeigh); - SetToMax(TexLineNext[X-1], ValueDiag); - SetToMax(TexLineNext[X+1], ValueDiag); - end; - end; - end; - - TmpBuffer := nil; - SetLength(SrcBuffer, 0); -end; - -procedure TFTGlyph.CreateTexture(LoadFlags: FT_Int32); -var - X, Y: integer; - Glyph: FT_Glyph; - BitmapGlyph: FT_BitmapGlyph; - Bitmap: PFT_Bitmap; - BitmapLine: PChar; - BitmapBuffer: PChar; - TexBuffer: TGLubyteDynArray; - TexLine: PGLubyteArray; - CBox: FT_BBox; -begin - // load the Glyph for our character - if (FT_Load_Glyph(fFont.Face, fCharIndex, LoadFlags) <> 0) then - raise Exception.Create('FT_Load_Glyph failed'); - - // move the face's glyph into a Glyph object - if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then - raise Exception.Create('FT_Get_Glyph failed'); - - // store scaled advance width/height in glyph-object - fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2; - fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2; - - // get the contour's bounding box (in 1/64th pixels, not font-units) - FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox); - // convert 1/64th values to double values - fBounds.Left := CBox.xMin / 64; - fBounds.Right := CBox.xMax / 64 + fOutset*2; - fBounds.Bottom := CBox.yMin / 64; - fBounds.Top := CBox.yMax / 64 + fOutset*2; - - // convert the glyph to a bitmap (and destroy original glyph image) - FT_Glyph_To_Bitmap(Glyph, ft_render_mode_normal, nil, 1); - BitmapGlyph := FT_BitmapGlyph(Glyph); - - // get bitmap offsets - fBitmapCoords.Left := BitmapGlyph^.left - cTexSmoothBorder; - // Note: add 1*fOutset for lifting the baseline so outset fonts to not intersect - // with the baseline; Ceil(fOutset) for the outset pixels added to the bitmap. - fBitmapCoords.Top := BitmapGlyph^.top + fOutset+Ceil(fOutset) + cTexSmoothBorder; - - // make accessing the bitmap easier - Bitmap := @BitmapGlyph^.bitmap; - // get bitmap dimensions - fBitmapCoords.Width := Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2; - fBitmapCoords.Height := Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2; - - // get power-of-2 bitmap widths - fTexSize.Width := - NextPowerOf2(Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2); - fTexSize.Height := - NextPowerOf2(Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2); - - // texture-widths ignoring empty (power-of-2) padding space - fTexOffset.X := fBitmapCoords.Width / fTexSize.Width; - fTexOffset.Y := fBitmapCoords.Height / fTexSize.Height; - - // allocate memory for texture data - SetLength(TexBuffer, fTexSize.Width * fTexSize.Height); - FillChar(TexBuffer[0], Length(TexBuffer), 0); - - // Freetype stores the bitmap with either upper (pitch is > 0) or lower - // (pitch < 0) glyphs line first. Set the buffer to the upper line. - // See http://freetype.sourceforge.net/freetype2/docs/glyphs/glyphs-7.html - if (Bitmap.pitch > 0) then - BitmapBuffer := @Bitmap.buffer[0] - else - BitmapBuffer := @Bitmap.buffer[(Bitmap.rows-1) * Abs(Bitmap.pitch)]; - - // copy data to texture bitmap (upper line first). - for Y := 0 to Bitmap.rows-1 do - begin - // set pointer to first pixel in line that holds bitmap data. - // Each line starts with a cTexSmoothBorder pixel and multiple outset pixels - // that are added by Extrude() later. - TexLine := @TexBuffer[(Y + cTexSmoothBorder + Ceil(fOutset)) * fTexSize.Width + - cTexSmoothBorder + Ceil(fOutset)]; - // get next lower line offset, use pitch instead of width as it tells - // us the storage direction of the lines. In addition a line might be padded. - BitmapLine := @BitmapBuffer[Y * Bitmap.pitch]; - for X := 0 to Bitmap.width-1 do - TexLine[X] := GLubyte(BitmapLine[X]); - end; - - if (fOutset > 0) then - Extrude(TexBuffer, fOutset); - - // allocate resources for textures and display lists - glGenTextures(1, @fTexture); - - // setup texture parameters - glBindTexture(GL_TEXTURE_2D, fTexture); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - - glPixelStorei(GL_UNPACK_ALIGNMENT, 1); - // create alpha-map (GL_ALPHA component only). - // TexCoord (0,0) corresponds to the top left pixel of the glyph, - // (1,1) to the bottom right pixel. So the glyph is flipped as OpenGL uses - // a cartesian (y-axis up) coordinate system for textures. - // See the cTexSmoothBorder comment for info on texture borders. - glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, fTexSize.Width, fTexSize.Height, - 0, GL_ALPHA, GL_UNSIGNED_BYTE, @TexBuffer[0]); - - // free expanded data - SetLength(TexBuffer, 0); - - // create the display list - fDisplayList := glGenLists(1); - - // render to display-list - glNewList(fDisplayList, GL_COMPILE); - Render(false); - glEndList(); - - // free glyph data (bitmap, etc.) - FT_Done_Glyph(Glyph); -end; - -constructor TFTGlyph.Create(Font: TFTFont; ch: WideChar; Outset: single; - LoadFlags: FT_Int32); -begin - inherited Create(); - - fFont := Font; - fOutset := Outset; - - // get the Freetype char-index (use default UNICODE charmap) - fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch)); - - CreateTexture(LoadFlags); -end; - -destructor TFTGlyph.Destroy; -begin - if (fDisplayList <> 0) then - glDeleteLists(fDisplayList, 1); - if (fTexture <> 0) then - glDeleteTextures(1, @fTexture); - inherited; -end; - -procedure TFTGlyph.Render(UseDisplayLists: boolean); -begin - // use display-lists if enabled and exit - if (UseDisplayLists) then - begin - glCallList(fDisplayList); - Exit; - end; - - glBindTexture(GL_TEXTURE_2D, fTexture); - glPushMatrix(); - - // move to top left glyph position - glTranslatef(fBitmapCoords.Left, fBitmapCoords.Top, 0); - - // draw glyph texture - glBegin(GL_QUADS); - // top right - glTexCoord2f(fTexOffset.X, 0); - glVertex2f(fBitmapCoords.Width, 0); - - // top left - glTexCoord2f(0, 0); - glVertex2f(0, 0); - - // bottom left - glTexCoord2f(0, fTexOffset.Y); - glVertex2f(0, -fBitmapCoords.Height); - - // bottom right - glTexCoord2f(fTexOffset.X, fTexOffset.Y); - glVertex2f(fBitmapCoords.Width, -fBitmapCoords.Height); - glEnd(); - - glPopMatrix(); -end; - -procedure TFTGlyph.RenderReflection(); -var - Color: TGLColor; - TexUpperPos: single; - TexLowerPos: single; - UpperPos: single; -const - CutOff = 0.6; -begin - glPushMatrix(); - glBindTexture(GL_TEXTURE_2D, fTexture); - glGetFloatv(GL_CURRENT_COLOR, @Color.vals); - - // add extra space to the left of the glyph - glTranslatef(fBitmapCoords.Left, 0, 0); - - // The upper position of the glyph, if CutOff is 1.0, it is fFont.Ascender. - // If CutOff is set to 0.5 only half of the glyph height is displayed. - UpperPos := fFont.Descender + fFont.Height * CutOff; - - // the glyph texture's height is just the height of the glyph but not the font - // height. Setting a color for the upper and lower bounds of the glyph results - // in different color gradients. So we have to set the color values for the - // descender and ascender (as we have a cutoff, for the upper-pos here) as - // these positions are font but not glyph specific. - - // To get the texture positions we have to enhance the texture at the top and - // bottom by the amount from the top to ascender (rather upper-pos here) and - // from the bottom (Height-Top) to descender. Then we have to convert those - // heights to texture coordinates by dividing by the bitmap Height and - // removing the power-of-2 padding space by multiplying with fTexOffset.Y - // (as fBitmapCoords.Height corresponds to fTexOffset.Y and not 1.0). - TexUpperPos := -(UpperPos - fBitmapCoords.Top) / fBitmapCoords.Height * fTexOffset.Y; - TexLowerPos := (-(fFont.Descender + fBitmapCoords.Height - fBitmapCoords.Top) / - fBitmapCoords.Height + 1) * fTexOffset.Y; - - // draw glyph texture - glBegin(GL_QUADS); - // top right - glColor4f(Color.r, Color.g, Color.b, 0); - glTexCoord2f(fTexOffset.X, TexUpperPos); - glVertex2f(fBitmapCoords.Width, UpperPos); - - // top left - glTexCoord2f(0, TexUpperPos); - glVertex2f(0, UpperPos); - - // bottom left - glColor4f(Color.r, Color.g, Color.b, Color.a-0.3); - glTexCoord2f(0, TexLowerPos); - glVertex2f(0, fFont.Descender); - - // bottom right - glTexCoord2f(fTexOffset.X, TexLowerPos); - glVertex2f(fBitmapCoords.Width, fFont.Descender); - glEnd(); - - glPopMatrix(); - - // restore old color - // Note: glPopAttrib(GL_CURRENT_BIT)/glPopAttrib() is much slower then - // glGetFloatv(GL_CURRENT_COLOR, ...)/glColor4fv(...) - glColor4fv(@Color.vals); -end; - -function TFTGlyph.GetAdvance(): TPositionDbl; -begin - Result := fAdvance; -end; - -function TFTGlyph.GetBounds(): TBoundsDbl; -begin - Result := fBounds; -end; - - -{* - * TGlyphCache - *} - -constructor TGlyphCache.Create(); -begin - inherited; - fHash := TList.Create(); -end; - -destructor TGlyphCache.Destroy(); -begin - // free cached glyphs - FlushCache(false); - - // destroy TList - fHash.Free; - - inherited; -end; - -function TGlyphCache.FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; -var - I: integer; - Entry: TGlyphCacheHashEntry; -begin - Result := nil; - - for I := 0 to fHash.Count-1 do - begin - Entry := TGlyphCacheHashEntry(fHash[I]); - - if (Entry.BaseCode > BaseCode) then - begin - InsertPos := I; - Exit; - end; - - if (Entry.BaseCode = BaseCode) then - begin - InsertPos := I; - Result := @Entry.GlyphTable; - Exit; - end; - end; - - InsertPos := fHash.Count; -end; - -function TGlyphCache.AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; -var - BaseCode: cardinal; - GlyphCode: integer; - InsertPos: integer; - GlyphTable: PGlyphTable; - Entry: TGlyphCacheHashEntry; -begin - Result := false; - - BaseCode := cardinal(ch) shr 8; - GlyphTable := FindGlyphTable(BaseCode, InsertPos); - if (GlyphTable = nil) then - begin - Entry := TGlyphCacheHashEntry.Create(BaseCode); - GlyphTable := @Entry.GlyphTable; - fHash.Insert(InsertPos, Entry); - end; - - // get glyph table offset - GlyphCode := cardinal(ch) and $FF; - // insert glyph into table if not present - if (GlyphTable[GlyphCode] = nil) then - begin - GlyphTable[GlyphCode] := Glyph; - Result := true; - end; -end; - -procedure TGlyphCache.DeleteGlyph(ch: WideChar); -var - Table: PGlyphTable; - TableIndex, GlyphIndex: integer; - TableEmpty: boolean; -begin - // find table - Table := FindGlyphTable(cardinal(ch) shr 8, TableIndex); - if (Table = nil) then - Exit; - - // find glyph - GlyphIndex := cardinal(ch) and $FF; - if (Table[GlyphIndex] <> nil) then - begin - // destroy glyph - FreeAndNil(Table[GlyphIndex]); - - // check if table is empty - TableEmpty := true; - for GlyphIndex := 0 to High(Table^) do - begin - if (Table[GlyphIndex] <> nil) then - begin - TableEmpty := false; - Break; - end; - end; - - // free empty table - if (TableEmpty) then - begin - fHash.Delete(TableIndex); - end; - end; -end; - -function TGlyphCache.GetGlyph(ch: WideChar): TGlyph; -var - InsertPos: integer; - Table: PGlyphTable; -begin - Table := FindGlyphTable(cardinal(ch) shr 8, InsertPos); - if (Table = nil) then - Result := nil - else - Result := Table[cardinal(ch) and $FF]; -end; - -function TGlyphCache.HasGlyph(ch: WideChar): boolean; -begin - Result := (GetGlyph(ch) <> nil); -end; - -procedure TGlyphCache.FlushCache(KeepBaseSet: boolean); -var - EntryIndex, TableIndex: integer; - Entry: TGlyphCacheHashEntry; -begin - // destroy cached glyphs - for EntryIndex := 0 to fHash.Count-1 do - begin - Entry := TGlyphCacheHashEntry(fHash[EntryIndex]); - - // the base set (0-255) has BaseCode 0 as the upper bytes are 0. - if KeepBaseSet and (Entry.fBaseCode = 0) then - Continue; - - for TableIndex := 0 to High(Entry.GlyphTable) do - begin - if (Entry.GlyphTable[TableIndex] <> nil) then - FreeAndNil(Entry.GlyphTable[TableIndex]); - end; - FreeAndNil(Entry); - end; -end; - - -{* - * TGlyphCacheEntry - *} - -constructor TGlyphCacheHashEntry.Create(BaseCode: cardinal); -begin - inherited Create(); - fBaseCode := BaseCode; -end; - - -{* - * TFreeType - *} - -class function TFreeType.GetLibrary(): FT_Library; -begin - if (LibraryInst = nil) then - begin - // initialize freetype - if (FT_Init_FreeType(LibraryInst) <> 0) then - raise Exception.Create('FT_Init_FreeType failed'); - end; - Result := LibraryInst; -end; - -class procedure TFreeType.FreeLibrary(); -begin - if (LibraryInst <> nil) then - FT_Done_FreeType(LibraryInst); - LibraryInst := nil; -end; - - -{$IFDEF BITMAP_FONT} -{* - * TBitmapFont - *} - -constructor TBitmapFont.Create(const Filename: string; Outline: integer; - Baseline, Ascender, Descender: integer); -begin - inherited Create(); - - fTex := Texture.LoadTexture(true, Filename, TEXTURE_TYPE_TRANSPARENT, 0); - fTexSize := 1024; - fOutline := Outline; - fBaseline := Baseline; - fAscender := Ascender; - fDescender := Descender; - - LoadFontInfo(ChangeFileExt(Filename, '.dat')); - - ResetIntern(); -end; - -destructor TBitmapFont.Destroy(); -begin - glDeleteTextures(1, @fTex.TexNum); - inherited; -end; - -procedure TBitmapFont.ResetIntern(); -begin - fLineSpacing := Height; -end; - -procedure TBitmapFont.Reset(); -begin - inherited; - ResetIntern(); -end; - -procedure TBitmapFont.CorrectWidths(WidthMult: real; WidthAdd: integer); -var - Count: integer; -begin - for Count := 0 to 255 do - fWidths[Count] := Round(fWidths[Count] * WidthMult) + WidthAdd; -end; - -procedure TBitmapFont.LoadFontInfo(const InfoFile: string); -var - Stream: TFileStream; -begin - FillChar(fWidths[0], Length(fWidths), 0); - - Stream := nil; - try - Stream := TFileStream.Create(InfoFile, fmOpenRead); - Stream.Read(fWidths, 256); - except - raise Exception.Create('Could not read font info file ''' + InfoFile + ''''); - end; - Stream.Free; -end; - -function TBitmapFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; -var - LineIndex, CharIndex: integer; - CharCode: cardinal; - Line: WideString; - LineWidth: double; -begin - Result.Left := 0; - Result.Right := 0; - Result.Top := Height; - Result.Bottom := 0; - - for LineIndex := 0 to High(Text) do - begin - Line := Text[LineIndex]; - LineWidth := 0; - for CharIndex := 1 to Length(Line) do - begin - CharCode := Ord(Line[CharIndex]); - if (CharCode < Length(fWidths)) then - LineWidth := LineWidth + fWidths[CharCode]; - end; - if (LineWidth > Result.Right) then - Result.Right := LineWidth; - end; -end; - -procedure TBitmapFont.RenderChar(ch: WideChar; var AdvanceX: real); -var - TexX, TexY: real; - TexR, TexB: real; - GlyphWidth: real; - PL, PT: real; - PR, PB: real; - CharCode: cardinal; -begin - CharCode := Ord(ch); - if (CharCode > High(fWidths)) then - CharCode := 0; - - GlyphWidth := fWidths[CharCode]; - - // set texture positions - TexX := (CharCode mod 16) * 1/16 + 1/32 - (GlyphWidth/2 - fOutline)/fTexSize; - TexY := (CharCode div 16) * 1/16 + {2 texels} 2/fTexSize; - TexR := (CharCode mod 16) * 1/16 + 1/32 + (GlyphWidth/2 + fOutline)/fTexSize; - TexB := (1 + CharCode div 16) * 1/16 - {2 texels} 2/fTexSize; - - // set vector positions - PL := AdvanceX - fOutline; - PR := PL + GlyphWidth + fOutline*2; - PB := -fBaseline; - PT := PB + fTexSize div 16; - - (* - if (Font.Blend) then - begin - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - end; - *) - - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, fTex.TexNum); - - if (not ReflectionPass) then - begin - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); - glEnd; - end - else - begin - glDepthRange(0, 10); - glDepthFunc(GL_LEQUAL); - glEnable(GL_DEPTH_TEST); - - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); - glEnd; - - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); - -(* - glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0.7); - glTexCoord2f(TexX, TexB); glVertex3f(PL, PB, 0); - glTexCoord2f(TexR, TexB); glVertex3f(PR, PB, 0); - - glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0); - glTexCoord2f(TexR, (TexY + TexB)/2); glVertex3f(PR, (PT + PB)/2, 0); - glTexCoord2f(TexX, (TexY + TexB)/2); glVertex3f(PL, (PT + PB)/2, 0); -*) - glEnd; - - //write the colour back - glColor4fv(@fTempColor); - - glDisable(GL_DEPTH_TEST); - end; // reflection - - glDisable(GL_TEXTURE_2D); - (* - if (Font.Blend) then - glDisable(GL_BLEND); - *) - - AdvanceX := AdvanceX + GlyphWidth; -end; - -procedure TBitmapFont.Render(const Text: WideString); -var - CharIndex: integer; - AdvanceX: real; -begin - // if there is no text do nothing - if (Text = '') then - Exit; - - //Save the current color and alpha (for reflection) - glGetFloatv(GL_CURRENT_COLOR, @fTempColor); - - AdvanceX := 0; - for CharIndex := 1 to Length(Text) do - begin - RenderChar(Text[CharIndex], AdvanceX); - end; -end; - -function TBitmapFont.GetHeight(): single; -begin - Result := fAscender - fDescender; -end; - -function TBitmapFont.GetAscender(): single; -begin - Result := fAscender; -end; - -function TBitmapFont.GetDescender(): single; -begin - Result := fDescender; -end; - -function TBitmapFont.GetUnderlinePosition(): single; -begin - Result := -2.0; -end; - -function TBitmapFont.GetUnderlineThickness(): single; -begin - Result := 1.0; -end; - -{$ENDIF BITMAP_FONT} - - -initialization - -finalization - TFreeType.FreeLibrary(); - -end. + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + fMipmapFonts[Level].Free; + inherited; +end; + +procedure TScalableFont.ResetIntern(); +begin + fScale := 1.0; + fAspect := 1.0; +end; + +procedure TScalableFont.Reset(); +var + Level: integer; +begin + inherited; + ResetIntern(); + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].Reset(); +end; + +{** + * Returns the mipmap level to use with regard to the current projection + * and modelview matrix, font scale and aspect. + * + * Note: + * - for Freetype fonts, hinting and grid-fitting must be disabled, otherwise + * the glyph widths/heights ratios and advance widths of the mipmap fonts + * do not match as they are adjusted sligthly (e.g. an 'a' at size 12px has + * width 12px, but at size 6px width 8px). + * - returned mipmap-level is used for all glyphs of the current text to print. + * This is faster, much easier to handle, since we just need to create + * multiple sized fonts and select the one we need for the mipmap-level and + * it avoids that neighbored glyphs use different mipmap-level which might + * look odd because one glyph might look blurry and the other sharp. + * + * Motivation: + * We do not use OpenGL for mipmapping as the results are very bad. At least + * with automatic mipmap generation (gluBuildMipmaps) the fonts look rather + * blurry. + * Defining our own mipmaps by creating multiple textures with + * for different mimap levels is a pain, as the font size passed to freetype + * is not the size of the bitmaps created and it does not guarantee that a + * glyph bitmap of a font with font-size s/2 is half the size of the font with + * font-size s. If the bitmap size is just a single pixel bigger than the half + * we might need a texture of the next power-of-2 and the texture would not be + * half of the size of the next bigger mipmap. In addition we use a fixed one + * pixel sized border to smooth the texture (see cTexSmoothBorder) and maybe + * an outset that is added to the font, so creating a glyph mipmap that is + * exactly half the size of the next bigger one is a very difficult task. + * + * Solution: + * Use mipmap textures that are not exactly half the size of the next mipmap + * level. OpenGL does not support this (at least not without extensions). + * The trickiest task is to determine the mipmap to use by calculating the + * amount of minification that is performed in this function. + *} +function TScalableFont.GetMipmapLevel(): integer; +var + ModelMatrix, ProjMatrix: T16dArray; + WinCoords: array[0..2, 0..2] of GLdouble; + ViewPortArray: TViewPortArray; + Dist, Dist2: double; + WidthScale, HeightScale: double; +const + // width/height of square used for determining the scale + cTestSize = 10.0; + // an offset to the mipmap-level to adjust the change-over of two consecutive + // mipmap levels. If for example the bias is 0.1 and unbiased level is 1.9 + // the result level will be 2. A bias of 0.5 is equal to rounding. + // With bias=0.1 we prefer larger mipmaps over smaller ones. + cBias = 0.2; +begin + // 1. retrieve current transformation matrices for gluProject + glGetDoublev(GL_MODELVIEW_MATRIX, @ModelMatrix); + glGetDoublev(GL_PROJECTION_MATRIX, @ProjMatrix); + glGetIntegerv(GL_VIEWPORT, @ViewPortArray); + + // 2. project three of the corner points of a square with size cTestSize + // to window coordinates (the square is just a dummy for a glyph) + + // project point (x1, y1) to window corrdinates + gluProject(0, 0, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[0][0], @WinCoords[0][1], @WinCoords[0][2]); + // project point (x2, y1) to window corrdinates + gluProject(cTestSize, 0, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[1][0], @WinCoords[1][1], @WinCoords[1][2]); + // project point (x1, y2) to window corrdinates + gluProject(0, cTestSize, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[2][0], @WinCoords[2][1], @WinCoords[2][2]); + + // 3. Lets see how much the width and height of the square changed. + // Calculate the width and height as displayed on the screen in window + // coordinates and calculate the ratio to the original coordinates in + // modelview space so the ratio gives us the scale (minification here). + + // projected width ||(x1, y1) - (x2, y1)|| + Dist := (WinCoords[0][0] - WinCoords[1][0]); + Dist2 := (WinCoords[0][1] - WinCoords[1][1]); + WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + // projected height ||(x1, y1) - (x1, y2)|| + Dist := (WinCoords[0][0] - WinCoords[2][0]); + Dist2 := (WinCoords[0][1] - WinCoords[2][1]); + HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + //writeln(Format('Scale %f, %f', [WidthScale, HeightScale])); + + // 4. Now that we have got the scale, take the bigger minification scale + // and get it to a logarithmic scale as each mipmap is 1/2 the size of its + // predecessor (Mipmap_size[i] = Mipmap_size[i-1]/2). + // The result is our mipmap-level = the index of the mipmap to use. + + // Level > 0: Minification; < 0: Magnification + Result := Trunc(Log2(Max(WidthScale, HeightScale)) + cBias); + + // clamp to valid range + if (Result < 0) then + Result := 0; + if (Result > High(fMipmapFonts)) then + Result := High(fMipmapFonts); +end; + +function TScalableFont.GetMipmapScale(Level: integer): single; +begin + if (fMipmapFonts[Level] = nil) then + begin + Result := -1; + Exit; + end; + + Result := fScale * fMipmapFonts[0].Height / fMipmapFonts[Level].Height; +end; + +{** + * Returns the correct mipmap font for the current scale and projection + * matrix. The modelview scale is adjusted to the mipmap level, so + * Result.Print() will display the font in the correct size. + *} +function TScalableFont.ChooseMipmapFont(): TFont; +var + DesiredLevel: integer; + Level: integer; + MipmapScale: single; +begin + Result := nil; + DesiredLevel := GetMipmapLevel(); + + // get the smallest mipmap available for the desired level + // as not all levels must be assigned to a font. + for Level := DesiredLevel downto 0 do + begin + if (fMipmapFonts[Level] <> nil) then + begin + Result := fMipmapFonts[Level]; + Break; + end; + end; + + // since the mipmap font (if level > 0) is smaller than the base-font + // we have to scale to get its size right. + MipmapScale := fMipmapFonts[0].Height/Result.Height; + glScalef(MipmapScale, MipmapScale, 0); +end; + +procedure TScalableFont.Print(const Text: TWideStringArray); +begin + glPushMatrix(); + + // set scale and stretching + glScalef(fScale * fAspect, fScale, 0); + + // print text + if (fUseMipmaps) then + ChooseMipmapFont().Print(Text) + else + fBaseFont.Print(Text); + + glPopMatrix(); +end; + +procedure TScalableFont.Render(const Text: WideString); +begin + Assert(false, 'Unused TScalableFont.Render() was called'); +end; + +function TScalableFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +begin + Result := fBaseFont.BBox(Text, Advance); + Result.Left := Result.Left * fScale * fAspect; + Result.Right := Result.Right * fScale * fAspect; + Result.Top := Result.Top * fScale; + Result.Bottom := Result.Bottom * fScale; +end; + +procedure TScalableFont.SetHeight(Height: single); +begin + fScale := Height / fBaseFont.GetHeight(); +end; + +function TScalableFont.GetHeight(): single; +begin + Result := fBaseFont.GetHeight() * fScale; +end; + +procedure TScalableFont.SetAspect(Aspect: single); +begin + fAspect := Aspect; +end; + +function TScalableFont.GetAspect(): single; +begin + Result := fAspect; +end; + +function TScalableFont.GetAscender(): single; +begin + Result := fBaseFont.GetAscender() * fScale; +end; + +function TScalableFont.GetDescender(): single; +begin + Result := fBaseFont.GetDescender() * fScale; +end; + +procedure TScalableFont.SetLineSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetLineSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetLineSpacing(): single; +begin + Result := fBaseFont.GetLineSpacing() * fScale; +end; + +procedure TScalableFont.SetGlyphSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetGlyphSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetGlyphSpacing(): single; +begin + Result := fBaseFont.GetGlyphSpacing() * fScale; +end; + +procedure TScalableFont.SetReflectionSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetReflectionSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetReflectionSpacing(): single; +begin + Result := fBaseFont.GetLineSpacing() * fScale; +end; + +procedure TScalableFont.SetStyle(Style: TFontStyle); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetStyle(Style); +end; + +function TScalableFont.GetStyle(): TFontStyle; +begin + Result := fBaseFont.GetStyle(); +end; + +function TScalableFont.GetUnderlinePosition(): single; +begin + Result := fBaseFont.GetUnderlinePosition(); +end; + +function TScalableFont.GetUnderlineThickness(): single; +begin + Result := fBaseFont.GetUnderlinePosition(); +end; + +procedure TScalableFont.SetUseKerning(Enable: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetUseKerning(Enable); +end; + + +{* + * TCachedFont + *} + +constructor TCachedFont.Create(); +begin + inherited; + fCache := TGlyphCache.Create(); +end; + +destructor TCachedFont.Destroy(); +begin + fCache.Free; + inherited; +end; + +function TCachedFont.GetGlyph(ch: WideChar): TGlyph; +begin + Result := fCache.GetGlyph(ch); + if (Result = nil) then + begin + Result := LoadGlyph(ch); + if (not fCache.AddGlyph(ch, Result)) then + Result.Free; + end; +end; + +procedure TCachedFont.FlushCache(KeepBaseSet: boolean); +begin + fCache.FlushCache(KeepBaseSet); +end; + + +{* + * TFTFont + *} + +constructor TFTFont.Create( + const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32); +var + i: WideChar; +begin + inherited Create(); + + fFilename := Filename; + fSize := Size; + fOutset := Outset; + fLoadFlags := LoadFlags; + fUseDisplayLists := true; + + // load font information + if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename), 0, fFace) <> 0) then + raise Exception.Create('FT_New_Face: Could not load font ''' + Filename + ''''); + + // support scalable fonts only + if (not FT_IS_SCALABLE(fFace)) then + raise Exception.Create('Font is not scalable'); + + if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then + raise Exception.Create('FT_Set_Pixel_Sizes failes'); + + // get scale factor for font-unit to pixel-size transformation + fFontUnitScale.X := fFace.size.metrics.x_ppem / fFace.units_per_EM; + fFontUnitScale.Y := fFace.size.metrics.y_ppem / fFace.units_per_EM; + + ResetIntern(); + + // pre-cache some commonly used glyphs (' ' - '~') + for i := #32 to #126 do + fCache.AddGlyph(i, TFTGlyph.Create(Self, i, Outset, LoadFlags)); +end; + +destructor TFTFont.Destroy(); +begin + // free face + FT_Done_Face(fFace); + inherited; +end; + +procedure TFTFont.ResetIntern(); +begin + // Note: outset and non outset fonts use same spacing + fLineSpacing := fFace.height * fFontUnitScale.Y; + fReflectionSpacing := -2*fFace.descender * fFontUnitScale.Y; +end; + +procedure TFTFont.Reset(); +begin + inherited; + ResetIntern(); +end; + +function TFTFont.LoadGlyph(ch: WideChar): TGlyph; +begin + Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags); +end; + +function TFTFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +var + Glyph, PrevGlyph: TFTGlyph; + TextLine: WideString; + LineYOffset: single; + LineIndex, CharIndex: integer; + LineBounds: TBoundsDbl; + KernDelta: FT_Vector; + UnderlinePos: double; +begin + // Reset global bounds + Result.Left := Infinity; + Result.Right := 0; + Result.Bottom := Infinity; + Result.Top := 0; + + // reset last glyph + PrevGlyph := nil; + + // display text + for LineIndex := 0 to High(Text) do + begin + // get next text line + TextLine := Text[LineIndex]; + LineYOffset := -LineSpacing * LineIndex; + + // reset line bounds + LineBounds.Left := Infinity; + LineBounds.Right := 0; + LineBounds.Bottom := Infinity; + LineBounds.Top := 0; + + // for each glyph image, compute its bounding box + for CharIndex := 1 to Length(TextLine) do + begin + Glyph := TFTGlyph(GetGlyph(TextLine[CharIndex])); + if (Glyph <> nil) then + begin + // get kerning + if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + begin + FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_KERNING_UNSCALED, KernDelta); + LineBounds.Right := LineBounds.Right + KernDelta.x * fFontUnitScale.X; + end; + + // update left bound (must be done before right bound is updated) + if (LineBounds.Right + Glyph.Bounds.Left < LineBounds.Left) then + LineBounds.Left := LineBounds.Right + Glyph.Bounds.Left; + + // update right bound + if (CharIndex < Length(TextLine)) or // not the last character + (TextLine[CharIndex] = ' ') or // on space char (Bounds.Right = 0) + Advance then // or in advance mode + begin + // add advance and glyph spacing + LineBounds.Right := LineBounds.Right + Glyph.Advance.x + GlyphSpacing + end + else + begin + // add glyph's right bound + LineBounds.Right := LineBounds.Right + Glyph.Bounds.Right; + end; + + // update bottom and top bounds + if (Glyph.Bounds.Bottom < LineBounds.Bottom) then + LineBounds.Bottom := Glyph.Bounds.Bottom; + if (Glyph.Bounds.Top > LineBounds.Top) then + LineBounds.Top := Glyph.Bounds.Top; + end; + + PrevGlyph := Glyph; + end; + + // handle italic font style + if (Italic in Style) then + begin + LineBounds.Left := LineBounds.Left + LineBounds.Bottom * cShearFactor; + LineBounds.Right := LineBounds.Right + LineBounds.Top * cShearFactor; + end; + + // handle underlined font style + if (Underline in Style) then + begin + UnderlinePos := GetUnderlinePosition(); + if (UnderlinePos < LineBounds.Bottom) then + LineBounds.Bottom := UnderlinePos; + end; + + // add line offset + LineBounds.Bottom := LineBounds.Bottom + LineYOffset; + LineBounds.Top := LineBounds.Top + LineYOffset; + + // adjust global bounds + if (Result.Left > LineBounds.Left) then + Result.Left := LineBounds.Left; + if (Result.Right < LineBounds.Right) then + Result.Right := LineBounds.Right; + if (Result.Bottom > LineBounds.Bottom) then + Result.Bottom := LineBounds.Bottom; + if (Result.Top < LineBounds.Top) then + Result.Top := LineBounds.Top; + end; + + // if left or bottom bound was not set, set them to 0 + if (Result.Left = Infinity) then + Result.Left := 0.0; + if (Result.Bottom = Infinity) then + Result.Bottom := 0.0; +end; + +procedure TFTFont.Render(const Text: WideString); +var + CharIndex: integer; + Glyph, PrevGlyph: TFTGlyph; + KernDelta: FT_Vector; +begin + // reset last glyph + PrevGlyph := nil; + + // draw current line + for CharIndex := 1 to Length(Text) do + begin + Glyph := TFTGlyph(GetGlyph(Text[CharIndex])); + if (Assigned(Glyph)) then + begin + // get kerning + if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + begin + FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_KERNING_UNSCALED, KernDelta); + glTranslatef(KernDelta.x * fFontUnitScale.X, 0, 0); + end; + + if (ReflectionPass) then + Glyph.RenderReflection() + else + Glyph.Render(fUseDisplayLists); + + glTranslatef(Glyph.Advance.x + fGlyphSpacing, 0, 0); + end; + + PrevGlyph := Glyph; + end; +end; + +function TFTFont.GetHeight(): single; +begin + Result := Ascender - Descender; +end; + +function TFTFont.GetAscender(): single; +begin + Result := fFace.ascender * fFontUnitScale.Y + Outset*2; +end; + +function TFTFont.GetDescender(): single; +begin + // Note: outset is not part of the descender as the baseline is lifted + Result := fFace.descender * fFontUnitScale.Y; +end; + +function TFTFont.GetUnderlinePosition(): single; +begin + Result := fFace.underline_position * fFontUnitScale.Y - Outset; +end; + +function TFTFont.GetUnderlineThickness(): single; +begin + Result := fFace.underline_thickness * fFontUnitScale.Y + Outset*2; +end; + + +{* + * TFTScalableFont + *} + +constructor TFTScalableFont.Create(const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean); +var + LoadFlags: FT_Int32; +begin + LoadFlags := FT_LOAD_DEFAULT; + // Disable hinting and grid-fitting to preserve font outlines at each font + // size, otherwise the font widths/heights do not match resulting in ugly + // text size changes during zooming. + // A drawback is a reduced quality with smaller font sizes but it is not that + // bad with gray-scaled rendering (at least it looks better than OpenGL's + // linear downscaling on minification). + if (UseMipmaps) then + LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; + inherited Create( + TFTFont.Create(Filename, Size, Size * OutsetAmount, LoadFlags), + UseMipmaps); +end; + +function TFTScalableFont.CreateMipmap(Level: integer; Scale: single): TFont; +var + ScaledSize: integer; + BaseFont: TFTFont; +begin + Result := nil; + BaseFont := TFTFont(fBaseFont); + ScaledSize := Round(BaseFont.Size * Scale); + // do not create mipmap fonts < 8 pixels + if (ScaledSize < 8) then + Exit; + Result := TFTFont.Create(BaseFont.fFilename, + ScaledSize, BaseFont.fOutset * Scale, + FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); +end; + +function TFTScalableFont.GetOutset(): single; +begin + Result := TFTFont(fBaseFont).Outset * fScale; +end; + +procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); +end; + + +{* + * TOutlineFont + *} + +constructor TFTOutlineFont.Create( + const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32); +begin + inherited Create(); + + fFilename := Filename; + fSize := Size; + fOutset := Outset; + + fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags); + fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags); + + ResetIntern(); +end; + +destructor TFTOutlineFont.Destroy; +begin + fOutlineFont.Free; + fInnerFont.Free; + inherited; +end; + +procedure TFTOutlineFont.ResetIntern(); +begin + // TODO: maybe swap fInnerFont/fOutlineFont.GlyphSpacing to use the spacing + // of the outline font? + //fInnerFont.GlyphSpacing := fOutset*2; + fOutlineFont.GlyphSpacing := -fOutset*2; + + fLineSpacing := fOutlineFont.LineSpacing; + fReflectionSpacing := fOutlineFont.ReflectionSpacing; + fOutlineColor := NewGLColor(0, 0, 0, -1); +end; + +procedure TFTOutlineFont.Reset(); +begin + inherited; + fInnerFont.Reset(); + fOutlineFont.Reset(); + ResetIntern(); +end; + +procedure TFTOutlineFont.DrawUnderline(const Text: WideString); +var + CurrentColor: TGLColor; + OutlineColor: TGLColor; +begin + // save current color + glGetFloatv(GL_CURRENT_COLOR, @CurrentColor.vals); + + // if the outline's alpha component is < 0 use the current alpha + OutlineColor := fOutlineColor; + if (OutlineColor.a < 0) then + OutlineColor.a := CurrentColor.a; + + // draw underline outline (in outline color) + glColor4fv(@OutlineColor.vals); + fOutlineFont.DrawUnderline(Text); + glColor4fv(@CurrentColor.vals); + + // draw underline inner part (in current color) + glPushMatrix(); + glTranslatef(fOutset, 0, 0); + fInnerFont.DrawUnderline(Text); + glPopMatrix(); +end; + +procedure TFTOutlineFont.Render(const Text: WideString); +var + CurrentColor: TGLColor; + OutlineColor: TGLColor; +begin + // save current color + glGetFloatv(GL_CURRENT_COLOR, @CurrentColor.vals); + + // if the outline's alpha component is < 0 use the current alpha + OutlineColor := fOutlineColor; + if (OutlineColor.a < 0) then + OutlineColor.a := CurrentColor.a; + + { setup and render outline font } + + glColor4fv(@OutlineColor.vals); + glPushMatrix(); + fOutlineFont.Render(Text); + glPopMatrix(); + glColor4fv(@CurrentColor.vals); + + { setup and render inner font } + + glPushMatrix(); + glTranslatef(fOutset, fOutset, 0); + fInnerFont.Render(Text); + glPopMatrix(); +end; + +procedure TFTOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); +begin + fOutlineColor := NewGLColor(r, g, b, a); +end; + +procedure TFTOutlineFont.FlushCache(KeepBaseSet: boolean); +begin + fOutlineFont.FlushCache(KeepBaseSet); + fInnerFont.FlushCache(KeepBaseSet); +end; + +function TFTOutlineFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +begin + Result := fOutlineFont.BBox(Text, Advance); +end; + +function TFTOutlineFont.GetHeight(): single; +begin + Result := fOutlineFont.Height; +end; + +function TFTOutlineFont.GetAscender(): single; +begin + Result := fOutlineFont.Ascender; +end; + +function TFTOutlineFont.GetDescender(): single; +begin + Result := fOutlineFont.Descender; +end; + +procedure TFTOutlineFont.SetLineSpacing(Spacing: single); +begin + inherited SetLineSpacing(Spacing); + fInnerFont.LineSpacing := Spacing; + fOutlineFont.LineSpacing := Spacing; +end; + +procedure TFTOutlineFont.SetGlyphSpacing(Spacing: single); +begin + inherited SetGlyphSpacing(Spacing); + fInnerFont.GlyphSpacing := Spacing; + fOutlineFont.GlyphSpacing := Spacing - Outset*2; +end; + +procedure TFTOutlineFont.SetReflectionSpacing(Spacing: single); +begin + inherited SetReflectionSpacing(Spacing); + fInnerFont.ReflectionSpacing := Spacing; + fOutlineFont.ReflectionSpacing := Spacing; +end; + +procedure TFTOutlineFont.SetStyle(Style: TFontStyle); +begin + inherited SetStyle(Style); + fInnerFont.Style := Style; + fOutlineFont.Style := Style; +end; + +function TFTOutlineFont.GetStyle(): TFontStyle; +begin + Result := inherited GetStyle(); +end; + +function TFTOutlineFont.GetUnderlinePosition(): single; +begin + Result := fOutlineFont.GetUnderlinePosition(); +end; + +function TFTOutlineFont.GetUnderlineThickness(): single; +begin + Result := fOutlineFont.GetUnderlinePosition(); +end; + +procedure TFTOutlineFont.SetUseKerning(Enable: boolean); +begin + inherited SetUseKerning(Enable); + fInnerFont.fUseKerning := Enable; + fOutlineFont.fUseKerning := Enable; +end; + +procedure TFTOutlineFont.SetReflectionPass(Enable: boolean); +begin + inherited SetReflectionPass(Enable); + fInnerFont.fReflectionPass := Enable; + fOutlineFont.fReflectionPass := Enable; +end; + +{** + * TScalableOutlineFont + *} + +constructor TFTScalableOutlineFont.Create( + const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean); +var + LoadFlags: FT_Int32; +begin + LoadFlags := FT_LOAD_DEFAULT; + // Disable hinting and grid-fitting (see TFTScalableFont.Create) + if (UseMipmaps) then + LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; + inherited Create( + TFTOutlineFont.Create(Filename, Size, Size*OutsetAmount, LoadFlags), + UseMipmaps); +end; + +function TFTScalableOutlineFont.CreateMipmap(Level: integer; Scale: single): TFont; +var + ScaledSize: integer; + BaseFont: TFTOutlineFont; +begin + Result := nil; + BaseFont := TFTOutlineFont(fBaseFont); + ScaledSize := Round(BaseFont.Size*Scale); + // do not create mipmap fonts < 8 pixels + if (ScaledSize < 8) then + Exit; + Result := TFTOutlineFont.Create(BaseFont.fFilename, + ScaledSize, BaseFont.fOutset*Scale, + FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); +end; + +function TFTScalableOutlineFont.GetOutset(): single; +begin + Result := TFTOutlineFont(fBaseFont).Outset * fScale; +end; + +procedure TFTScalableOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTOutlineFont(fMipmapFonts[Level]).SetOutlineColor(r, g, b, a); +end; + +procedure TFTScalableOutlineFont.FlushCache(KeepBaseSet: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTOutlineFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); +end; + + +{* + * TFTGlyph + *} + +const + {** + * Size of the transparent border surrounding the glyph image in the texture. + * The border is necessary because OpenGL does not smooth texels at the + * border of a texture with the GL_CLAMP or GL_CLAMP_TO_EDGE styles. + * Without the border, magnified glyph textures look very ugly at their edges. + * It looks edgy, as if some pixels are missing especially on the left edge + * (just set cTexSmoothBorder to 0 to see what is meant by this). + * With the border even the glyphs edges are blended to the border (transparent) + * color and everything looks nice. + * + * Note: + * OpenGL already supports texture border by setting the border parameter + * of glTexImage*D() to 1 and using a texture size of 2^m+2b and setting the + * border pixels to the border color. In some forums it is discouraged to use + * the border parameter as only a few of the more modern graphics cards support + * this feature. On an ATI Radeon 9700 card, the slowed down to 0.5 fps and + * the glyph's background got black. So instead of using this feature we + * handle it on our own. The only drawback is that textures might get bigger + * because the border might require a higher power of 2 size instead of just + * two additional pixels. + *} + cTexSmoothBorder = 1; + +procedure TFTGlyph.Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); + + procedure SetToMax(var Val1: GLubyte; Val2: GLubyte); {$IFDEF HasInline}inline;{$ENDIF} + begin + if (Val1 < Val2) then + Val1 := Val2; + end; + +var + I, X, Y: integer; + SrcBuffer,TmpBuffer: TGLubyteDynArray; + TexLine, TexLinePrev, TexLineNext: PGLubyteArray; + SrcLine: PGLubyteArray; + AlphaScale: single; + Value, ValueNeigh, ValueDiag: GLubyte; +const + // square-root of 2 used for diagonal neighbor pixels + cSqrt2 = 1.4142; + // number of ignored pixels on each edge of the bitmap. Consists of: + // - border used for font smoothing and + // - outer (extruded) bitmap pixel (because it is just written but never read) + cBorder = cTexSmoothBorder + 1; +begin + // allocate memory for temporary buffer + SetLength(SrcBuffer, Length(TexBuffer)); + FillChar(SrcBuffer[0], Length(TexBuffer), 0); + + // extrude pixel by pixel + for I := 1 to Ceil(Outset) do + begin + // swap arrays + TmpBuffer := TexBuffer; + TexBuffer := SrcBuffer; + SrcBuffer := TmpBuffer; + + // as long as we add an entire pixel of outset, use a solid color. + // If the fractional part is reached blend, e.g. outline=3.2 -> 3 solid + // pixels and one blended with alpha=0.2. + // For the fractional part I = Ceil(Outset) is always true. + if (I <= Outset) then + AlphaScale := 1 + else + AlphaScale := Outset - Trunc(Outset); + + // copy data to the expanded bitmap. + for Y := cBorder to fTexSize.Height - 2*cBorder do + begin + TexLine := @TexBuffer[Y*fTexSize.Width]; + TexLinePrev := @TexBuffer[(Y-1)*fTexSize.Width]; + TexLineNext := @TexBuffer[(Y+1)*fTexSize.Width]; + SrcLine := @SrcBuffer[Y*fTexSize.Width]; + + // expand current line's pixels + for X := cBorder to fTexSize.Width - 2*cBorder do + begin + Value := SrcLine[X]; + ValueNeigh := Round(Value * AlphaScale); + ValueDiag := Round(ValueNeigh / cSqrt2); + + SetToMax(TexLine[X], Value); + SetToMax(TexLine[X-1], ValueNeigh); + SetToMax(TexLine[X+1], ValueNeigh); + + SetToMax(TexLinePrev[X], ValueNeigh); + SetToMax(TexLinePrev[X-1], ValueDiag); + SetToMax(TexLinePrev[X+1], ValueDiag); + + SetToMax(TexLineNext[X], ValueNeigh); + SetToMax(TexLineNext[X-1], ValueDiag); + SetToMax(TexLineNext[X+1], ValueDiag); + end; + end; + end; + + TmpBuffer := nil; + SetLength(SrcBuffer, 0); +end; + +procedure TFTGlyph.CreateTexture(LoadFlags: FT_Int32); +var + X, Y: integer; + Glyph: FT_Glyph; + BitmapGlyph: FT_BitmapGlyph; + Bitmap: PFT_Bitmap; + BitmapLine: PChar; + BitmapBuffer: PChar; + TexBuffer: TGLubyteDynArray; + TexLine: PGLubyteArray; + CBox: FT_BBox; +begin + // load the Glyph for our character + if (FT_Load_Glyph(fFont.Face, fCharIndex, LoadFlags) <> 0) then + raise Exception.Create('FT_Load_Glyph failed'); + + // move the face's glyph into a Glyph object + if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then + raise Exception.Create('FT_Get_Glyph failed'); + + // store scaled advance width/height in glyph-object + fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2; + fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2; + + // get the contour's bounding box (in 1/64th pixels, not font-units) + FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox); + // convert 1/64th values to double values + fBounds.Left := CBox.xMin / 64; + fBounds.Right := CBox.xMax / 64 + fOutset*2; + fBounds.Bottom := CBox.yMin / 64; + fBounds.Top := CBox.yMax / 64 + fOutset*2; + + // convert the glyph to a bitmap (and destroy original glyph image) + FT_Glyph_To_Bitmap(Glyph, ft_render_mode_normal, nil, 1); + BitmapGlyph := FT_BitmapGlyph(Glyph); + + // get bitmap offsets + fBitmapCoords.Left := BitmapGlyph^.left - cTexSmoothBorder; + // Note: add 1*fOutset for lifting the baseline so outset fonts to not intersect + // with the baseline; Ceil(fOutset) for the outset pixels added to the bitmap. + fBitmapCoords.Top := BitmapGlyph^.top + fOutset+Ceil(fOutset) + cTexSmoothBorder; + + // make accessing the bitmap easier + Bitmap := @BitmapGlyph^.bitmap; + // get bitmap dimensions + fBitmapCoords.Width := Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2; + fBitmapCoords.Height := Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2; + + // get power-of-2 bitmap widths + fTexSize.Width := + NextPowerOf2(Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2); + fTexSize.Height := + NextPowerOf2(Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2); + + // texture-widths ignoring empty (power-of-2) padding space + fTexOffset.X := fBitmapCoords.Width / fTexSize.Width; + fTexOffset.Y := fBitmapCoords.Height / fTexSize.Height; + + // allocate memory for texture data + SetLength(TexBuffer, fTexSize.Width * fTexSize.Height); + FillChar(TexBuffer[0], Length(TexBuffer), 0); + + // Freetype stores the bitmap with either upper (pitch is > 0) or lower + // (pitch < 0) glyphs line first. Set the buffer to the upper line. + // See http://freetype.sourceforge.net/freetype2/docs/glyphs/glyphs-7.html + if (Bitmap.pitch > 0) then + BitmapBuffer := @Bitmap.buffer[0] + else + BitmapBuffer := @Bitmap.buffer[(Bitmap.rows-1) * Abs(Bitmap.pitch)]; + + // copy data to texture bitmap (upper line first). + for Y := 0 to Bitmap.rows-1 do + begin + // set pointer to first pixel in line that holds bitmap data. + // Each line starts with a cTexSmoothBorder pixel and multiple outset pixels + // that are added by Extrude() later. + TexLine := @TexBuffer[(Y + cTexSmoothBorder + Ceil(fOutset)) * fTexSize.Width + + cTexSmoothBorder + Ceil(fOutset)]; + // get next lower line offset, use pitch instead of width as it tells + // us the storage direction of the lines. In addition a line might be padded. + BitmapLine := @BitmapBuffer[Y * Bitmap.pitch]; + for X := 0 to Bitmap.width-1 do + TexLine[X] := GLubyte(BitmapLine[X]); + end; + + if (fOutset > 0) then + Extrude(TexBuffer, fOutset); + + // allocate resources for textures and display lists + glGenTextures(1, @fTexture); + + // setup texture parameters + glBindTexture(GL_TEXTURE_2D, fTexture); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + + glPixelStorei(GL_UNPACK_ALIGNMENT, 1); + // create alpha-map (GL_ALPHA component only). + // TexCoord (0,0) corresponds to the top left pixel of the glyph, + // (1,1) to the bottom right pixel. So the glyph is flipped as OpenGL uses + // a cartesian (y-axis up) coordinate system for textures. + // See the cTexSmoothBorder comment for info on texture borders. + glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, fTexSize.Width, fTexSize.Height, + 0, GL_ALPHA, GL_UNSIGNED_BYTE, @TexBuffer[0]); + + // free expanded data + SetLength(TexBuffer, 0); + + // create the display list + fDisplayList := glGenLists(1); + + // render to display-list + glNewList(fDisplayList, GL_COMPILE); + Render(false); + glEndList(); + + // free glyph data (bitmap, etc.) + FT_Done_Glyph(Glyph); +end; + +constructor TFTGlyph.Create(Font: TFTFont; ch: WideChar; Outset: single; + LoadFlags: FT_Int32); +begin + inherited Create(); + + fFont := Font; + fOutset := Outset; + + // get the Freetype char-index (use default UNICODE charmap) + fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch)); + + CreateTexture(LoadFlags); +end; + +destructor TFTGlyph.Destroy; +begin + if (fDisplayList <> 0) then + glDeleteLists(fDisplayList, 1); + if (fTexture <> 0) then + glDeleteTextures(1, @fTexture); + inherited; +end; + +procedure TFTGlyph.Render(UseDisplayLists: boolean); +begin + // use display-lists if enabled and exit + if (UseDisplayLists) then + begin + glCallList(fDisplayList); + Exit; + end; + + glBindTexture(GL_TEXTURE_2D, fTexture); + glPushMatrix(); + + // move to top left glyph position + glTranslatef(fBitmapCoords.Left, fBitmapCoords.Top, 0); + + // draw glyph texture + glBegin(GL_QUADS); + // top right + glTexCoord2f(fTexOffset.X, 0); + glVertex2f(fBitmapCoords.Width, 0); + + // top left + glTexCoord2f(0, 0); + glVertex2f(0, 0); + + // bottom left + glTexCoord2f(0, fTexOffset.Y); + glVertex2f(0, -fBitmapCoords.Height); + + // bottom right + glTexCoord2f(fTexOffset.X, fTexOffset.Y); + glVertex2f(fBitmapCoords.Width, -fBitmapCoords.Height); + glEnd(); + + glPopMatrix(); +end; + +procedure TFTGlyph.RenderReflection(); +var + Color: TGLColor; + TexUpperPos: single; + TexLowerPos: single; + UpperPos: single; +const + CutOff = 0.6; +begin + glPushMatrix(); + glBindTexture(GL_TEXTURE_2D, fTexture); + glGetFloatv(GL_CURRENT_COLOR, @Color.vals); + + // add extra space to the left of the glyph + glTranslatef(fBitmapCoords.Left, 0, 0); + + // The upper position of the glyph, if CutOff is 1.0, it is fFont.Ascender. + // If CutOff is set to 0.5 only half of the glyph height is displayed. + UpperPos := fFont.Descender + fFont.Height * CutOff; + + // the glyph texture's height is just the height of the glyph but not the font + // height. Setting a color for the upper and lower bounds of the glyph results + // in different color gradients. So we have to set the color values for the + // descender and ascender (as we have a cutoff, for the upper-pos here) as + // these positions are font but not glyph specific. + + // To get the texture positions we have to enhance the texture at the top and + // bottom by the amount from the top to ascender (rather upper-pos here) and + // from the bottom (Height-Top) to descender. Then we have to convert those + // heights to texture coordinates by dividing by the bitmap Height and + // removing the power-of-2 padding space by multiplying with fTexOffset.Y + // (as fBitmapCoords.Height corresponds to fTexOffset.Y and not 1.0). + TexUpperPos := -(UpperPos - fBitmapCoords.Top) / fBitmapCoords.Height * fTexOffset.Y; + TexLowerPos := (-(fFont.Descender + fBitmapCoords.Height - fBitmapCoords.Top) / + fBitmapCoords.Height + 1) * fTexOffset.Y; + + // draw glyph texture + glBegin(GL_QUADS); + // top right + glColor4f(Color.r, Color.g, Color.b, 0); + glTexCoord2f(fTexOffset.X, TexUpperPos); + glVertex2f(fBitmapCoords.Width, UpperPos); + + // top left + glTexCoord2f(0, TexUpperPos); + glVertex2f(0, UpperPos); + + // bottom left + glColor4f(Color.r, Color.g, Color.b, Color.a-0.3); + glTexCoord2f(0, TexLowerPos); + glVertex2f(0, fFont.Descender); + + // bottom right + glTexCoord2f(fTexOffset.X, TexLowerPos); + glVertex2f(fBitmapCoords.Width, fFont.Descender); + glEnd(); + + glPopMatrix(); + + // restore old color + // Note: glPopAttrib(GL_CURRENT_BIT)/glPopAttrib() is much slower then + // glGetFloatv(GL_CURRENT_COLOR, ...)/glColor4fv(...) + glColor4fv(@Color.vals); +end; + +function TFTGlyph.GetAdvance(): TPositionDbl; +begin + Result := fAdvance; +end; + +function TFTGlyph.GetBounds(): TBoundsDbl; +begin + Result := fBounds; +end; + + +{* + * TGlyphCache + *} + +constructor TGlyphCache.Create(); +begin + inherited; + fHash := TList.Create(); +end; + +destructor TGlyphCache.Destroy(); +begin + // free cached glyphs + FlushCache(false); + + // destroy TList + fHash.Free; + + inherited; +end; + +function TGlyphCache.FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; +var + I: integer; + Entry: TGlyphCacheHashEntry; +begin + Result := nil; + + for I := 0 to fHash.Count-1 do + begin + Entry := TGlyphCacheHashEntry(fHash[I]); + + if (Entry.BaseCode > BaseCode) then + begin + InsertPos := I; + Exit; + end; + + if (Entry.BaseCode = BaseCode) then + begin + InsertPos := I; + Result := @Entry.GlyphTable; + Exit; + end; + end; + + InsertPos := fHash.Count; +end; + +function TGlyphCache.AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; +var + BaseCode: cardinal; + GlyphCode: integer; + InsertPos: integer; + GlyphTable: PGlyphTable; + Entry: TGlyphCacheHashEntry; +begin + Result := false; + + BaseCode := cardinal(ch) shr 8; + GlyphTable := FindGlyphTable(BaseCode, InsertPos); + if (GlyphTable = nil) then + begin + Entry := TGlyphCacheHashEntry.Create(BaseCode); + GlyphTable := @Entry.GlyphTable; + fHash.Insert(InsertPos, Entry); + end; + + // get glyph table offset + GlyphCode := cardinal(ch) and $FF; + // insert glyph into table if not present + if (GlyphTable[GlyphCode] = nil) then + begin + GlyphTable[GlyphCode] := Glyph; + Result := true; + end; +end; + +procedure TGlyphCache.DeleteGlyph(ch: WideChar); +var + Table: PGlyphTable; + TableIndex, GlyphIndex: integer; + TableEmpty: boolean; +begin + // find table + Table := FindGlyphTable(cardinal(ch) shr 8, TableIndex); + if (Table = nil) then + Exit; + + // find glyph + GlyphIndex := cardinal(ch) and $FF; + if (Table[GlyphIndex] <> nil) then + begin + // destroy glyph + FreeAndNil(Table[GlyphIndex]); + + // check if table is empty + TableEmpty := true; + for GlyphIndex := 0 to High(Table^) do + begin + if (Table[GlyphIndex] <> nil) then + begin + TableEmpty := false; + Break; + end; + end; + + // free empty table + if (TableEmpty) then + begin + fHash.Delete(TableIndex); + end; + end; +end; + +function TGlyphCache.GetGlyph(ch: WideChar): TGlyph; +var + InsertPos: integer; + Table: PGlyphTable; +begin + Table := FindGlyphTable(cardinal(ch) shr 8, InsertPos); + if (Table = nil) then + Result := nil + else + Result := Table[cardinal(ch) and $FF]; +end; + +function TGlyphCache.HasGlyph(ch: WideChar): boolean; +begin + Result := (GetGlyph(ch) <> nil); +end; + +procedure TGlyphCache.FlushCache(KeepBaseSet: boolean); +var + EntryIndex, TableIndex: integer; + Entry: TGlyphCacheHashEntry; +begin + // destroy cached glyphs + for EntryIndex := 0 to fHash.Count-1 do + begin + Entry := TGlyphCacheHashEntry(fHash[EntryIndex]); + + // the base set (0-255) has BaseCode 0 as the upper bytes are 0. + if KeepBaseSet and (Entry.fBaseCode = 0) then + Continue; + + for TableIndex := 0 to High(Entry.GlyphTable) do + begin + if (Entry.GlyphTable[TableIndex] <> nil) then + FreeAndNil(Entry.GlyphTable[TableIndex]); + end; + FreeAndNil(Entry); + end; +end; + + +{* + * TGlyphCacheEntry + *} + +constructor TGlyphCacheHashEntry.Create(BaseCode: cardinal); +begin + inherited Create(); + fBaseCode := BaseCode; +end; + + +{* + * TFreeType + *} + +class function TFreeType.GetLibrary(): FT_Library; +begin + if (LibraryInst = nil) then + begin + // initialize freetype + if (FT_Init_FreeType(LibraryInst) <> 0) then + raise Exception.Create('FT_Init_FreeType failed'); + end; + Result := LibraryInst; +end; + +class procedure TFreeType.FreeLibrary(); +begin + if (LibraryInst <> nil) then + FT_Done_FreeType(LibraryInst); + LibraryInst := nil; +end; + + +{$IFDEF BITMAP_FONT} +{* + * TBitmapFont + *} + +constructor TBitmapFont.Create(const Filename: string; Outline: integer; + Baseline, Ascender, Descender: integer); +begin + inherited Create(); + + fTex := Texture.LoadTexture(true, Filename, TEXTURE_TYPE_TRANSPARENT, 0); + fTexSize := 1024; + fOutline := Outline; + fBaseline := Baseline; + fAscender := Ascender; + fDescender := Descender; + + LoadFontInfo(ChangeFileExt(Filename, '.dat')); + + ResetIntern(); +end; + +destructor TBitmapFont.Destroy(); +begin + glDeleteTextures(1, @fTex.TexNum); + inherited; +end; + +procedure TBitmapFont.ResetIntern(); +begin + fLineSpacing := Height; +end; + +procedure TBitmapFont.Reset(); +begin + inherited; + ResetIntern(); +end; + +procedure TBitmapFont.CorrectWidths(WidthMult: real; WidthAdd: integer); +var + Count: integer; +begin + for Count := 0 to 255 do + fWidths[Count] := Round(fWidths[Count] * WidthMult) + WidthAdd; +end; + +procedure TBitmapFont.LoadFontInfo(const InfoFile: string); +var + Stream: TFileStream; +begin + FillChar(fWidths[0], Length(fWidths), 0); + + Stream := nil; + try + Stream := TFileStream.Create(InfoFile, fmOpenRead); + Stream.Read(fWidths, 256); + except + raise Exception.Create('Could not read font info file ''' + InfoFile + ''''); + end; + Stream.Free; +end; + +function TBitmapFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +var + LineIndex, CharIndex: integer; + CharCode: cardinal; + Line: WideString; + LineWidth: double; +begin + Result.Left := 0; + Result.Right := 0; + Result.Top := Height; + Result.Bottom := 0; + + for LineIndex := 0 to High(Text) do + begin + Line := Text[LineIndex]; + LineWidth := 0; + for CharIndex := 1 to Length(Line) do + begin + CharCode := Ord(Line[CharIndex]); + if (CharCode < Length(fWidths)) then + LineWidth := LineWidth + fWidths[CharCode]; + end; + if (LineWidth > Result.Right) then + Result.Right := LineWidth; + end; +end; + +procedure TBitmapFont.RenderChar(ch: WideChar; var AdvanceX: real); +var + TexX, TexY: real; + TexR, TexB: real; + GlyphWidth: real; + PL, PT: real; + PR, PB: real; + CharCode: cardinal; +begin + CharCode := Ord(ch); + if (CharCode > High(fWidths)) then + CharCode := 0; + + GlyphWidth := fWidths[CharCode]; + + // set texture positions + TexX := (CharCode mod 16) * 1/16 + 1/32 - (GlyphWidth/2 - fOutline)/fTexSize; + TexY := (CharCode div 16) * 1/16 + {2 texels} 2/fTexSize; + TexR := (CharCode mod 16) * 1/16 + 1/32 + (GlyphWidth/2 + fOutline)/fTexSize; + TexB := (1 + CharCode div 16) * 1/16 - {2 texels} 2/fTexSize; + + // set vector positions + PL := AdvanceX - fOutline; + PR := PL + GlyphWidth + fOutline*2; + PB := -fBaseline; + PT := PB + fTexSize div 16; + + (* + if (Font.Blend) then + begin + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + end; + *) + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, fTex.TexNum); + + if (not ReflectionPass) then + begin + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + glEnd; + end + else + begin + glDepthRange(0, 10); + glDepthFunc(GL_LEQUAL); + glEnable(GL_DEPTH_TEST); + + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + glEnd; + + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + +(* + glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0.7); + glTexCoord2f(TexX, TexB); glVertex3f(PL, PB, 0); + glTexCoord2f(TexR, TexB); glVertex3f(PR, PB, 0); + + glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0); + glTexCoord2f(TexR, (TexY + TexB)/2); glVertex3f(PR, (PT + PB)/2, 0); + glTexCoord2f(TexX, (TexY + TexB)/2); glVertex3f(PL, (PT + PB)/2, 0); +*) + glEnd; + + //write the colour back + glColor4fv(@fTempColor); + + glDisable(GL_DEPTH_TEST); + end; // reflection + + glDisable(GL_TEXTURE_2D); + (* + if (Font.Blend) then + glDisable(GL_BLEND); + *) + + AdvanceX := AdvanceX + GlyphWidth; +end; + +procedure TBitmapFont.Render(const Text: WideString); +var + CharIndex: integer; + AdvanceX: real; +begin + // if there is no text do nothing + if (Text = '') then + Exit; + + //Save the current color and alpha (for reflection) + glGetFloatv(GL_CURRENT_COLOR, @fTempColor); + + AdvanceX := 0; + for CharIndex := 1 to Length(Text) do + begin + RenderChar(Text[CharIndex], AdvanceX); + end; +end; + +function TBitmapFont.GetHeight(): single; +begin + Result := fAscender - fDescender; +end; + +function TBitmapFont.GetAscender(): single; +begin + Result := fAscender; +end; + +function TBitmapFont.GetDescender(): single; +begin + Result := fDescender; +end; + +function TBitmapFont.GetUnderlinePosition(): single; +begin + Result := -2.0; +end; + +function TBitmapFont.GetUnderlineThickness(): single; +begin + Result := 1.0; +end; + +{$ENDIF BITMAP_FONT} + + +initialization + +finalization + TFreeType.FreeLibrary(); + +end. -- cgit v1.2.3 From e8a388e32a4563ac9ea0895ca6c7cdf83cf9d3ec Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 28 Oct 2008 18:57:02 +0000 Subject: - glPrint(Pchar) -> glPrint(string) - glPrintLetter removed - font engine handles FT_PIXEL_MODE_MONO as FT_Glyph_To_Bitmap(FT_RENDER_MODE_NORMAL) might return a 1bit/pixel black/white image instead of 8bit/pixel gray shaded one (happened with 16px japanese glyphs of simsun.ttf, latin ones were correct). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1482 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) (limited to 'src/base/UFont.pas') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 30be4c3b..a72bca21 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -2019,8 +2019,8 @@ var Glyph: FT_Glyph; BitmapGlyph: FT_BitmapGlyph; Bitmap: PFT_Bitmap; - BitmapLine: PChar; - BitmapBuffer: PChar; + BitmapLine: PByteArray; + BitmapBuffer: PByteArray; TexBuffer: TGLubyteDynArray; TexLine: PGLubyteArray; CBox: FT_BBox; @@ -2045,8 +2045,9 @@ begin fBounds.Bottom := CBox.yMin / 64; fBounds.Top := CBox.yMax / 64 + fOutset*2; - // convert the glyph to a bitmap (and destroy original glyph image) - FT_Glyph_To_Bitmap(Glyph, ft_render_mode_normal, nil, 1); + // convert the glyph to a bitmap (and destroy original glyph image). + // Request 8 bit gray level pixel mode. + FT_Glyph_To_Bitmap(Glyph, FT_RENDER_MODE_NORMAL, nil, 1); BitmapGlyph := FT_BitmapGlyph(Glyph); // get bitmap offsets @@ -2094,8 +2095,23 @@ begin // get next lower line offset, use pitch instead of width as it tells // us the storage direction of the lines. In addition a line might be padded. BitmapLine := @BitmapBuffer[Y * Bitmap.pitch]; - for X := 0 to Bitmap.width-1 do - TexLine[X] := GLubyte(BitmapLine[X]); + + // check for pixel mode and copy pixels + // Should be 8 bit gray, but even with FT_RENDER_MODE_NORMAL, freetype + // sometimes (e.g. 16px sized japanese fonts) fallbacks to 1 bit pixels. + case (Bitmap.pixel_mode) of + FT_PIXEL_MODE_GRAY: begin // 8 bit gray + for X := 0 to Bitmap.width-1 do + TexLine[X] := BitmapLine[X]; + end; + FT_PIXEL_MODE_MONO: begin // 1 bit mono + for X := 0 to Bitmap.width-1 do + TexLine[X] := High(GLubyte) * ((BitmapLine[X div 8] shr (7-(X mod 8))) and $1); + end; + else begin + // unhandled pixel format + end; + end; end; if (fOutset > 0) then -- cgit v1.2.3 From 917901e8e33438c425aef50a0a7417f32d77b760 Mon Sep 17 00:00:00 2001 From: s_alexander Date: Mon, 9 Nov 2009 00:27:55 +0000 Subject: merged unicode branch (r1931) into trunk git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1939 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 440 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 257 insertions(+), 183 deletions(-) (limited to 'src/base/UFont.pas') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index a72bca21..72409ac1 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -47,12 +47,14 @@ uses glext, glu, sdl, + Math, + Classes, + SysUtils, + UUnicodeUtils, {$IFDEF BITMAP_FONT} UTexture, {$ENDIF} - Math, - Classes, - SysUtils; + UPath; type @@ -60,7 +62,7 @@ type TGLubyteArray = array[0 .. (MaxInt div SizeOf(GLubyte))-1] of GLubyte; TGLubyteDynArray = array of GLubyte; - TWideStringArray = array of WideString; + TUCS4StringArray = array of UCS4String; TGLColor = packed record case byte of @@ -126,34 +128,34 @@ type {** * Splits lines in Text seperated by newline (char-code #13). - * @param Text UTF-8 encoded string - * @param Lines splitted WideString lines + * @param Text UCS-4 encoded string + * @param Lines splitted UCS4String lines *} - procedure SplitLines(const Text: UTF8String; var Lines: TWideStringArray); + procedure SplitLines(const Text: UCS4String; var Lines: TUCS4StringArray); {** - * Print an array of WideStrings. Each array-item is a line of text. + * Print an array of UCS4Strings. Each array-item is a line of text. * Lines of text are seperated by the line-spacing. * This is the base function for all text drawing. *} - procedure Print(const Text: TWideStringArray); overload; virtual; + procedure Print(const Text: TUCS4StringArray); overload; virtual; {** * Draws an underline. *} - procedure DrawUnderline(const Text: WideString); virtual; + procedure DrawUnderline(const Text: UCS4String); virtual; {** * Renders (one) line of text. *} - procedure Render(const Text: WideString); virtual; abstract; + procedure Render(const Text: UCS4String); virtual; abstract; {** * Returns the bounds of text-lines contained in Text. * @param(Advance if true the right bound is set to the advance instead * of the minimal right bound.) *} - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract; + function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract; {** * Resets all user settings to default values. @@ -188,9 +190,11 @@ type {** * Prints a text. *} + procedure Print(const Text: UCS4String); overload; + {** UTF-16 version of @link(Print) } procedure Print(const Text: WideString); overload; {** UTF-8 version of @link(Print) } - procedure Print(const Text: string); overload; + procedure Print(const Text: UTF8String); overload; {** * Calculates the bounding box (width and height) around Text. @@ -203,6 +207,8 @@ type * bigger than the text's width as it additionally contains the advance * and glyph-spacing of the last character. *} + function BBox(const Text: UCS4String; Advance: boolean = true): TBoundsDbl; overload; + {** UTF-16 version of @link(BBox) } function BBox(const Text: WideString; Advance: boolean = true): TBoundsDbl; overload; {** UTF-8 version of @link(BBox) } function BBox(const Text: UTF8String; Advance: boolean = true): TBoundsDbl; overload; @@ -249,9 +255,9 @@ type /// Mipmap fonts (size[level+1] = size[level]/2) fMipmapFonts: array[0..cMaxMipmapLevel] of TFont; - procedure Render(const Text: WideString); override; - procedure Print(const Text: TWideStringArray); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + procedure Render(const Text: UCS4String); override; + procedure Print(const Text: TUCS4StringArray); override; + function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override; {** * Callback called for creation of each mipmap font. @@ -322,7 +328,7 @@ type {** * Table for storage of max. 256 glyphs. - * Used for the second cache level. Indexed by the LSB of the WideChar + * Used for the second cache level. Indexed by the LSB of the UCS4Char * char-code. *} PGlyphTable = ^TGlyphTable; @@ -332,7 +338,7 @@ type * Cache for glyphs of a single font. * The cached glyphs are stored inside a hash-list. * Hashing is performed in two steps: - * 1. the least significant byte (LSB) of the WideChar character code + * 1. the least significant byte (LSB) of the UCS4Char character code * is removed (shr 8) and the result (we call it BaseCode here) looked up in * the hash-list. * 2. Each entry of the hash-list contains a table with max. 256 entries. @@ -359,22 +365,22 @@ type * Add glyph Glyph with char-code ch to the cache. * @returns @true on success, @false otherwise *} - function AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; + function AddGlyph(ch: UCS4Char; const Glyph: TGlyph): boolean; {** * Removes the glyph with char-code ch from the cache. *} - procedure DeleteGlyph(ch: WideChar); + procedure DeleteGlyph(ch: UCS4Char); {** * Removes the glyph with char-code ch from the cache. *} - function GetGlyph(ch: WideChar): TGlyph; + function GetGlyph(ch: UCS4Char): TGlyph; {** * Checks if a glyph with char-code ch is cached. *} - function HasGlyph(ch: WideChar): boolean; + function HasGlyph(ch: UCS4Char): boolean; {** * Remove and free all cached glyphs. If KeepBaseSet is set to @@ -408,13 +414,13 @@ type * Retrieves a cached glyph with char-code ch from cache. * If the glyph is not already cached, it is loaded with LoadGlyph(). *} - function GetGlyph(ch: WideChar): TGlyph; + function GetGlyph(ch: UCS4Char): TGlyph; {** * Callback to create (load) a glyph with char-code ch. * Implemented by subclasses. *} - function LoadGlyph(ch: WideChar): TGlyph; virtual; abstract; + function LoadGlyph(ch: UCS4Char): TGlyph; virtual; abstract; public constructor Create(); @@ -436,6 +442,7 @@ type *} TFTGlyph = class(TGlyph) private + fCharCode: UCS4Char; //**< Char code fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code) fDisplayList: GLuint; //**< Display-list ID fTexture: GLuint; //**< Texture ID @@ -458,7 +465,7 @@ type * The bitmap must be 2* pixels wider and higher than the * original glyph's bitmap with the latter centered in it. *} - procedure Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); + procedure StrokeBorder(var Glyph: FT_Glyph); {** * Creates an OpenGL texture (and display list) for the glyph. @@ -477,7 +484,7 @@ type * Creates a glyph with char-code ch from font Font. * @param LoadFlags flags passed to FT_Load_Glyph() *} - constructor Create(Font: TFTFont; ch: WideChar; Outset: single; + constructor Create(Font: TFTFont; ch: UCS4Char; Outset: single; LoadFlags: FT_Int32); destructor Destroy(); override; @@ -490,6 +497,8 @@ type property CharIndex: FT_UInt read fCharIndex; end; + TFontPart = ( fpNone, fpInner, fpOutline ); + {** * Freetype font class. *} @@ -498,19 +507,20 @@ type procedure ResetIntern(); protected - fFilename: string; //**< filename of the font-file + fFilename: IPath; //**< filename of the font-file fSize: integer; //**< Font base size (in pixels) fOutset: single; //**< size of outset extrusion (in pixels) fFace: FT_Face; //**< Holds the height of the font fLoadFlags: FT_Int32; //**< FT glpyh load-flags fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing + fPart: TFontPart; //**< indicates the part of an outline font {** @seealso TCachedFont.LoadGlyph } - function LoadGlyph(ch: WideChar): TGlyph; override; + function LoadGlyph(ch: UCS4Char): TGlyph; override; - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + procedure Render(const Text: UCS4String); override; + function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override; function GetHeight(): single; override; function GetAscender(): single; override; @@ -528,7 +538,7 @@ type * @param LoadFlags flags passed to FT_Load_Glyph() * @raises Exception if the font-file could not be loaded *} - constructor Create(const Filename: string; + constructor Create(const Filename: IPath; Size: integer; Outset: single = 0.0; LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); @@ -558,7 +568,7 @@ type * The extrusion in pixels is Size*OutsetAmount * (0.0 -> no extrusion, 0.1 -> 10%). *} - constructor Create(const Filename: string; + constructor Create(const Filename: IPath; Size: integer; OutsetAmount: single = 0.0; UseMipmaps: boolean = true); @@ -576,7 +586,7 @@ type *} TFTOutlineFont = class(TFont) private - fFilename: string; + fFilename: IPath; fSize: integer; fOutset: single; fInnerFont, fOutlineFont: TFTFont; @@ -585,9 +595,9 @@ type procedure ResetIntern(); protected - procedure DrawUnderline(const Text: WideString); override; - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + procedure DrawUnderline(const Text: UCS4String); override; + procedure Render(const Text: UCS4String); override; + function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override; function GetHeight(): single; override; function GetAscender(): single; override; @@ -603,7 +613,7 @@ type procedure SetReflectionPass(Enable: boolean); override; public - constructor Create(const Filename: string; + constructor Create(const Filename: IPath; Size: integer; Outset: single; LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); destructor Destroy; override; @@ -637,7 +647,7 @@ type function CreateMipmap(Level: integer; Scale: single): TFont; override; public - constructor Create(const Filename: string; + constructor Create(const Filename: IPath; Size: integer; OutsetAmount: single; UseMipmaps: boolean = true); @@ -672,18 +682,18 @@ type procedure ResetIntern(); - procedure RenderChar(ch: WideChar; var AdvanceX: real); + procedure RenderChar(ch: UCS4Char; var AdvanceX: real); {** * Load font widths from an info file. * @param InfoFile the name of the info (.dat) file * @raises Exception if the file is corrupted *} - procedure LoadFontInfo(const InfoFile: string); + procedure LoadFontInfo(const InfoFile: IPath); protected - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + procedure Render(const Text: UCS4String); override; + function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override; function GetHeight(): single; override; function GetAscender(): single; override; @@ -699,7 +709,7 @@ type * (y-axis up) and from the lower edge of the glyphs bounding box) * @param(Ascender pixels from baseline to top of highest glyph) *} - constructor Create(const Filename: string; Outline: integer; + constructor Create(const Filename: IPath; Outline: integer; Baseline, Ascender, Descender: integer); destructor Destroy(); override; @@ -801,37 +811,61 @@ begin ResetIntern(); end; -procedure TFont.SplitLines(const Text: UTF8String; var Lines: TWideStringArray); +procedure TFont.SplitLines(const Text: UCS4String; var Lines: TUCS4StringArray); var - LineList: TStringList; - LineIndex: integer; + CharIndex: integer; + LineStart: integer; + LineLength: integer; + EOT: boolean; // End-Of-Text begin - // split lines on newline (there is no WideString version of ExtractStrings) - LineList := TStringList.Create(); - ExtractStrings([#13], [], PChar(Text), LineList); + // split lines on newline + SetLength(Lines, 0); + EOT := false; + LineStart := 0; + + for CharIndex := 0 to High(Text) do + begin + // check for end of text (UCS4Strings are zero-terminated) + if (CharIndex = High(Text)) then + EOT := true; + + // check for newline (carriage return (#13)) or end of text + if (Text[CharIndex] = 13) or EOT then + begin + LineLength := CharIndex - LineStart; + // check if last character was a newline + if (EOT and (LineLength = 0)) then + Break; - // create an array of WideStrins from the UTF-8 string-list - SetLength(Lines, LineList.Count); - for LineIndex := 0 to LineList.Count-1 do - Lines[LineIndex] := UTF8Decode(LineList[LineIndex]); - LineList.Free(); + // copy line (even if LineLength is 0) + SetLength(Lines, Length(Lines)+1); + Lines[High(Lines)] := UCS4Copy(Text, LineStart, LineLength); + + LineStart := CharIndex+1; + end; + end; end; -function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl; +function TFont.BBox(const Text: UCS4String; Advance: boolean): TBoundsDbl; var - LineArray: TWideStringArray; + LineArray: TUCS4StringArray; begin SplitLines(Text, LineArray); Result := BBox(LineArray, Advance); SetLength(LineArray, 0); end; +function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl; +begin + Result := BBox(UTF8Decode(Text), Advance); +end; + function TFont.BBox(const Text: WideString; Advance: boolean): TBoundsDbl; begin - Result := BBox(UTF8Encode(Text), Advance); + Result := BBox(WideStringToUCS4String(Text), Advance); end; -procedure TFont.Print(const Text: TWideStringArray); +procedure TFont.Print(const Text: TUCS4StringArray); var LineIndex: integer; begin @@ -912,21 +946,26 @@ begin glPopAttrib(); end; -procedure TFont.Print(const Text: string); +procedure TFont.Print(const Text: UCS4String); var - LineArray: TWideStringArray; + LineArray: TUCS4StringArray; begin SplitLines(Text, LineArray); Print(LineArray); SetLength(LineArray, 0); end; +procedure TFont.Print(const Text: UTF8String); +begin + Print(UTF8Decode(Text)); +end; + procedure TFont.Print(const Text: WideString); begin - Print(UTF8Encode(Text)); + Print(WideStringToUCS4String(Text)); end; -procedure TFont.DrawUnderline(const Text: WideString); +procedure TFont.DrawUnderline(const Text: UCS4String); var UnderlineY1, UnderlineY2: single; Bounds: TBoundsDbl; @@ -1194,7 +1233,7 @@ begin glScalef(MipmapScale, MipmapScale, 0); end; -procedure TScalableFont.Print(const Text: TWideStringArray); +procedure TScalableFont.Print(const Text: TUCS4StringArray); begin glPushMatrix(); @@ -1210,12 +1249,12 @@ begin glPopMatrix(); end; -procedure TScalableFont.Render(const Text: WideString); +procedure TScalableFont.Render(const Text: UCS4String); begin Assert(false, 'Unused TScalableFont.Render() was called'); end; -function TScalableFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +function TScalableFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; begin Result := fBaseFont.BBox(Text, Advance); Result.Left := Result.Left * fScale * fAspect; @@ -1346,7 +1385,7 @@ begin inherited; end; -function TCachedFont.GetGlyph(ch: WideChar): TGlyph; +function TCachedFont.GetGlyph(ch: UCS4Char): TGlyph; begin Result := fCache.GetGlyph(ch); if (Result = nil) then @@ -1368,11 +1407,11 @@ end; *} constructor TFTFont.Create( - const Filename: string; + const Filename: IPath; Size: integer; Outset: single; LoadFlags: FT_Int32); var - i: WideChar; + ch: UCS4Char; begin inherited Create(); @@ -1381,10 +1420,11 @@ begin fOutset := Outset; fLoadFlags := LoadFlags; fUseDisplayLists := true; + fPart := fpNone; // load font information - if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename), 0, fFace) <> 0) then - raise Exception.Create('FT_New_Face: Could not load font ''' + Filename + ''''); + if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename.ToNative), 0, fFace) <> 0) then + raise Exception.Create('FT_New_Face: Could not load font ''' + Filename.ToNative + ''''); // support scalable fonts only if (not FT_IS_SCALABLE(fFace)) then @@ -1400,8 +1440,8 @@ begin ResetIntern(); // pre-cache some commonly used glyphs (' ' - '~') - for i := #32 to #126 do - fCache.AddGlyph(i, TFTGlyph.Create(Self, i, Outset, LoadFlags)); + for ch := 32 to 126 do + fCache.AddGlyph(ch, TFTGlyph.Create(Self, ch, Outset, LoadFlags)); end; destructor TFTFont.Destroy(); @@ -1424,15 +1464,15 @@ begin ResetIntern(); end; -function TFTFont.LoadGlyph(ch: WideChar): TGlyph; +function TFTFont.LoadGlyph(ch: UCS4Char): TGlyph; begin Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags); end; -function TFTFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +function TFTFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; var Glyph, PrevGlyph: TFTGlyph; - TextLine: WideString; + TextLine: UCS4String; LineYOffset: single; LineIndex, CharIndex: integer; LineBounds: TBoundsDbl; @@ -1462,7 +1502,7 @@ begin LineBounds.Top := 0; // for each glyph image, compute its bounding box - for CharIndex := 1 to Length(TextLine) do + for CharIndex := 0 to LengthUCS4(TextLine)-1 do begin Glyph := TFTGlyph(GetGlyph(TextLine[CharIndex])); if (Glyph <> nil) then @@ -1480,9 +1520,9 @@ begin LineBounds.Left := LineBounds.Right + Glyph.Bounds.Left; // update right bound - if (CharIndex < Length(TextLine)) or // not the last character - (TextLine[CharIndex] = ' ') or // on space char (Bounds.Right = 0) - Advance then // or in advance mode + if (CharIndex < LengthUCS4(TextLine)-1) or // not the last character + (TextLine[CharIndex] = Ord(' ')) or // on space char (Bounds.Right = 0) + Advance then // or in advance mode begin // add advance and glyph spacing LineBounds.Right := LineBounds.Right + Glyph.Advance.x + GlyphSpacing @@ -1534,13 +1574,13 @@ begin end; // if left or bottom bound was not set, set them to 0 - if (Result.Left = Infinity) then + if (IsInfinite(Result.Left)) then Result.Left := 0.0; - if (Result.Bottom = Infinity) then + if (IsInfinite(Result.Bottom)) then Result.Bottom := 0.0; end; -procedure TFTFont.Render(const Text: WideString); +procedure TFTFont.Render(const Text: UCS4String); var CharIndex: integer; Glyph, PrevGlyph: TFTGlyph; @@ -1550,7 +1590,7 @@ begin PrevGlyph := nil; // draw current line - for CharIndex := 1 to Length(Text) do + for CharIndex := 0 to LengthUCS4(Text)-1 do begin Glyph := TFTGlyph(GetGlyph(Text[CharIndex])); if (Assigned(Glyph)) then @@ -1606,7 +1646,7 @@ end; * TFTScalableFont *} -constructor TFTScalableFont.Create(const Filename: string; +constructor TFTScalableFont.Create(const Filename: IPath; Size: integer; OutsetAmount: single; UseMipmaps: boolean); var @@ -1662,7 +1702,7 @@ end; *} constructor TFTOutlineFont.Create( - const Filename: string; + const Filename: IPath; Size: integer; Outset: single; LoadFlags: FT_Int32); begin @@ -1673,7 +1713,9 @@ begin fOutset := Outset; fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags); + fInnerFont.fPart := fpInner; fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags); + fOutlineFont.fPart := fpOutline; ResetIntern(); end; @@ -1705,7 +1747,7 @@ begin ResetIntern(); end; -procedure TFTOutlineFont.DrawUnderline(const Text: WideString); +procedure TFTOutlineFont.DrawUnderline(const Text: UCS4String); var CurrentColor: TGLColor; OutlineColor: TGLColor; @@ -1730,7 +1772,7 @@ begin glPopMatrix(); end; -procedure TFTOutlineFont.Render(const Text: WideString); +procedure TFTOutlineFont.Render(const Text: UCS4String); var CurrentColor: TGLColor; OutlineColor: TGLColor; @@ -1770,7 +1812,7 @@ begin fInnerFont.FlushCache(KeepBaseSet); end; -function TFTOutlineFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +function TFTOutlineFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; begin Result := fOutlineFont.BBox(Text, Advance); end; @@ -1852,7 +1894,7 @@ end; *} constructor TFTScalableOutlineFont.Create( - const Filename: string; + const Filename: IPath; Size: integer; OutsetAmount: single; UseMipmaps: boolean); var @@ -1935,82 +1977,113 @@ const *} cTexSmoothBorder = 1; -procedure TFTGlyph.Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); +procedure TFTGlyph.StrokeBorder(var Glyph: FT_Glyph); +var + Outline: PFT_Outline; + OuterStroker, InnerStroker: FT_Stroker; + OuterNumPoints, InnerNumPoints, GlyphNumPoints: FT_UInt; + OuterNumContours, InnerNumContours, GlyphNumContours: FT_UInt; + OuterBorder, InnerBorder: FT_StrokerBorder; + OutlineFlags: FT_Int; + UseStencil: boolean; +begin + // It is possible to extrude the borders of a glyph with FT_Glyph_Stroke + // but it will extrude the border to the outside and the inside of a glyph + // although we just want to extrude to the outside. + // FT_Glyph_StrokeBorder extrudes to the outside but also fills the interior + // (this is what we need for bold fonts). + // In both cases the inner font and outline font (border) will overlap. + // Normally this does not matter but it does if alpha blending is active. + // In this case if e.g. the inner color is set to white, the outline to red + // and alpha to 0.5 the inner part will not be white it will be pink. + + InnerStroker := nil; + OuterStroker := nil; + + // If we are to create the interior of an outlined font (fInner = true) + // we have to create two borders: + // - one extruded to the outside by fOutset pixels and + // - one extruded to the inside by almost 0 zero pixels. + // The second one is used as a stencil for the first one, clearing the + // interiour of the glyph. + // The stencil is not needed to create bold fonts. + UseStencil := (fFont.fPart = fpInner); + + Outline := @FT_OutlineGlyph(Glyph).outline; + + OuterBorder := FT_Outline_GetOutsideBorder(Outline); + if (OuterBorder = FT_STROKER_BORDER_LEFT) then + InnerBorder := FT_STROKER_BORDER_RIGHT + else + InnerBorder := FT_STROKER_BORDER_LEFT; + + { extrude outer border } + + if (FT_Stroker_New(Glyph.library_, OuterStroker) <> 0) then + raise Exception.Create('FT_Stroker_New failed!'); + FT_Stroker_Set( + OuterStroker, + Round(fOutset * 64), + FT_STROKER_LINECAP_ROUND, + FT_STROKER_LINEJOIN_BEVEL, + 0); + + // similar to FT_Glyph_StrokeBorder(inner = FT_FALSE) but it is possible to + // use FT_Stroker_ExportBorder() afterwards to combine inner and outer borders + if (FT_Stroker_ParseOutline(OuterStroker, Outline, FT_FALSE) <> 0) then + raise Exception.Create('FT_Stroker_ParseOutline failed!'); - procedure SetToMax(var Val1: GLubyte; Val2: GLubyte); {$IFDEF HasInline}inline;{$ENDIF} + FT_Stroker_GetBorderCounts(OuterStroker, OuterBorder, OuterNumPoints, OuterNumContours); + + { extrude inner border (= stencil) } + + if (UseStencil) then begin - if (Val1 < Val2) then - Val1 := Val2; + if (FT_Stroker_New(Glyph.library_, InnerStroker) <> 0) then + raise Exception.Create('FT_Stroker_New failed!'); + FT_Stroker_Set( + InnerStroker, + 63, // extrude at most one pixel to avoid a black border + FT_STROKER_LINECAP_ROUND, + FT_STROKER_LINEJOIN_BEVEL, + 0); + + if (FT_Stroker_ParseOutline(InnerStroker, Outline, FT_FALSE) <> 0) then + raise Exception.Create('FT_Stroker_ParseOutline failed!'); + + FT_Stroker_GetBorderCounts(InnerStroker, InnerBorder, InnerNumPoints, InnerNumContours); + end else begin + InnerNumPoints := 0; + InnerNumContours := 0; end; -var - I, X, Y: integer; - SrcBuffer,TmpBuffer: TGLubyteDynArray; - TexLine, TexLinePrev, TexLineNext: PGLubyteArray; - SrcLine: PGLubyteArray; - AlphaScale: single; - Value, ValueNeigh, ValueDiag: GLubyte; -const - // square-root of 2 used for diagonal neighbor pixels - cSqrt2 = 1.4142; - // number of ignored pixels on each edge of the bitmap. Consists of: - // - border used for font smoothing and - // - outer (extruded) bitmap pixel (because it is just written but never read) - cBorder = cTexSmoothBorder + 1; -begin - // allocate memory for temporary buffer - SetLength(SrcBuffer, Length(TexBuffer)); - FillChar(SrcBuffer[0], Length(TexBuffer), 0); - - // extrude pixel by pixel - for I := 1 to Ceil(Outset) do - begin - // swap arrays - TmpBuffer := TexBuffer; - TexBuffer := SrcBuffer; - SrcBuffer := TmpBuffer; - - // as long as we add an entire pixel of outset, use a solid color. - // If the fractional part is reached blend, e.g. outline=3.2 -> 3 solid - // pixels and one blended with alpha=0.2. - // For the fractional part I = Ceil(Outset) is always true. - if (I <= Outset) then - AlphaScale := 1 - else - AlphaScale := Outset - Trunc(Outset); - - // copy data to the expanded bitmap. - for Y := cBorder to fTexSize.Height - 2*cBorder do - begin - TexLine := @TexBuffer[Y*fTexSize.Width]; - TexLinePrev := @TexBuffer[(Y-1)*fTexSize.Width]; - TexLineNext := @TexBuffer[(Y+1)*fTexSize.Width]; - SrcLine := @SrcBuffer[Y*fTexSize.Width]; + { combine borders (subtract: OuterBorder - InnerBorder) } - // expand current line's pixels - for X := cBorder to fTexSize.Width - 2*cBorder do - begin - Value := SrcLine[X]; - ValueNeigh := Round(Value * AlphaScale); - ValueDiag := Round(ValueNeigh / cSqrt2); + GlyphNumPoints := InnerNumPoints + OuterNumPoints; + GlyphNumContours := InnerNumContours + OuterNumContours; - SetToMax(TexLine[X], Value); - SetToMax(TexLine[X-1], ValueNeigh); - SetToMax(TexLine[X+1], ValueNeigh); + // save flags before deletion (TODO: set them on the resulting outline) + OutlineFlags := Outline.flags; - SetToMax(TexLinePrev[X], ValueNeigh); - SetToMax(TexLinePrev[X-1], ValueDiag); - SetToMax(TexLinePrev[X+1], ValueDiag); + // resize glyph outline to hold inner and outer border + FT_Outline_Done(Glyph.Library_, Outline); + if (FT_Outline_New(Glyph.Library_, GlyphNumPoints, GlyphNumContours, Outline) <> 0) then + raise Exception.Create('FT_Outline_New failed!'); - SetToMax(TexLineNext[X], ValueNeigh); - SetToMax(TexLineNext[X-1], ValueDiag); - SetToMax(TexLineNext[X+1], ValueDiag); - end; - end; - end; + Outline.n_points := 0; + Outline.n_contours := 0; - TmpBuffer := nil; - SetLength(SrcBuffer, 0); + // add points to outline. The inner-border is used as a stencil. + FT_Stroker_ExportBorder(OuterStroker, OuterBorder, Outline); + if (UseStencil) then + FT_Stroker_ExportBorder(InnerStroker, InnerBorder, Outline); + if (FT_Outline_Check(outline) <> 0) then + raise Exception.Create('FT_Stroker_ExportBorder failed!'); + + if (InnerStroker <> nil) then + FT_Stroker_Done(InnerStroker); + if (OuterStroker <> nil) then + FT_Stroker_Done(OuterStroker); end; procedure TFTGlyph.CreateTexture(LoadFlags: FT_Int32); @@ -2033,6 +2106,9 @@ begin if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then raise Exception.Create('FT_Get_Glyph failed'); + if (fOutset > 0) then + StrokeBorder(Glyph); + // store scaled advance width/height in glyph-object fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2; fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2; @@ -2114,9 +2190,6 @@ begin end; end; - if (fOutset > 0) then - Extrude(TexBuffer, fOutset); - // allocate resources for textures and display lists glGenTextures(1, @fTexture); @@ -2151,13 +2224,14 @@ begin FT_Done_Glyph(Glyph); end; -constructor TFTGlyph.Create(Font: TFTFont; ch: WideChar; Outset: single; +constructor TFTGlyph.Create(Font: TFTFont; ch: UCS4Char; Outset: single; LoadFlags: FT_Int32); begin inherited Create(); fFont := Font; fOutset := Outset; + fCharCode := ch; // get the Freetype char-index (use default UNICODE charmap) fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch)); @@ -2336,7 +2410,7 @@ begin InsertPos := fHash.Count; end; -function TGlyphCache.AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; +function TGlyphCache.AddGlyph(ch: UCS4Char; const Glyph: TGlyph): boolean; var BaseCode: cardinal; GlyphCode: integer; @@ -2346,7 +2420,7 @@ var begin Result := false; - BaseCode := cardinal(ch) shr 8; + BaseCode := Ord(ch) shr 8; GlyphTable := FindGlyphTable(BaseCode, InsertPos); if (GlyphTable = nil) then begin @@ -2356,7 +2430,7 @@ begin end; // get glyph table offset - GlyphCode := cardinal(ch) and $FF; + GlyphCode := Ord(ch) and $FF; // insert glyph into table if not present if (GlyphTable[GlyphCode] = nil) then begin @@ -2365,19 +2439,19 @@ begin end; end; -procedure TGlyphCache.DeleteGlyph(ch: WideChar); +procedure TGlyphCache.DeleteGlyph(ch: UCS4Char); var Table: PGlyphTable; TableIndex, GlyphIndex: integer; TableEmpty: boolean; begin // find table - Table := FindGlyphTable(cardinal(ch) shr 8, TableIndex); + Table := FindGlyphTable(Ord(ch) shr 8, TableIndex); if (Table = nil) then Exit; // find glyph - GlyphIndex := cardinal(ch) and $FF; + GlyphIndex := Ord(ch) and $FF; if (Table[GlyphIndex] <> nil) then begin // destroy glyph @@ -2402,19 +2476,19 @@ begin end; end; -function TGlyphCache.GetGlyph(ch: WideChar): TGlyph; +function TGlyphCache.GetGlyph(ch: UCS4Char): TGlyph; var InsertPos: integer; Table: PGlyphTable; begin - Table := FindGlyphTable(cardinal(ch) shr 8, InsertPos); + Table := FindGlyphTable(Ord(ch) shr 8, InsertPos); if (Table = nil) then Result := nil else - Result := Table[cardinal(ch) and $FF]; + Result := Table[Ord(ch) and $FF]; end; -function TGlyphCache.HasGlyph(ch: WideChar): boolean; +function TGlyphCache.HasGlyph(ch: UCS4Char): boolean; begin Result := (GetGlyph(ch) <> nil); end; @@ -2482,7 +2556,7 @@ end; * TBitmapFont *} -constructor TBitmapFont.Create(const Filename: string; Outline: integer; +constructor TBitmapFont.Create(const Filename: IPath; Outline: integer; Baseline, Ascender, Descender: integer); begin inherited Create(); @@ -2494,7 +2568,7 @@ begin fAscender := Ascender; fDescender := Descender; - LoadFontInfo(ChangeFileExt(Filename, '.dat')); + LoadFontInfo(Filename.SetExtension('.dat')); ResetIntern(); end; @@ -2524,27 +2598,27 @@ begin fWidths[Count] := Round(fWidths[Count] * WidthMult) + WidthAdd; end; -procedure TBitmapFont.LoadFontInfo(const InfoFile: string); +procedure TBitmapFont.LoadFontInfo(const InfoFile: IPath); var - Stream: TFileStream; + Stream: TStream; begin FillChar(fWidths[0], Length(fWidths), 0); Stream := nil; try - Stream := TFileStream.Create(InfoFile, fmOpenRead); + Stream := TBinaryFileStream.Create(InfoFile, fmOpenRead); Stream.Read(fWidths, 256); except - raise Exception.Create('Could not read font info file ''' + InfoFile + ''''); + raise Exception.Create('Could not read font info file ''' + InfoFile.ToNative + ''''); end; Stream.Free; end; -function TBitmapFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +function TBitmapFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; var LineIndex, CharIndex: integer; CharCode: cardinal; - Line: WideString; + Line: UCS4String; LineWidth: double; begin Result.Left := 0; @@ -2556,7 +2630,7 @@ begin begin Line := Text[LineIndex]; LineWidth := 0; - for CharIndex := 1 to Length(Line) do + for CharIndex := 0 to LengthUCS4(Line)-1 do begin CharCode := Ord(Line[CharIndex]); if (CharCode < Length(fWidths)) then @@ -2567,7 +2641,7 @@ begin end; end; -procedure TBitmapFont.RenderChar(ch: WideChar; var AdvanceX: real); +procedure TBitmapFont.RenderChar(ch: UCS4Char; var AdvanceX: real); var TexX, TexY: real; TexR, TexB: real; @@ -2659,20 +2733,20 @@ begin AdvanceX := AdvanceX + GlyphWidth; end; -procedure TBitmapFont.Render(const Text: WideString); +procedure TBitmapFont.Render(const Text: UCS4String); var CharIndex: integer; AdvanceX: real; begin // if there is no text do nothing - if (Text = '') then + if (Text = nil) or (Text[0] = 0) then Exit; //Save the current color and alpha (for reflection) glGetFloatv(GL_CURRENT_COLOR, @fTempColor); AdvanceX := 0; - for CharIndex := 1 to Length(Text) do + for CharIndex := 0 to LengthUCS4(Text)-1 do begin RenderChar(Text[CharIndex], AdvanceX); end; -- cgit v1.2.3 From 5770b03c014bffe3318b96dcb935ff3438fd12fa Mon Sep 17 00:00:00 2001 From: s_alexander Date: Mon, 9 Nov 2009 07:41:42 +0000 Subject: fixed div 0 errors git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1940 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) (limited to 'src/base/UFont.pas') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 72409ac1..191e74d2 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -1167,12 +1167,22 @@ begin // projected width ||(x1, y1) - (x2, y1)|| Dist := (WinCoords[0][0] - WinCoords[1][0]); Dist2 := (WinCoords[0][1] - WinCoords[1][1]); - WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + WidthScale := 1; + if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then + begin + WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + end; // projected height ||(x1, y1) - (x1, y2)|| Dist := (WinCoords[0][0] - WinCoords[2][0]); Dist2 := (WinCoords[0][1] - WinCoords[2][1]); - HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + HeightScale := 1; + if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then + begin + HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + end; //writeln(Format('Scale %f, %f', [WidthScale, HeightScale])); @@ -1326,7 +1336,7 @@ var Level: integer; begin for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then + if ((fMipmapFonts[Level] <> nil) AND (GetMipmapScale(Level) > 0)) then fMipmapFonts[Level].SetReflectionSpacing(Spacing / GetMipmapScale(Level)); end; -- cgit v1.2.3 From 6452b6942e423943fcd8b4a7acc6d1d06f2461a3 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 6 Feb 2010 23:35:42 +0000 Subject: a small optimization. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2099 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'src/base/UFont.pas') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 191e74d2..b97b2890 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -1127,7 +1127,7 @@ var ModelMatrix, ProjMatrix: T16dArray; WinCoords: array[0..2, 0..2] of GLdouble; ViewPortArray: TViewPortArray; - Dist, Dist2: double; + Dist, Dist2, DistSum: double; WidthScale, HeightScale: double; const // width/height of square used for determining the scale @@ -1169,9 +1169,10 @@ begin Dist2 := (WinCoords[0][1] - WinCoords[1][1]); WidthScale := 1; - if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then + DistSum := Dist*Dist + Dist2*Dist2 + if DistSum > 0) then begin - WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + WidthScale := cTestSize / Sqrt(DistSum); end; // projected height ||(x1, y1) - (x1, y2)|| @@ -1179,9 +1180,10 @@ begin Dist2 := (WinCoords[0][1] - WinCoords[2][1]); HeightScale := 1; - if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then + DistSum := Dist*Dist + Dist2*Dist2 + if DistSum > 0) then begin - HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + HeightScale := cTestSize / Sqrt(DistSum); end; //writeln(Format('Scale %f, %f', [WidthScale, HeightScale])); -- cgit v1.2.3 From 7745d3787c6ab93a1f54eaeb3475f76ac64735fd Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 7 Feb 2010 00:13:44 +0000 Subject: typo git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2100 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base/UFont.pas') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index b97b2890..473ac23c 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -1169,7 +1169,7 @@ begin Dist2 := (WinCoords[0][1] - WinCoords[1][1]); WidthScale := 1; - DistSum := Dist*Dist + Dist2*Dist2 + DistSum := Dist*Dist + Dist2*Dist2; if DistSum > 0) then begin WidthScale := cTestSize / Sqrt(DistSum); @@ -1180,7 +1180,7 @@ begin Dist2 := (WinCoords[0][1] - WinCoords[2][1]); HeightScale := 1; - DistSum := Dist*Dist + Dist2*Dist2 + DistSum := Dist*Dist + Dist2*Dist2; if DistSum > 0) then begin HeightScale := cTestSize / Sqrt(DistSum); -- cgit v1.2.3 From 5c101e3a76ea5809ae5b6986f2ad5317f95f19d1 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 7 Feb 2010 00:15:18 +0000 Subject: Aller guten Dinge sind 3 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2101 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base/UFont.pas') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 473ac23c..03918e3b 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -1170,7 +1170,7 @@ begin WidthScale := 1; DistSum := Dist*Dist + Dist2*Dist2; - if DistSum > 0) then + if (DistSum > 0) then begin WidthScale := cTestSize / Sqrt(DistSum); end; @@ -1181,7 +1181,7 @@ begin HeightScale := 1; DistSum := Dist*Dist + Dist2*Dist2; - if DistSum > 0) then + if (DistSum > 0) then begin HeightScale := cTestSize / Sqrt(DistSum); end; -- cgit v1.2.3 From 69cf82185e7f559d8858b44fa76379c771acc6b6 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 23 Apr 2010 22:39:26 +0000 Subject: - font fallback added - more configurable fonts.ini - ftNormal/ftBold/ftOutline1/2 added git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2293 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 335 +++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 246 insertions(+), 89 deletions(-) (limited to 'src/base/UFont.pas') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 03918e3b..72b1d8d8 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -88,6 +88,8 @@ type Width, Height: integer; end; + EFontError = class(Exception); + {** * Abstract base class representing a glyph. *} @@ -119,6 +121,7 @@ type procedure ResetIntern(); protected + fFilename: IPath; fStyle: TFontStyle; fUseKerning: boolean; fLineSpacing: single; // must be inited by subclass @@ -184,7 +187,7 @@ type property ReflectionPass: boolean read fReflectionPass write SetReflectionPass; public - constructor Create(); + constructor Create(const Filename: IPath); destructor Destroy(); override; {** @@ -213,6 +216,12 @@ type {** UTF-8 version of @link(BBox) } function BBox(const Text: UTF8String; Advance: boolean = true): TBoundsDbl; overload; + {** + * Adds a new font that is used if the default font misses a glyph + * @raises EFontError if the fallback could not be initialized + *} + procedure AddFallback(const Filename: IPath); virtual; abstract; + {** Font height } property Height: single read GetHeight; {** Vertical distance from baseline to top of glyph } @@ -229,6 +238,8 @@ type property Style: TFontStyle read GetStyle write SetStyle; {** If set to true (default) kerning will be used if available } property UseKerning: boolean read GetUseKerning write SetUseKerning; + {** Filename } + property Filename: IPath read fFilename; end; const @@ -248,8 +259,8 @@ type procedure ResetIntern(); protected - fScale: single; //**< current height to base-font height ratio - fAspect: single; //**< width to height aspect + fScale: single; //**< current height to base-font height ratio + fStretch: single; //**< stretch factor for width (Width * fStretch) fBaseFont: TFont; //**< shortcut for fMipmapFonts[0] fUseMipmaps: boolean; //**< true if mipmap fonts are generated /// Mipmap fonts (size[level+1] = size[level]/2) @@ -286,8 +297,8 @@ type procedure SetHeight(Height: single); virtual; function GetHeight(): single; override; - procedure SetAspect(Aspect: single); virtual; - function GetAspect(): single; virtual; + procedure SetStretch(Stretch: single); virtual; + function GetStretch(): single; virtual; function GetAscender(): single; override; function GetDescender(): single; override; procedure SetLineSpacing(Spacing: single); override; @@ -322,8 +333,8 @@ type {** Font height } property Height: single read GetHeight write SetHeight; - {** Factor for font stretching (NewWidth = Width*Aspect), 1.0 by default } - property Aspect: single read GetAspect write SetAspect; + {** Factor for font stretching (NewWidth = Width*Stretch), 1.0 by default } + property Stretch: single read GetStretch write SetStretch; end; {** @@ -423,7 +434,7 @@ type function LoadGlyph(ch: UCS4Char): TGlyph; virtual; abstract; public - constructor Create(); + constructor Create(const Filename: IPath); destructor Destroy(); override; {** @@ -436,6 +447,28 @@ type TFTFont = class; + {** + * Freetype font face class. + *} + TFTFontFace = class + strict private + fFilename: IPath; //**< filename of the font-file + fFace: FT_Face; //**< Holds the height of the font + fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio + + public + {** + * @raises EFontError if the glyph could not be initialized + *} + constructor Create(const Filename: IPath; Size: integer); + + destructor Destroy(); override; + + property Filename: IPath read fFilename; + property Data: FT_Face read fFace; + property FontUnitScale: TPositionDbl read fFontUnitScale; + end; + {** * Freetype glyph. * Each glyph stores a texture with the glyph's image. @@ -443,6 +476,7 @@ type TFTGlyph = class(TGlyph) private fCharCode: UCS4Char; //**< Char code + fFace: TFTFontFace; //**< Freetype face used for this glyph fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code) fDisplayList: GLuint; //**< Display-list ID fTexture: GLuint; //**< Texture ID @@ -471,7 +505,7 @@ type * Creates an OpenGL texture (and display list) for the glyph. * The glyph's and bitmap's metrics are set correspondingly. * @param LoadFlags flags passed to FT_Load_Glyph() - * @raises Exception if the glyph could not be initialized + * @raises EFontError if the glyph could not be initialized *} procedure CreateTexture(LoadFlags: FT_Int32); @@ -495,9 +529,13 @@ type {** Freetype specific char-index (<> char-code) } property CharIndex: FT_UInt read fCharIndex; + + {** Freetype face used for this glyph } + property Face: TFTFontFace read fFace; end; TFontPart = ( fpNone, fpInner, fpOutline ); + TFTFontFaceArray = array of TFTFontFace; {** * Freetype font class. @@ -506,15 +544,14 @@ type private procedure ResetIntern(); - protected - fFilename: IPath; //**< filename of the font-file + strict protected + fFace: TFTFontFace; //**< Default font face fSize: integer; //**< Font base size (in pixels) fOutset: single; //**< size of outset extrusion (in pixels) - fFace: FT_Face; //**< Holds the height of the font fLoadFlags: FT_Int32; //**< FT glpyh load-flags - fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing fPart: TFontPart; //**< indicates the part of an outline font + fFallbackFaces: TFTFontFaceArray; //**< available fallback faces, ordered by priority {** @seealso TCachedFont.LoadGlyph } function LoadGlyph(ch: UCS4Char): TGlyph; override; @@ -528,15 +565,13 @@ type function GetUnderlinePosition(): single; override; function GetUnderlineThickness(): single; override; - property Face: FT_Face read fFace; - public {** * Creates a font of size Size (in pixels) from the file Filename. * If Outset (in pixels) is set to a value > 0 the glyphs will be extruded * at their borders. Use it for e.g. a bold effect. * @param LoadFlags flags passed to FT_Load_Glyph() - * @raises Exception if the font-file could not be loaded + * @raises EFontError if the font-file could not be loaded *} constructor Create(const Filename: IPath; Size: integer; Outset: single = 0.0; @@ -549,11 +584,19 @@ type {** @seealso TFont.Reset } procedure Reset(); override; - + + procedure AddFallback(const Filename: IPath); override; + {** Size of the base font } property Size: integer read fSize; {** Outset size } property Outset: single read fOutset; + {** The part (inner/outline/none) this font represents in a composite font } + property Part: TFontPart read fPart write fPart; + {** Freetype face of this font } + property DefaultFace: TFTFontFace read fFace; + {** Available freetype fallback faces, ordered by priority } + property FallbackFaces: TFTFontFaceArray read fFallbackFaces; end; TFTScalableFont = class(TScalableFont) @@ -567,11 +610,27 @@ type * OutsetAmount is the ratio of the glyph extrusion. * The extrusion in pixels is Size*OutsetAmount * (0.0 -> no extrusion, 0.1 -> 10%). + * + * The memory size (in bytes) consumed by a scalable font + * - with UseMipmaps=false: + * mem = size^2 * #cached_glyphs + * - with UseMipmaps=true (all mipmap levels): + * mem = size^2 * #cached_glyphs * Sum[i=1..cMaxMipmapLevel](1/i^2) + * - with UseMipmaps=true (5 <= cMaxMipmapLevel <= 10): + * mem ~= size^2 * #cached_glyphs * 1.5 + * + * Examples (for 128 cached glyphs): + * - Size: 64 pixels: 768 KB (mipmapped) or 512 KB (non-mipmapped). + * - Size 128 pixels: 3 MB (mipmapped) or 2 MB (non-mipmapped) + * + * Note: once a glyph is cached there will *} constructor Create(const Filename: IPath; Size: integer; OutsetAmount: single = 0.0; UseMipmaps: boolean = true); + procedure AddFallback(const Filename: IPath); override; + {** @seealso TGlyphCache.FlushCache } procedure FlushCache(KeepBaseSet: boolean); @@ -586,7 +645,6 @@ type *} TFTOutlineFont = class(TFont) private - fFilename: IPath; fSize: integer; fOutset: single; fInnerFont, fOutlineFont: TFTFont; @@ -628,6 +686,8 @@ type {** @seealso TGlyphCache.FlushCache } procedure FlushCache(KeepBaseSet: boolean); + procedure AddFallback(const Filename: IPath); override; + {** @seealso TFont.Reset } procedure Reset(); override; @@ -657,6 +717,8 @@ type {** @seealso TGlyphCache.FlushCache } procedure FlushCache(KeepBaseSet: boolean); + procedure AddFallback(const Filename: IPath); override; + {** Outset size } property Outset: single read GetOutset; end; @@ -687,7 +749,7 @@ type {** * Load font widths from an info file. * @param InfoFile the name of the info (.dat) file - * @raises Exception if the file is corrupted + * @raises EFontError if the file is corrupted *} procedure LoadFontInfo(const InfoFile: IPath); @@ -721,6 +783,8 @@ type {** @seealso TFont.Reset } procedure Reset(); override; + + procedure AddFallback(const Filename: IPath); override; end; {$ENDIF BITMAP_FONT} @@ -730,7 +794,7 @@ type {** * Returns a pointer to the freetype library singleton. * If non exists, freetype will be initialized. - * @raises Exception if initialization failed + * @raises EFontError if initialization failed *} class function GetLibrary(): FT_Library; class procedure FreeLibrary(); @@ -783,9 +847,10 @@ end; * TFont *} -constructor TFont.Create(); +constructor TFont.Create(const Filename: IPath); begin - inherited; + inherited Create(); + fFilename := Filename; ResetIntern(); end; @@ -1040,7 +1105,7 @@ constructor TScalableFont.Create(Font: TFont; UseMipmaps: boolean); var MipmapLevel: integer; begin - inherited Create(); + inherited Create(Font.Filename); fBaseFont := Font; fMipmapFonts[0] := Font; @@ -1072,7 +1137,7 @@ end; procedure TScalableFont.ResetIntern(); begin fScale := 1.0; - fAspect := 1.0; + fStretch := 1.0; end; procedure TScalableFont.Reset(); @@ -1088,7 +1153,7 @@ end; {** * Returns the mipmap level to use with regard to the current projection - * and modelview matrix, font scale and aspect. + * and modelview matrix, font scale and stretch. * * Note: * - for Freetype fonts, hinting and grid-fitting must be disabled, otherwise @@ -1250,7 +1315,7 @@ begin glPushMatrix(); // set scale and stretching - glScalef(fScale * fAspect, fScale, 0); + glScalef(fScale * fStretch, fScale, 0); // print text if (fUseMipmaps) then @@ -1269,8 +1334,8 @@ end; function TScalableFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; begin Result := fBaseFont.BBox(Text, Advance); - Result.Left := Result.Left * fScale * fAspect; - Result.Right := Result.Right * fScale * fAspect; + Result.Left := Result.Left * fScale * fStretch; + Result.Right := Result.Right * fScale * fStretch; Result.Top := Result.Top * fScale; Result.Bottom := Result.Bottom * fScale; end; @@ -1285,14 +1350,14 @@ begin Result := fBaseFont.GetHeight() * fScale; end; -procedure TScalableFont.SetAspect(Aspect: single); +procedure TScalableFont.SetStretch(Stretch: single); begin - fAspect := Aspect; + fStretch := Stretch; end; -function TScalableFont.GetAspect(): single; +function TScalableFont.GetStretch(): single; begin - Result := fAspect; + Result := fStretch; end; function TScalableFont.GetAscender(): single; @@ -1385,9 +1450,9 @@ end; * TCachedFont *} -constructor TCachedFont.Create(); +constructor TCachedFont.Create(const Filename: IPath); begin - inherited; + inherited Create(Filename); fCache := TGlyphCache.Create(); end; @@ -1413,41 +1478,60 @@ begin fCache.FlushCache(KeepBaseSet); end; - {* - * TFTFont + * TFTFontFace *} -constructor TFTFont.Create( - const Filename: IPath; - Size: integer; Outset: single; - LoadFlags: FT_Int32); -var - ch: UCS4Char; +constructor TFTFontFace.Create(const Filename: IPath; Size: integer); begin inherited Create(); fFilename := Filename; - fSize := Size; - fOutset := Outset; - fLoadFlags := LoadFlags; - fUseDisplayLists := true; - fPart := fpNone; // load font information if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename.ToNative), 0, fFace) <> 0) then - raise Exception.Create('FT_New_Face: Could not load font ''' + Filename.ToNative + ''''); + raise EFontError.Create('FT_New_Face: Could not load font ''' + Filename.ToNative + ''''); // support scalable fonts only if (not FT_IS_SCALABLE(fFace)) then - raise Exception.Create('Font is not scalable'); + raise EFontError.Create('Font is not scalable'); if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then - raise Exception.Create('FT_Set_Pixel_Sizes failes'); + raise EFontError.Create('FT_Set_Pixel_Sizes failes'); // get scale factor for font-unit to pixel-size transformation fFontUnitScale.X := fFace.size.metrics.x_ppem / fFace.units_per_EM; fFontUnitScale.Y := fFace.size.metrics.y_ppem / fFace.units_per_EM; +end; + +destructor TFTFontFace.Destroy(); +begin + // free face data + FT_Done_Face(fFace); + inherited; +end; + + +{* + * TFTFont + *} + +constructor TFTFont.Create( + const Filename: IPath; + Size: integer; Outset: single; + LoadFlags: FT_Int32); +var + ch: UCS4Char; +begin + inherited Create(Filename); + + fSize := Size; + fOutset := Outset; + fLoadFlags := LoadFlags; + fUseDisplayLists := true; + fPart := fpNone; + + fFace := TFTFontFace.Create(Filename, Size); ResetIntern(); @@ -1457,17 +1541,22 @@ begin end; destructor TFTFont.Destroy(); +var + I: integer; begin - // free face - FT_Done_Face(fFace); + // free faces + fFace.Free; + for I := 0 to High(fFallbackFaces) do + fFallbackFaces[I].Free; + inherited; end; procedure TFTFont.ResetIntern(); begin // Note: outset and non outset fonts use same spacing - fLineSpacing := fFace.height * fFontUnitScale.Y; - fReflectionSpacing := -2*fFace.descender * fFontUnitScale.Y; + fLineSpacing := fFace.Data.height * fFace.FontUnitScale.Y; + fReflectionSpacing := -2*fFace.Data.descender * fFace.FontUnitScale.Y; end; procedure TFTFont.Reset(); @@ -1476,6 +1565,15 @@ begin ResetIntern(); end; +procedure TFTFont.AddFallback(const Filename: IPath); +var + FontFace: TFTFontFace; +begin + FontFace := TFTFontFace.Create(Filename, Size); + SetLength(fFallbackFaces, Length(fFallbackFaces) + 1); + fFallbackFaces[High(fFallbackFaces)] := FontFace; +end; + function TFTFont.LoadGlyph(ch: UCS4Char): TGlyph; begin Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags); @@ -1520,11 +1618,11 @@ begin if (Glyph <> nil) then begin // get kerning - if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + if (fUseKerning and FT_HAS_KERNING(fFace.Data) and (PrevGlyph <> nil)) then begin - FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_Get_Kerning(fFace.Data, PrevGlyph.CharIndex, Glyph.CharIndex, FT_KERNING_UNSCALED, KernDelta); - LineBounds.Right := LineBounds.Right + KernDelta.x * fFontUnitScale.X; + LineBounds.Right := LineBounds.Right + KernDelta.x * fFace.FontUnitScale.X; end; // update left bound (must be done before right bound is updated) @@ -1608,11 +1706,11 @@ begin if (Assigned(Glyph)) then begin // get kerning - if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + if (fUseKerning and FT_HAS_KERNING(fFace.Data) and (PrevGlyph <> nil)) then begin - FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_Get_Kerning(fFace.Data, PrevGlyph.CharIndex, Glyph.CharIndex, FT_KERNING_UNSCALED, KernDelta); - glTranslatef(KernDelta.x * fFontUnitScale.X, 0, 0); + glTranslatef(KernDelta.x * fFace.FontUnitScale.X, 0, 0); end; if (ReflectionPass) then @@ -1634,23 +1732,23 @@ end; function TFTFont.GetAscender(): single; begin - Result := fFace.ascender * fFontUnitScale.Y + Outset*2; + Result := fFace.Data.ascender * fFace.FontUnitScale.Y + Outset*2; end; function TFTFont.GetDescender(): single; begin // Note: outset is not part of the descender as the baseline is lifted - Result := fFace.descender * fFontUnitScale.Y; + Result := fFace.Data.descender * fFace.FontUnitScale.Y; end; function TFTFont.GetUnderlinePosition(): single; begin - Result := fFace.underline_position * fFontUnitScale.Y - Outset; + Result := fFace.Data.underline_position * fFace.FontUnitScale.Y - Outset; end; function TFTFont.GetUnderlineThickness(): single; begin - Result := fFace.underline_thickness * fFontUnitScale.Y + Outset*2; + Result := fFace.Data.underline_thickness * fFace.FontUnitScale.Y + Outset*2; end; @@ -1689,8 +1787,8 @@ begin // do not create mipmap fonts < 8 pixels if (ScaledSize < 8) then Exit; - Result := TFTFont.Create(BaseFont.fFilename, - ScaledSize, BaseFont.fOutset * Scale, + Result := TFTFont.Create(BaseFont.Filename, + ScaledSize, BaseFont.Outset * Scale, FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); end; @@ -1699,6 +1797,15 @@ begin Result := TFTFont(fBaseFont).Outset * fScale; end; +procedure TFTScalableFont.AddFallback(const Filename: IPath); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTFont(fMipmapFonts[Level]).AddFallback(Filename); +end; + procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean); var Level: integer; @@ -1718,16 +1825,15 @@ constructor TFTOutlineFont.Create( Size: integer; Outset: single; LoadFlags: FT_Int32); begin - inherited Create(); + inherited Create(Filename); - fFilename := Filename; fSize := Size; fOutset := Outset; fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags); - fInnerFont.fPart := fpInner; + fInnerFont.Part := fpInner; fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags); - fOutlineFont.fPart := fpOutline; + fOutlineFont.Part := fpOutline; ResetIntern(); end; @@ -1824,6 +1930,12 @@ begin fInnerFont.FlushCache(KeepBaseSet); end; +procedure TFTOutlineFont.AddFallback(const Filename: IPath); +begin + fOutlineFont.AddFallback(Filename); + fInnerFont.AddFallback(Filename); +end; + function TFTOutlineFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; begin Result := fOutlineFont.BBox(Text, Advance); @@ -1960,6 +2072,15 @@ begin TFTOutlineFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); end; +procedure TFTScalableOutlineFont.AddFallback(const Filename: IPath); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTOutlineFont(fMipmapFonts[Level]).AddFallback(Filename); +end; + {* * TFTGlyph @@ -2019,10 +2140,16 @@ begin // The second one is used as a stencil for the first one, clearing the // interiour of the glyph. // The stencil is not needed to create bold fonts. - UseStencil := (fFont.fPart = fpInner); + UseStencil := (fFont.Part = fpInner); - Outline := @FT_OutlineGlyph(Glyph).outline; + // we cannot extrude bitmaps, only vector based glyphs. + // Check for FT_GLYPH_FORMAT_OUTLINE otherwise a cast to FT_OutlineGlyph is + // invalid and FT_Stroker_ParseOutline() will crash + if (Glyph.format <> FT_GLYPH_FORMAT_OUTLINE) then + Exit; + Outline := @FT_OutlineGlyph(Glyph).outline; + OuterBorder := FT_Outline_GetOutsideBorder(Outline); if (OuterBorder = FT_STROKER_BORDER_LEFT) then InnerBorder := FT_STROKER_BORDER_RIGHT @@ -2032,7 +2159,7 @@ begin { extrude outer border } if (FT_Stroker_New(Glyph.library_, OuterStroker) <> 0) then - raise Exception.Create('FT_Stroker_New failed!'); + raise EFontError.Create('FT_Stroker_New failed!'); FT_Stroker_Set( OuterStroker, Round(fOutset * 64), @@ -2043,7 +2170,7 @@ begin // similar to FT_Glyph_StrokeBorder(inner = FT_FALSE) but it is possible to // use FT_Stroker_ExportBorder() afterwards to combine inner and outer borders if (FT_Stroker_ParseOutline(OuterStroker, Outline, FT_FALSE) <> 0) then - raise Exception.Create('FT_Stroker_ParseOutline failed!'); + raise EFontError.Create('FT_Stroker_ParseOutline failed!'); FT_Stroker_GetBorderCounts(OuterStroker, OuterBorder, OuterNumPoints, OuterNumContours); @@ -2052,7 +2179,7 @@ begin if (UseStencil) then begin if (FT_Stroker_New(Glyph.library_, InnerStroker) <> 0) then - raise Exception.Create('FT_Stroker_New failed!'); + raise EFontError.Create('FT_Stroker_New failed!'); FT_Stroker_Set( InnerStroker, 63, // extrude at most one pixel to avoid a black border @@ -2061,7 +2188,7 @@ begin 0); if (FT_Stroker_ParseOutline(InnerStroker, Outline, FT_FALSE) <> 0) then - raise Exception.Create('FT_Stroker_ParseOutline failed!'); + raise EFontError.Create('FT_Stroker_ParseOutline failed!'); FT_Stroker_GetBorderCounts(InnerStroker, InnerBorder, InnerNumPoints, InnerNumContours); end else begin @@ -2080,7 +2207,7 @@ begin // resize glyph outline to hold inner and outer border FT_Outline_Done(Glyph.Library_, Outline); if (FT_Outline_New(Glyph.Library_, GlyphNumPoints, GlyphNumContours, Outline) <> 0) then - raise Exception.Create('FT_Outline_New failed!'); + raise EFontError.Create('FT_Outline_New failed!'); Outline.n_points := 0; Outline.n_contours := 0; @@ -2090,7 +2217,7 @@ begin if (UseStencil) then FT_Stroker_ExportBorder(InnerStroker, InnerBorder, Outline); if (FT_Outline_Check(outline) <> 0) then - raise Exception.Create('FT_Stroker_ExportBorder failed!'); + raise EFontError.Create('FT_Stroker_ExportBorder failed!'); if (InnerStroker <> nil) then FT_Stroker_Done(InnerStroker); @@ -2110,20 +2237,26 @@ var TexLine: PGLubyteArray; CBox: FT_BBox; begin + // we need vector data for outlined glyphs so do not load bitmaps. + // This is necessary for mixed fonts that contain bitmap versions of smaller + // glyphs, for example in CJK fonts. + if (fOutset > 0) then + LoadFlags := LoadFlags or FT_LOAD_NO_BITMAP; + // load the Glyph for our character - if (FT_Load_Glyph(fFont.Face, fCharIndex, LoadFlags) <> 0) then - raise Exception.Create('FT_Load_Glyph failed'); + if (FT_Load_Glyph(fFace.Data, fCharIndex, LoadFlags) <> 0) then + raise EFontError.Create('FT_Load_Glyph failed'); // move the face's glyph into a Glyph object - if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then - raise Exception.Create('FT_Get_Glyph failed'); + if (FT_Get_Glyph(fFace.Data^.glyph, Glyph) <> 0) then + raise EFontError.Create('FT_Get_Glyph failed'); if (fOutset > 0) then StrokeBorder(Glyph); // store scaled advance width/height in glyph-object - fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2; - fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2; + fAdvance.X := fFace.Data^.glyph^.advance.x / 64 + fOutset*2; + fAdvance.Y := fFace.Data^.glyph^.advance.y / 64 + fOutset*2; // get the contour's bounding box (in 1/64th pixels, not font-units) FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox); @@ -2238,6 +2371,8 @@ end; constructor TFTGlyph.Create(Font: TFTFont; ch: UCS4Char; Outset: single; LoadFlags: FT_Int32); +var + I: integer; begin inherited Create(); @@ -2245,8 +2380,25 @@ begin fOutset := Outset; fCharCode := ch; - // get the Freetype char-index (use default UNICODE charmap) - fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch)); + // Note: the default face is also used if no face (neither default nor fallback) + // contains a glyph for the given char. + fFace := Font.DefaultFace; + + // search the Freetype char-index (use default UNICODE charmap) in the default face + fCharIndex := FT_Get_Char_Index(fFace.Data, FT_ULONG(ch)); + if (fCharIndex = 0) then + begin + // glyph not in default font, search in fallback font faces + for I := 0 to High(Font.FallbackFaces) do + begin + fCharIndex := FT_Get_Char_Index(Font.FallbackFaces[I].Data, FT_ULONG(ch)); + if (fCharIndex <> 0) then + begin + fFace := Font.FallbackFaces[I]; + Break; + end; + end; + end; CreateTexture(LoadFlags); end; @@ -2550,7 +2702,7 @@ begin begin // initialize freetype if (FT_Init_FreeType(LibraryInst) <> 0) then - raise Exception.Create('FT_Init_FreeType failed'); + raise EFontError.Create('FT_Init_FreeType failed'); end; Result := LibraryInst; end; @@ -2571,7 +2723,7 @@ end; constructor TBitmapFont.Create(const Filename: IPath; Outline: integer; Baseline, Ascender, Descender: integer); begin - inherited Create(); + inherited Create(Filename); fTex := Texture.LoadTexture(true, Filename, TEXTURE_TYPE_TRANSPARENT, 0); fTexSize := 1024; @@ -2602,6 +2754,11 @@ begin ResetIntern(); end; +procedure TBitmapFont.AddFallback(const Filename: IPath); +begin + // no support for fallbacks +end; + procedure TBitmapFont.CorrectWidths(WidthMult: real; WidthAdd: integer); var Count: integer; @@ -2621,7 +2778,7 @@ begin Stream := TBinaryFileStream.Create(InfoFile, fmOpenRead); Stream.Read(fWidths, 256); except - raise Exception.Create('Could not read font info file ''' + InfoFile.ToNative + ''''); + raise EFontError.Create('Could not read font info file ''' + InfoFile.ToNative + ''''); end; Stream.Free; end; -- cgit v1.2.3 From b99460b47145de0ebbd1b9e6effe71cf91c056ec Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 24 Apr 2010 00:21:33 +0000 Subject: removed "strict protected/private" git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2296 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base/UFont.pas') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 72b1d8d8..79873272 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -451,7 +451,7 @@ type * Freetype font face class. *} TFTFontFace = class - strict private + private fFilename: IPath; //**< filename of the font-file fFace: FT_Face; //**< Holds the height of the font fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio @@ -544,7 +544,7 @@ type private procedure ResetIntern(); - strict protected + protected fFace: TFTFontFace; //**< Default font face fSize: integer; //**< Font base size (in pixels) fOutset: single; //**< size of outset extrusion (in pixels) -- cgit v1.2.3 From 461a3645025cb950c3c69bc555e25a135065bb71 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 25 Apr 2010 07:44:43 +0000 Subject: - added font face cache -> loading all fonts now takes 1.5 secs instead of 7 secs - without the CJK font it takes only 600 ms - with wqy-zenhei.ttc replaced by the simsun.ttc windows font it takes only 800 ms instead of 1.5 secs so it is font related -> another CJK font might be better suited git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2305 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 102 ++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 98 insertions(+), 4 deletions(-) (limited to 'src/base/UFont.pas') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 79873272..49a19a1a 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -41,6 +41,9 @@ interface {$DEFINE BITMAP_FONT} {$ENDIF} +// Enables the Freetype font cache +{$DEFINE ENABLE_FT_FACE_CACHE} + uses FreeType, gl, @@ -455,6 +458,7 @@ type fFilename: IPath; //**< filename of the font-file fFace: FT_Face; //**< Holds the height of the font fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio + fSize: integer; public {** @@ -467,6 +471,25 @@ type property Filename: IPath read fFilename; property Data: FT_Face read fFace; property FontUnitScale: TPositionDbl read fFontUnitScale; + property Size: integer read fSize; + end; + + {** + * Loading font faces with freetype is a slow process. + * Especially loading a font (e.g. fallback fonts) more than once is a waste + * of time. Just cache already loaded faces here. + *} + TFTFontFaceCache = class + private + fFaces: array of TFTFontFace; + fFacesRefCnt: array of integer; + public + {** + * @raises EFontError if the font could not be initialized + *} + function LoadFace(const Filename: IPath; Size: integer): TFTFontFace; + + procedure UnloadFace(Face: TFTFontFace); end; {** @@ -543,6 +566,7 @@ type TFTFont = class(TCachedFont) private procedure ResetIntern(); + class function GetFaceCache(): TFTFontFaceCache; protected fFace: TFTFontFace; //**< Default font face @@ -1478,6 +1502,10 @@ begin fCache.FlushCache(KeepBaseSet); end; +{* + * TFTFontFaceCache + *} + {* * TFTFontFace *} @@ -1487,6 +1515,7 @@ begin inherited Create(); fFilename := Filename; + fSize := Size; // load font information if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename.ToNative), 0, fFace) <> 0) then @@ -1512,6 +1541,61 @@ begin end; +{* + * TFTFontFaceCache + *} + +function TFTFontFaceCache.LoadFace(const Filename: IPath; Size: integer): TFTFontFace; +var + I: Integer; + Face: TFTFontFace; +begin + {$IFDEF ENABLE_FT_FACE_CACHE} + for I := 0 to High(fFaces) do + begin + Face := fFaces[I]; + // check if we have this file in our cache + if ((Face.Filename.Equals(Filename)) and (Face.Size = Size)) then + begin + // true -> return cached face and increment ref-count + Inc(fFacesRefCnt[I]); + Result := Face; + Exit; + end; + end; + {$ENDIF} + + // face not in cache -> load it + Face := TFTFontFace.Create(Filename, Size); + + // add face to cache + SetLength(fFaces, Length(fFaces)+1); + SetLength(fFacesRefCnt, Length(fFaces)+1); + fFaces[High(fFaces)] := Face; + fFacesRefCnt[High(fFaces)] := 1; + + Result := Face; +end; + +procedure TFTFontFaceCache.UnloadFace(Face: TFTFontFace); +var + I: Integer; +begin + for I := 0 to High(fFaces) do + begin + // search face in cache + if (fFaces[I] = Face) then + begin + // decrement ref-count and free face if ref-count is 0 + Dec(fFacesRefCnt[I]); + if (fFacesRefCnt[I] <= 0) then + fFaces[I].Free; + Exit; + end; + end; +end; + + {* * TFTFont *} @@ -1531,7 +1615,7 @@ begin fUseDisplayLists := true; fPart := fpNone; - fFace := TFTFontFace.Create(Filename, Size); + fFace := GetFaceCache.LoadFace(Filename, Size); ResetIntern(); @@ -1545,13 +1629,23 @@ var I: integer; begin // free faces - fFace.Free; + GetFaceCache.UnloadFace(fFace); for I := 0 to High(fFallbackFaces) do - fFallbackFaces[I].Free; + GetFaceCache.UnloadFace(fFallbackFaces[I]); inherited; end; +var + FontFaceCache: TFTFontFaceCache = nil; + +class function TFTFont.GetFaceCache(): TFTFontFaceCache; +begin + if (FontFaceCache = nil) then + FontFaceCache := TFTFontFaceCache.Create; + Result := FontFaceCache; +end; + procedure TFTFont.ResetIntern(); begin // Note: outset and non outset fonts use same spacing @@ -1569,7 +1663,7 @@ procedure TFTFont.AddFallback(const Filename: IPath); var FontFace: TFTFontFace; begin - FontFace := TFTFontFace.Create(Filename, Size); + FontFace := GetFaceCache.LoadFace(Filename, Size); SetLength(fFallbackFaces, Length(fFallbackFaces) + 1); fFallbackFaces[High(fFallbackFaces)] := FontFace; end; -- cgit v1.2.3