518 lines
13 KiB
Ada
518 lines
13 KiB
Ada
with
|
|
openGL.Font,
|
|
|
|
freetype_c.Binding,
|
|
freetype_c.FT_GlyphSlot,
|
|
freetype_c.Pointers,
|
|
freetype_c.FT_Size_Metrics,
|
|
|
|
ada.unchecked_Deallocation;
|
|
|
|
package body openGL.FontImpl
|
|
is
|
|
use freetype_c.Pointers;
|
|
|
|
-----------
|
|
-- Utility
|
|
--
|
|
|
|
procedure deallocate is new ada.unchecked_Deallocation (Glyph.Container.item'Class,
|
|
glyph_Container_view);
|
|
|
|
---------
|
|
-- Forge
|
|
--
|
|
|
|
procedure define (Self : access Item; ftFont : access Font.item'Class;
|
|
fontFilePath : in String)
|
|
is
|
|
use freetype.Face,
|
|
openGL.Glyph.container,
|
|
Freetype_C,
|
|
Freetype_C.Binding;
|
|
use type FT_Error;
|
|
|
|
begin
|
|
Self.Face := Forge.to_Face (fontFilePath, precomputeKerning => True);
|
|
Self.load_Flags := FT_Int (FT_LOAD_DEFAULT_flag);
|
|
Self.Intf := ftFont;
|
|
Self.Err := Self.face.Error;
|
|
|
|
if Self.Err = 0
|
|
then
|
|
Self.glyphList := new Glyph.Container.item' (to_glyph_Container (Self.Face'Access));
|
|
else
|
|
raise Error with "Unable to create face for font '" & fontFilePath & "'.";
|
|
end if;
|
|
end define;
|
|
|
|
|
|
|
|
procedure define (Self : access Item; ftFont : access Font.item'Class;
|
|
pBufferBytes : access C.unsigned_char;
|
|
bufferSizeInBytes : in Integer)
|
|
is
|
|
use freetype.Face,
|
|
openGL.Glyph.container,
|
|
Freetype_C,
|
|
Freetype_c.Binding;
|
|
use type FT_Error;
|
|
begin
|
|
Self.Face := Forge.to_Face (pBufferBytes, bufferSizeInBytes, precomputeKerning => True);
|
|
Self.load_Flags := FT_Int (FT_LOAD_DEFAULT_flag);
|
|
Self.Intf := ftFont;
|
|
Self.Err := Self.face.Error;
|
|
|
|
if Self.Err = 0
|
|
then
|
|
Self.glyphList := new Glyph.Container.item' (to_glyph_Container (Self.Face'Access));
|
|
end if;
|
|
end define;
|
|
|
|
|
|
|
|
procedure destruct (Self : in out Item)
|
|
is
|
|
begin
|
|
if Self.glyphList /= null
|
|
then
|
|
Self.glyphList.destruct;
|
|
deallocate (Self.glyphList);
|
|
end if;
|
|
end destruct;
|
|
|
|
|
|
--------------
|
|
-- Attributes
|
|
--
|
|
|
|
function Err (Self : in Item) return freetype_c.FT_Error
|
|
is
|
|
begin
|
|
return Self.Err;
|
|
end Err;
|
|
|
|
|
|
|
|
function attach (Self : access Item; fontFilePath : in String) return Boolean
|
|
is
|
|
begin
|
|
if not Self.Face.attach (fontFilePath)
|
|
then
|
|
Self.Err := Self.Face.Error;
|
|
return False;
|
|
end if;
|
|
|
|
Self.Err := 0;
|
|
return True;
|
|
end attach;
|
|
|
|
|
|
|
|
function attach (Self : access Item; pBufferBytes : access C.unsigned_char;
|
|
bufferSizeInBytes : in Integer) return Boolean
|
|
is
|
|
begin
|
|
if not Self.Face.attach (pBufferBytes, bufferSizeInBytes)
|
|
then
|
|
Self.Err := Self.Face.Error;
|
|
return False;
|
|
end if;
|
|
|
|
Self.Err := 0;
|
|
return True;
|
|
end attach;
|
|
|
|
|
|
|
|
procedure GlyphLoadFlags (Self : in out Item; Flags : in freetype_c.FT_Int)
|
|
is
|
|
begin
|
|
Self.load_Flags := Flags;
|
|
end GlyphLoadFlags;
|
|
|
|
|
|
|
|
function CharMap (Self : access Item; Encoding : in freetype_c.FT_Encoding) return Boolean
|
|
is
|
|
Result : constant Boolean := Self.glyphList.CharMap (Encoding);
|
|
begin
|
|
Self.Err := Self.glyphList.Error;
|
|
return Result;
|
|
end CharMap;
|
|
|
|
|
|
|
|
function CharMapCount (Self : in Item) return Natural
|
|
is
|
|
begin
|
|
return Self.Face.CharMapCount;
|
|
end CharMapCount;
|
|
|
|
|
|
|
|
function CharMapList (Self : access Item) return freetype.face.FT_Encodings_view
|
|
is
|
|
begin
|
|
return Self.Face.CharMapList;
|
|
end CharMapList;
|
|
|
|
|
|
|
|
function Ascender (Self : in Item) return Real
|
|
is
|
|
begin
|
|
return Self.charSize.Ascender;
|
|
end Ascender;
|
|
|
|
|
|
|
|
function Descender (Self : in Item) return Real
|
|
is
|
|
begin
|
|
return Self.charSize.Descender;
|
|
end Descender;
|
|
|
|
|
|
|
|
function LineHeight (Self : in Item) return Real
|
|
is
|
|
begin
|
|
return Self.charSize.Height;
|
|
end LineHeight;
|
|
|
|
|
|
|
|
function FaceSize (Self : access Item; Size : in Natural;
|
|
x_Res, y_Res : in Natural) return Boolean
|
|
is
|
|
use Glyph.Container;
|
|
use type freetype_c.FT_Error;
|
|
|
|
begin
|
|
if Self.glyphList /= null
|
|
then
|
|
Self.glyphList.destruct;
|
|
deallocate (Self.glyphList);
|
|
end if;
|
|
|
|
Self.charSize := Self.Face.Size (Size, x_Res, y_Res);
|
|
Self.Err := Self.Face.Error;
|
|
|
|
if Self.Err /= 0 then
|
|
return False;
|
|
end if;
|
|
|
|
Self.glyphList := new Glyph.Container.item' (to_glyph_Container (Self.Face'unchecked_Access));
|
|
return True;
|
|
end FaceSize;
|
|
|
|
|
|
|
|
function FaceSize (Self : in Item) return Natural
|
|
is
|
|
begin
|
|
return Self.charSize.CharSize;
|
|
end FaceSize;
|
|
|
|
|
|
|
|
procedure Depth (Self : in out Item; Depth : in Real)
|
|
is
|
|
begin
|
|
null; -- NB: This is 'null' in FTGL also.
|
|
end Depth;
|
|
|
|
|
|
|
|
procedure Outset (Self : in out Item; Outset : in Real)
|
|
is
|
|
begin
|
|
null; -- NB: This is 'null' in FTGL also.
|
|
end Outset;
|
|
|
|
|
|
|
|
procedure Outset (Self : in out Item; Front : in Real;
|
|
Back : in Real)
|
|
|
|
is
|
|
begin
|
|
null; -- NB: This is 'null' in FTGL also.
|
|
end Outset;
|
|
|
|
|
|
|
|
function CheckGlyph (Self : access Item; Character : in freetype.charmap.CharacterCode) return Boolean
|
|
is
|
|
use type Glyph.Container.Glyph_view,
|
|
freetype_c.FT_Error;
|
|
|
|
glyphIndex : freetype.charMap.glyphIndex;
|
|
ftSlot : freetype_c.FT_GlyphSlot.item;
|
|
tempGlyph : glyph.Container.Glyph_view;
|
|
|
|
begin
|
|
if Self.glyphList.Glyph (Character) /= null
|
|
then
|
|
return True;
|
|
end if;
|
|
|
|
glyphIndex := freetype.charMap.glyphIndex (Self.glyphList.FontIndex (Character));
|
|
ftSlot := Self.Face.Glyph (glyphIndex, Self.load_flags);
|
|
|
|
if ftSlot = null
|
|
then
|
|
Self.Err := Self.Face.Error;
|
|
return False;
|
|
end if;
|
|
|
|
if Self.Intf = null
|
|
then
|
|
raise Error with "CheckGlyph ~ Self.Intf = null";
|
|
end if;
|
|
|
|
tempGlyph := Self.Intf.MakeGlyph (ftSlot);
|
|
|
|
if tempGlyph = null
|
|
then
|
|
if Self.Err = 0 then
|
|
Self.Err := 16#13#;
|
|
end if;
|
|
|
|
return False;
|
|
end if;
|
|
|
|
if Self.glyphList.Glyph (character) = null
|
|
then
|
|
Self.glyphList.add (tempGlyph, Character);
|
|
end if;
|
|
|
|
return True;
|
|
end CheckGlyph;
|
|
|
|
|
|
|
|
function BBox (Self : access Item; Text : in String;
|
|
Length : in Integer;
|
|
Position : in Vector_3;
|
|
Spacing : in Vector_3) return Bounds
|
|
is
|
|
pragma unreferenced (Length);
|
|
|
|
use freetype.charMap,
|
|
Geometry_3d;
|
|
|
|
Pos : Vector_3 := Position;
|
|
totalBBox : Bounds := null_Bounds;
|
|
begin
|
|
if Text = ""
|
|
then
|
|
totalBBox.Box := totalBBox.Box or Pos;
|
|
set_Ball_from_Box (totalBBox);
|
|
|
|
return totalBBox;
|
|
end if;
|
|
|
|
-- Only compute the bounds if string is non-empty.
|
|
--
|
|
if Text'Length > 0 -- TODO: Rid this useless check.
|
|
then
|
|
-- For multibyte, we can't rely on sizeof (T) == character
|
|
--
|
|
declare
|
|
use type freetype.charMap.characterCode;
|
|
|
|
thisChar : Character;
|
|
nextChar : Character;
|
|
|
|
begin
|
|
-- Expand totalBox by each glyph in string
|
|
--
|
|
for i in Text'Range
|
|
loop
|
|
thisChar := Text (i);
|
|
|
|
if i /= Text'Last
|
|
then nextChar := Text (i + 1);
|
|
else nextChar := ' ';
|
|
end if;
|
|
|
|
if Self.CheckGlyph (to_characterCode (thisChar))
|
|
then
|
|
declare
|
|
tempBBox : Bounds := Self.glyphList.BBox (to_characterCode (thisChar));
|
|
begin
|
|
tempBBox.Box := tempBBox.Box + Pos;
|
|
totalBBox.Box := totalBBox.Box or tempBBox.Box;
|
|
|
|
Pos := Pos + spacing;
|
|
Pos := Pos + Vector_3' (Self.glyphList.Advance (to_characterCode (thisChar),
|
|
to_characterCode (nextChar)),
|
|
0.0,
|
|
0.0);
|
|
end;
|
|
end if;
|
|
end loop;
|
|
end;
|
|
end if;
|
|
|
|
set_Ball_from_Box (totalBBox);
|
|
|
|
return totalBBox;
|
|
end BBox;
|
|
|
|
|
|
|
|
function kern_Advance (Self : in Item; From, To : in Character) return Real
|
|
is
|
|
use freetype.charMap;
|
|
begin
|
|
return Self.glyphList.Advance (to_characterCode (From),
|
|
to_characterCode (To));
|
|
end kern_Advance;
|
|
|
|
|
|
|
|
function x_PPEM (Self : in Item) return Real
|
|
is
|
|
use freetype_c.Binding;
|
|
|
|
ft_Size : constant FT_SizeRec_Pointer := FT_Face_Get_Size (Self.Face.freetype_Face);
|
|
ft_Metrics : constant freetype_c.FT_Size_Metrics.item := FT_Size_Get_Metrics (ft_Size);
|
|
begin
|
|
return Real (ft_Metrics.x_PPEM);
|
|
end x_PPEM;
|
|
|
|
|
|
|
|
function x_Scale (Self : in Item) return Real
|
|
is
|
|
use freetype_c.Binding;
|
|
|
|
ft_Size : constant FT_SizeRec_Pointer := FT_Face_Get_Size (Self.Face.freetype_Face);
|
|
ft_Metrics : constant freetype_c.FT_Size_Metrics.item := FT_Size_Get_Metrics (ft_Size);
|
|
begin
|
|
return Real (ft_Metrics.x_Scale);
|
|
end x_Scale;
|
|
|
|
|
|
|
|
function y_Scale (Self : in Item) return Real
|
|
is
|
|
use freetype_c.Binding;
|
|
|
|
ft_Size : constant FT_SizeRec_Pointer := FT_Face_Get_Size (Self.Face.freetype_Face);
|
|
ft_Metrics : constant freetype_c.FT_Size_Metrics.item := FT_Size_Get_Metrics (ft_Size);
|
|
begin
|
|
return Real (ft_Metrics.y_Scale);
|
|
end y_Scale;
|
|
|
|
|
|
|
|
function Advance (Self : access Item; Text : in String;
|
|
Length : in Integer;
|
|
Spacing : in Vector_3) return Real
|
|
is
|
|
pragma unreferenced (Length);
|
|
|
|
Advance : Real := 0.0;
|
|
ustr : Integer := 1;
|
|
i : Integer := 0;
|
|
|
|
begin
|
|
while i < Text'Length
|
|
loop
|
|
declare
|
|
use freetype.charMap;
|
|
use type freetype.charmap.characterCode;
|
|
|
|
thisChar : constant Character := Text (ustr);
|
|
nextChar : Character;
|
|
|
|
begin
|
|
ustr := ustr + 1;
|
|
|
|
if ustr <= Text'Length
|
|
then nextChar := Text (ustr);
|
|
else nextChar := Character'Val (0);
|
|
end if;
|
|
|
|
if nextChar /= Character'Val (0)
|
|
and then Self.CheckGlyph (to_characterCode (thisChar))
|
|
then
|
|
Advance := Advance + Self.glyphList.Advance (to_characterCode (thisChar),
|
|
to_characterCode (nextChar));
|
|
end if;
|
|
|
|
if nextChar /= Character'Val (0)
|
|
then
|
|
Advance := Advance + Spacing (1);
|
|
end if;
|
|
|
|
i := i + 1;
|
|
end;
|
|
end loop;
|
|
|
|
return advance;
|
|
end Advance;
|
|
|
|
|
|
--------------
|
|
--- Operations
|
|
--
|
|
|
|
function render (Self : access Item; Text : in String;
|
|
Length : in Integer;
|
|
Position : in Vector_3;
|
|
Spacing : in Vector_3;
|
|
renderMode : in Integer) return Vector_3
|
|
is
|
|
use type freetype.charMap.characterCode;
|
|
|
|
ustr : Integer := 1;
|
|
i : Integer := 0;
|
|
Pos : Vector_3 := Position;
|
|
|
|
begin
|
|
while (Length < 0 and then i < Text'Length)
|
|
or else (Length >= 0 and then i < Length)
|
|
loop
|
|
declare
|
|
use freetype.charMap;
|
|
|
|
thisChar : constant Character := Text (ustr);
|
|
nextChar : Character;
|
|
|
|
begin
|
|
ustr := ustr + 1;
|
|
|
|
if ustr <= Text'Length
|
|
then nextChar := Text (ustr);
|
|
else nextChar := Character'Val (0);
|
|
end if;
|
|
|
|
if nextChar /= Character'Val (0)
|
|
and then Self.CheckGlyph (to_characterCode (thisChar))
|
|
then
|
|
Pos := Pos + Self.glyphList.render (to_characterCode (thisChar),
|
|
to_characterCode (nextChar),
|
|
Position,
|
|
renderMode);
|
|
end if;
|
|
|
|
if nextChar /= Character'Val (0)
|
|
then
|
|
Pos := Pos + Spacing;
|
|
end if;
|
|
|
|
i := i + 1;
|
|
end;
|
|
end loop;
|
|
|
|
return Pos;
|
|
end Render;
|
|
|
|
|
|
end openGL.FontImpl;
|