Add initial prototype.
This commit is contained in:
Rod Kay
@@ -0,0 +1,341 @@
|
||||
with
|
||||
openGL.Glyph.texture,
|
||||
openGL.Glyph.Container,
|
||||
openGL.Palette,
|
||||
openGL.Tasks,
|
||||
|
||||
GL.Binding,
|
||||
GL.lean,
|
||||
GL.Pointers,
|
||||
|
||||
freetype_c.Binding,
|
||||
ada.unchecked_Conversion;
|
||||
|
||||
package body openGL.FontImpl.Texture
|
||||
is
|
||||
---------
|
||||
-- Forge
|
||||
--
|
||||
|
||||
function to_FontImpl_texture (ftFont : access Font.item'Class;
|
||||
fontFilePath : in String) return fontImpl.texture.item
|
||||
is
|
||||
use freetype_c.Binding;
|
||||
Success : Boolean;
|
||||
begin
|
||||
return Self : fontImpl.texture.item
|
||||
do
|
||||
define (Self'Access, ftFont, fontFilePath);
|
||||
|
||||
Self.load_Flags := freetype_c.FT_Int (FT_LOAD_NO_HINTING_flag or FT_LOAD_NO_BITMAP_flag);
|
||||
Self.numGlyphs := Self.Face.GlyphCount;
|
||||
Self.remGlyphs := Self.numGlyphs;
|
||||
|
||||
Success := Self.FaceSize (20);
|
||||
|
||||
if not Success then
|
||||
raise Error with "Unable to set font facesize for '" & fontFilePath & "'.";
|
||||
end if;
|
||||
end return;
|
||||
end to_FontImpl_texture;
|
||||
|
||||
|
||||
|
||||
function new_FontImpl_texture (ftFont : access Font.item'Class;
|
||||
fontFilePath : in String) return access fontImpl.texture.item'Class
|
||||
is
|
||||
use freetype_c.Binding;
|
||||
|
||||
Self : constant fontImpl.texture.view := new fontImpl.texture.item;
|
||||
Success : Boolean;
|
||||
begin
|
||||
define (Self, ftFont, fontFilePath);
|
||||
|
||||
Self.load_Flags := freetype_c.FT_Int (FT_LOAD_NO_HINTING_flag or FT_LOAD_NO_BITMAP_flag);
|
||||
Self.numGlyphs := Self.Face.GlyphCount;
|
||||
Self.remGlyphs := Self.numGlyphs;
|
||||
|
||||
Success := Self.FaceSize (20);
|
||||
|
||||
if not Success then
|
||||
raise Error with "Unable to set font facesize for '" & fontFilePath & "'.";
|
||||
end if;
|
||||
|
||||
return Self;
|
||||
end new_FontImpl_texture;
|
||||
|
||||
|
||||
|
||||
function to_FontImpl_texture (ftFont : access openGL.Font.item'Class;
|
||||
pBufferBytes : in unsigned_char_Pointer;
|
||||
bufferSizeInBytes : in Natural) return fontImpl.texture.item
|
||||
is
|
||||
use freetype_c.Binding;
|
||||
begin
|
||||
return Self : fontImpl.texture.item
|
||||
do
|
||||
define (Self'Access, ftFont, pBufferBytes, bufferSizeInBytes);
|
||||
|
||||
Self.load_Flags := freetype_c.FT_Int ( FT_LOAD_NO_HINTING_flag
|
||||
or FT_LOAD_NO_BITMAP_flag);
|
||||
Self.numGlyphs := Self.face.GlyphCount;
|
||||
Self.remGlyphs := Self.numGlyphs;
|
||||
end return;
|
||||
end to_FontImpl_texture;
|
||||
|
||||
|
||||
|
||||
function new_FontImpl_texture (ftFont : access Font.item'Class;
|
||||
pBufferBytes : in unsigned_char_Pointer;
|
||||
bufferSizeInBytes : in Natural) return fontImpl.texture.view
|
||||
is
|
||||
begin
|
||||
return new fontImpl.texture.item' (to_FontImpl_texture (ftFont,
|
||||
pBufferBytes,
|
||||
bufferSizeInBytes));
|
||||
end new_FontImpl_texture;
|
||||
|
||||
|
||||
|
||||
procedure free_Textures (Self : in out Item)
|
||||
is
|
||||
use texture_name_Vectors,
|
||||
GL.lean;
|
||||
|
||||
Cursor : texture_name_Vectors.Cursor := Self.textureIDList.First;
|
||||
the_Name : aliased openGL.Texture.texture_Name;
|
||||
begin
|
||||
Tasks.check;
|
||||
|
||||
while has_Element (Cursor)
|
||||
loop
|
||||
the_Name := Element (Cursor);
|
||||
glDeleteTextures (1, the_Name'Access);
|
||||
|
||||
next (Cursor);
|
||||
end loop;
|
||||
end free_Textures;
|
||||
|
||||
|
||||
|
||||
overriding
|
||||
procedure destruct (Self : in out Item)
|
||||
is
|
||||
use type ada.Containers.Count_type;
|
||||
begin
|
||||
destruct (FontImpl.item (Self)); -- Destroy base class.
|
||||
|
||||
if Self.textureIDList.Length > 0
|
||||
then
|
||||
Self.free_Textures;
|
||||
end if;
|
||||
end destruct;
|
||||
|
||||
|
||||
--------------
|
||||
-- Attributes
|
||||
--
|
||||
|
||||
overriding
|
||||
function FaceSize (Self : access Item; Size : in Natural;
|
||||
x_Res, y_Res : in Natural := 72) return Boolean
|
||||
is
|
||||
type access_FontImpl is access all FontImpl.item;
|
||||
Success : Boolean;
|
||||
begin
|
||||
if not Self.textureIDList.is_empty
|
||||
then
|
||||
Self.free_Textures;
|
||||
Self.textureIDList.clear;
|
||||
|
||||
Self.numGlyphs := Self.Face.GlyphCount;
|
||||
Self.remGlyphs := Self.numGlyphs;
|
||||
end if;
|
||||
|
||||
Success := access_FontImpl (Self).FaceSize (Size, x_Res, y_Res);
|
||||
return Success;
|
||||
end FaceSize;
|
||||
|
||||
|
||||
|
||||
function Render (Self : access Item; Text : in String;
|
||||
Length : in Integer;
|
||||
Position : in Vector_3;
|
||||
Spacing : in Vector_3;
|
||||
Mode : in renderMode) return Vector_3
|
||||
is
|
||||
use GL,
|
||||
GL.Binding;
|
||||
|
||||
function to_Integer is new ada.unchecked_Conversion (fontImpl.RenderMode, Integer);
|
||||
|
||||
Tmp : Vector_3;
|
||||
|
||||
begin
|
||||
Tasks.check;
|
||||
|
||||
glEnable (GL_BLEND);
|
||||
glBlendFunc (GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
|
||||
glEnable (GL_TEXTURE_2D);
|
||||
|
||||
GlyphImpl.texture.ResetActiveTexture;
|
||||
|
||||
Tmp := FontImpl.item (Self.all).Render (Text, Length,
|
||||
Position, Spacing,
|
||||
to_Integer (Mode));
|
||||
return Tmp;
|
||||
end Render;
|
||||
|
||||
|
||||
|
||||
function MakeGlyphImpl (Self : access Item; ftGlyph : in freetype_c.FT_GlyphSlot.item) return access Glyph.item'Class
|
||||
is
|
||||
tempGlyph : Glyph.Container.Glyph_view;
|
||||
begin
|
||||
Self.glyphHeight := Integer (Self.charSize.Height + 0.5);
|
||||
Self.glyphWidth := Integer (Self.charSize.Width + 0.5);
|
||||
|
||||
if Self.glyphHeight < 1 then Self.glyphHeight := 1; end if;
|
||||
if Self.glyphWidth < 1 then Self.glyphWidth := 1; end if;
|
||||
|
||||
if Self.textureIDList.is_empty
|
||||
then
|
||||
Self.textureIDList.append (Self.CreateTexture);
|
||||
Self.xOffset := Self.Padding;
|
||||
Self.yOffset := Self.Padding;
|
||||
end if;
|
||||
|
||||
if Self.xOffset > (Integer (Self.textureWidth) - Self.glyphWidth)
|
||||
then
|
||||
Self.xOffset := Self.Padding;
|
||||
Self.yOffset := Self.yOffset + Self.glyphHeight;
|
||||
|
||||
if Self.yOffset > (Integer (Self.textureHeight) - Self.glyphHeight)
|
||||
then
|
||||
Self.textureIDList.append (Self.CreateTexture);
|
||||
Self.yOffset := Self.Padding;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
tempGlyph := openGL.Glyph.texture.new_Glyph (ftGlyph,
|
||||
Self.textureIDList.last_Element,
|
||||
Self.xOffset,
|
||||
Self.yOffset,
|
||||
Integer (Self.textureWidth),
|
||||
Integer (Self.textureHeight)).all'Access;
|
||||
|
||||
Self.xOffset := Self.xOffset + Integer ( tempGlyph.BBox.Box.Upper (1)
|
||||
- tempGlyph.BBox.Box.Lower (1)
|
||||
+ Real (Self.Padding)
|
||||
+ 0.5);
|
||||
Self.remGlyphs := Self.remGlyphs - 1;
|
||||
|
||||
return tempGlyph;
|
||||
end MakeGlyphImpl;
|
||||
|
||||
|
||||
|
||||
function Quad (Self : access Item; for_Character : in Character) return GlyphImpl.texture.Quad_t
|
||||
is
|
||||
use freetype.charMap;
|
||||
|
||||
Success : constant Boolean := Self.CheckGlyph (to_characterCode (for_Character)) with unreferenced;
|
||||
the_Glyph : constant Glyph.Container.Glyph_view := Self.glyphList.Glyph (to_characterCode (for_Character));
|
||||
begin
|
||||
return Glyph.texture.item (the_Glyph.all).Quad ([0.0, 0.0, 0.0]);
|
||||
end Quad;
|
||||
|
||||
|
||||
|
||||
procedure CalculateTextureSize (Self : in out Item)
|
||||
is
|
||||
use openGL.Texture,
|
||||
GL,
|
||||
GL.Binding;
|
||||
|
||||
use type GL.GLsizei;
|
||||
|
||||
H : Integer;
|
||||
|
||||
begin
|
||||
Tasks.check;
|
||||
|
||||
if Self.maximumGLTextureSize = 0
|
||||
then
|
||||
Self.maximumGLTextureSize := 1024;
|
||||
glGetIntegerv (GL_MAX_TEXTURE_SIZE, Self.maximumGLTextureSize'Access);
|
||||
|
||||
pragma assert (Self.maximumGLTextureSize /= 0); -- If you hit this then you have an invalid openGL context.
|
||||
end if;
|
||||
|
||||
begin
|
||||
Self.textureWidth := Power_of_2_Ceiling ( (Self.remGlyphs * Self.glyphWidth)
|
||||
+ (Self.Padding * 2));
|
||||
exception
|
||||
when constraint_Error =>
|
||||
Self.textureWidth := Self.maximumGLTextureSize;
|
||||
end;
|
||||
|
||||
if Self.textureWidth > Self.maximumGLTextureSize
|
||||
then Self.textureWidth := Self.maximumGLTextureSize;
|
||||
end if;
|
||||
|
||||
H := Integer ( Real (Integer (Self.textureWidth) - (Self.Padding * 2))
|
||||
/ Real (Self.glyphWidth)
|
||||
+ 0.5);
|
||||
Self.textureHeight := Power_of_2_Ceiling ( ((Self.numGlyphs / H) + 1)
|
||||
* Self.glyphHeight);
|
||||
|
||||
if Self.textureHeight > Self.maximumGLTextureSize
|
||||
then Self.textureHeight := Self.maximumGLTextureSize;
|
||||
end if;
|
||||
end CalculateTextureSize;
|
||||
|
||||
|
||||
|
||||
function CreateTexture (Self : access Item) return openGL.Texture.texture_Name
|
||||
is
|
||||
use openGL.Palette,
|
||||
GL,
|
||||
GL.Binding;
|
||||
begin
|
||||
Tasks.check;
|
||||
|
||||
Self.CalculateTextureSize;
|
||||
|
||||
declare
|
||||
use GL.Pointers;
|
||||
|
||||
the_Image : Image (1 .. Index_t (self.textureHeight),
|
||||
1 .. Index_t (Self.textureWidth)) := (others => [others => +Black]);
|
||||
|
||||
textID : aliased openGL.Texture.texture_Name;
|
||||
begin
|
||||
glGenTextures (1, textID'Access);
|
||||
|
||||
glBindTexture (GL_TEXTURE_2D, textID);
|
||||
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);
|
||||
|
||||
glTexImage2D (GL_TEXTURE_2D,
|
||||
0, GL_ALPHA,
|
||||
Self.textureWidth, Self.textureHeight,
|
||||
0, GL_ALPHA,
|
||||
GL_UNSIGNED_BYTE,
|
||||
to_GLvoid_access (the_Image (1, 1).Red'Access));
|
||||
return textID;
|
||||
end;
|
||||
end CreateTexture;
|
||||
|
||||
|
||||
|
||||
function gl_Texture (Self : in Item) return openGL.Texture.texture_Name
|
||||
is
|
||||
begin
|
||||
return Self.textureIDList.last_Element;
|
||||
end gl_Texture;
|
||||
|
||||
|
||||
end openGL.FontImpl.Texture;
|
||||
@@ -0,0 +1,128 @@
|
||||
with
|
||||
openGL.Texture,
|
||||
openGL.GlyphImpl.texture,
|
||||
|
||||
freetype_c.FT_GlyphSlot,
|
||||
|
||||
ada.Containers.Vectors;
|
||||
|
||||
private
|
||||
with
|
||||
GL;
|
||||
|
||||
|
||||
package openGL.FontImpl.texture
|
||||
--
|
||||
-- Implements a texture font.
|
||||
--
|
||||
is
|
||||
type Item is new FontImpl.item with private;
|
||||
type View is access all Item'Class;
|
||||
|
||||
|
||||
---------
|
||||
-- Forge
|
||||
--
|
||||
|
||||
function to_FontImpl_texture (ftFont : access openGL.Font.item'Class;
|
||||
fontFilePath : in String) return fontImpl.texture.item;
|
||||
|
||||
function new_FontImpl_texture (ftFont : access openGL.Font.item'Class;
|
||||
fontFilePath : in String) return access fontImpl.texture.item'Class;
|
||||
|
||||
function to_FontImpl_texture (ftFont : access openGL.Font.item'Class;
|
||||
pBufferBytes : in unsigned_char_Pointer;
|
||||
bufferSizeInBytes : in Natural) return fontImpl.texture.item;
|
||||
|
||||
function new_FontImpl_texture (ftFont : access openGL.Font.item'Class;
|
||||
pBufferBytes : in unsigned_char_Pointer;
|
||||
bufferSizeInBytes : in Natural) return fontImpl.texture.view;
|
||||
overriding
|
||||
procedure destruct (Self : in out Item);
|
||||
|
||||
|
||||
--------------
|
||||
-- Attributes
|
||||
--
|
||||
|
||||
overriding
|
||||
function FaceSize (Self : access Item; Size : in Natural;
|
||||
x_Res,
|
||||
y_Res : in Natural := 72) return Boolean;
|
||||
--
|
||||
-- Set the char size for the current face.
|
||||
--
|
||||
-- Returns True if size was set correctly.
|
||||
|
||||
|
||||
function render (Self : access Item; Text : in String;
|
||||
Length : in Integer;
|
||||
Position : in Vector_3;
|
||||
Spacing : in Vector_3;
|
||||
Mode : in renderMode) return Vector_3;
|
||||
|
||||
function Quad (Self : access Item; for_Character : in Character) return openGL.GlyphImpl.Texture.Quad_t;
|
||||
|
||||
|
||||
---------------
|
||||
--- 'Protected'
|
||||
--
|
||||
|
||||
function MakeGlyphImpl (Self : access Item; ftGlyph : in freetype_c.FT_GlyphSlot.item) return access Glyph.item'Class;
|
||||
--
|
||||
-- Create an FTTextureGlyph object for the base class.
|
||||
|
||||
|
||||
function gl_Texture (Self : in Item) return openGL.Texture.texture_Name;
|
||||
|
||||
|
||||
|
||||
private
|
||||
|
||||
use type openGL.Texture.texture_Name;
|
||||
package texture_name_Vectors is new ada.Containers.Vectors (Positive, openGL.Texture.texture_Name);
|
||||
|
||||
|
||||
type Item is new FontImpl.item with
|
||||
record
|
||||
maximumGLTextureSize : aliased gl.GLsizei := 0; -- The max texture dimension on this openGL implemetation.
|
||||
|
||||
textureWidth : gl.GLsizei := 0; -- The min texture width required to hold the glyphs.
|
||||
textureHeight : gl.GLsizei := 0; -- The min texture height required to hold the glyphs.
|
||||
textureIDList : texture_name_Vectors.Vector;
|
||||
-- An array of texture ids.
|
||||
|
||||
glyphHeight : Integer := 0; -- The max height for glyphs in the current font.
|
||||
glyphWidth : Integer := 0; -- The max width for glyphs in the current font.
|
||||
|
||||
Padding : Natural := 3; -- A value to be added to the height and width to ensure that
|
||||
numGlyphs : Natural; -- glyphs don't overlap in the texture.
|
||||
remGlyphs : Natural;
|
||||
|
||||
xOffset, yOffset : Integer := 0;
|
||||
end record;
|
||||
|
||||
|
||||
procedure CalculateTextureSize (Self : in out Item);
|
||||
--
|
||||
-- Get the size of a block of memory required to layout the glyphs
|
||||
--
|
||||
-- Calculates a width and height based on the glyph sizes and the
|
||||
-- number of glyphs. It over estimates.
|
||||
|
||||
|
||||
function CreateTexture (Self : access Item) return openGL.Texture.texture_Name;
|
||||
--
|
||||
-- Creates a 'blank' openGL texture object.
|
||||
--
|
||||
-- The format is GL_ALPHA and the params are
|
||||
-- * GL_TEXTURE_WRAP_S = GL_CLAMP
|
||||
-- * GL_TEXTURE_WRAP_T = GL_CLAMP
|
||||
-- * GL_TEXTURE_MAG_FILTER = GL_LINEAR
|
||||
-- * GL_TEXTURE_MIN_FILTER = GL_LINEAR
|
||||
-- * Note that mipmapping is NOT used
|
||||
|
||||
|
||||
procedure free_Textures (Self : in out Item);
|
||||
|
||||
end openGL.FontImpl.Texture;
|
||||
517
3-mid/opengl/source/lean/text/private/opengl-fontimpl.adb
Normal file
517
3-mid/opengl/source/lean/text/private/opengl-fontimpl.adb
Normal file
@@ -0,0 +1,517 @@
|
||||
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;
|
||||
153
3-mid/opengl/source/lean/text/private/opengl-fontimpl.ads
Normal file
153
3-mid/opengl/source/lean/text/private/opengl-fontimpl.ads
Normal file
@@ -0,0 +1,153 @@
|
||||
with
|
||||
openGL.Glyph.Container,
|
||||
freetype.Face,
|
||||
freetype.charMap,
|
||||
Freetype_C,
|
||||
interfaces.C.Pointers;
|
||||
|
||||
limited
|
||||
with
|
||||
openGL.Font;
|
||||
|
||||
private
|
||||
with
|
||||
freetype.face_Size;
|
||||
|
||||
package openGL.FontImpl
|
||||
--
|
||||
-- Implements an openGL font.
|
||||
--
|
||||
is
|
||||
type Item is tagged limited private;
|
||||
type View is access all Item'Class;
|
||||
|
||||
|
||||
---------
|
||||
-- Types
|
||||
--
|
||||
|
||||
type RenderMode is (RENDER_FRONT, RENDER_BACK, RENDER_SIDE, RENDER_ALL);
|
||||
|
||||
for RenderMode use (RENDER_FRONT => 16#0001#,
|
||||
RENDER_BACK => 16#0002#,
|
||||
RENDER_SIDE => 16#0004#,
|
||||
RENDER_ALL => 16#ffff#);
|
||||
|
||||
type TextAlignment is (ALIGN_LEFT, ALIGN_CENTER, ALIGN_RIGHT, ALIGN_JUSTIFY);
|
||||
|
||||
for TextAlignment use (ALIGN_LEFT => 0,
|
||||
ALIGN_CENTER => 1,
|
||||
ALIGN_RIGHT => 2,
|
||||
ALIGN_JUSTIFY => 3);
|
||||
|
||||
|
||||
-- unsigned_char_Pointer
|
||||
--
|
||||
|
||||
use Interfaces;
|
||||
|
||||
type unsigned_char_array is array (C.size_t range <>) of aliased C.unsigned_char;
|
||||
|
||||
package unsigned_char_Pointers is new C.Pointers (Index => C.size_t,
|
||||
Element => C.unsigned_char,
|
||||
Element_array => unsigned_char_array,
|
||||
default_Terminator => 0);
|
||||
subtype unsigned_char_Pointer is unsigned_char_Pointers.Pointer;
|
||||
|
||||
|
||||
---------
|
||||
-- Forge
|
||||
--
|
||||
|
||||
procedure define (Self : access Item; ftFont : access Font.item'Class;
|
||||
fontFilePath : in String);
|
||||
|
||||
procedure define (Self : access Item; ftFont : access Font.item'Class;
|
||||
pBufferBytes : access C.unsigned_char;
|
||||
bufferSizeInBytes : in Integer);
|
||||
procedure destruct (Self : in out Item);
|
||||
|
||||
|
||||
---------------
|
||||
-- 'Protected' ~ For derived class use only.
|
||||
--
|
||||
|
||||
function Err (Self : in Item) return freetype_c.FT_Error;
|
||||
|
||||
function attach (Self : access Item; fontFilePath : in String) return Boolean;
|
||||
function attach (Self : access Item; pBufferBytes : access C.unsigned_char;
|
||||
bufferSizeInBytes : in Integer) return Boolean;
|
||||
|
||||
function FaceSize (Self : access Item; Size : in Natural;
|
||||
x_Res,
|
||||
y_Res : in Natural) return Boolean;
|
||||
function FaceSize (Self : in Item) return Natural;
|
||||
|
||||
procedure Depth (Self : in out Item; Depth : in Real);
|
||||
procedure Outset (Self : in out Item; Outset : in Real);
|
||||
procedure Outset (Self : in out Item; Front : in Real;
|
||||
Back : in Real);
|
||||
|
||||
procedure GlyphLoadFlags (Self : in out Item; Flags : in freetype_c.FT_Int);
|
||||
|
||||
function CharMap (Self : access Item; Encoding : in freetype_c.FT_Encoding) return Boolean;
|
||||
function CharMapCount (Self : in Item) return Natural;
|
||||
function CharMapList (Self : access Item) return freetype.face.FT_Encodings_view;
|
||||
|
||||
function Ascender (Self : in Item) return Real;
|
||||
function Descender (Self : in Item) return Real;
|
||||
function LineHeight (Self : in Item) return Real;
|
||||
|
||||
function BBox (Self : access Item; Text : in String;
|
||||
Length : in Integer;
|
||||
Position : in Vector_3;
|
||||
Spacing : in Vector_3) return Bounds;
|
||||
|
||||
function Advance (Self : access Item; Text : in String;
|
||||
Length : in Integer;
|
||||
Spacing : in Vector_3) return Real;
|
||||
|
||||
function kern_Advance (Self : in Item; From, To : in Character) return Real;
|
||||
|
||||
|
||||
function x_PPEM (Self : in Item) return Real;
|
||||
function x_Scale (Self : in Item) return Real;
|
||||
function y_Scale (Self : in Item) return Real;
|
||||
|
||||
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;
|
||||
|
||||
|
||||
private
|
||||
|
||||
type glyph_Container_view is access all openGL.Glyph.Container.item'Class;
|
||||
|
||||
|
||||
type Item is tagged limited
|
||||
record
|
||||
Face : aliased freetype.Face.item; -- Current face object.
|
||||
charSize : freetype.face_Size.item; -- Current size object.
|
||||
|
||||
load_Flags : freetype_c.FT_Int; -- The default glyph loading flags.
|
||||
Err : freetype_c.FT_Error; -- Current error code. Zero means no error.
|
||||
|
||||
Intf : access Font.item'Class; -- A link back to the interface of which we implement.
|
||||
glyphList : Glyph_Container_view; -- An object that holds a list of glyphs
|
||||
|
||||
Pen : Vector_3; -- Current pen or cursor position;
|
||||
end record;
|
||||
|
||||
|
||||
function CheckGlyph (Self : access Item; Character : in freetype.charmap.CharacterCode) return Boolean;
|
||||
--
|
||||
-- Check that the glyph at <code>chr</code> exist. If not load it.
|
||||
--
|
||||
-- Character: The character index.
|
||||
--
|
||||
-- Returns true if the glyph can be created.
|
||||
|
||||
|
||||
end openGL.FontImpl;
|
||||
@@ -0,0 +1,178 @@
|
||||
with
|
||||
openGL.Tasks,
|
||||
openGL.Errors,
|
||||
|
||||
GL.Binding,
|
||||
GL.Pointers,
|
||||
|
||||
freetype_c.Binding,
|
||||
freetype_c.FT_Bitmap,
|
||||
|
||||
interfaces.C;
|
||||
|
||||
|
||||
package body openGL.GlyphImpl.texture
|
||||
is
|
||||
-----------
|
||||
-- Globals
|
||||
--
|
||||
|
||||
activeTextureID : openGL.texture.texture_Name; -- TODO: Check C source for how this is used.
|
||||
pragma Unreferenced (activeTextureID);
|
||||
--
|
||||
-- The texture index of the currently active texture
|
||||
--
|
||||
-- We keep track of the currently active texture to try to reduce the
|
||||
-- number of texture bind operations.
|
||||
|
||||
procedure ResetActiveTexture
|
||||
is
|
||||
begin
|
||||
activeTextureID := 0;
|
||||
end ResetActiveTexture;
|
||||
|
||||
|
||||
---------
|
||||
-- Forge
|
||||
--
|
||||
|
||||
function new_GlyphImpl (glyth_Slot : in freetype_c.FT_GlyphSlot.item;
|
||||
texture_Id : in openGL.Texture.texture_Name;
|
||||
xOffset, yOffset : in Integer;
|
||||
Width, Height : in Integer) return GlyphImpl.texture.view
|
||||
is
|
||||
use freetype_C,
|
||||
freetype_C.Binding,
|
||||
GL,
|
||||
GL.Binding;
|
||||
|
||||
use type interfaces.C.unsigned,
|
||||
GLint;
|
||||
|
||||
Self : constant GlyphImpl.texture.view := new GlyphImpl.texture.item;
|
||||
begin
|
||||
Tasks.check;
|
||||
|
||||
Self.define (glyth_Slot);
|
||||
|
||||
Self.destWidth := 0;
|
||||
Self.destHeight := 0;
|
||||
Self.glTextureID := texture_Id;
|
||||
Self.Err := FT_Render_Glyph (glyth_Slot,
|
||||
FT_RENDER_MODE_NORMAL);
|
||||
if Self.Err /= no_Error
|
||||
then
|
||||
raise openGL.Error with "FT_Render_Glyph failed with error code: " & Self.Err'Image;
|
||||
end if;
|
||||
|
||||
if FT_GlyphSlot_Get_Format (glyth_Slot) /= get_FT_GLYPH_FORMAT_BITMAP
|
||||
then
|
||||
raise openGL.Error with "Glyph is not a bitmap format.";
|
||||
end if;
|
||||
|
||||
declare
|
||||
use GL.Pointers;
|
||||
Bitmap : constant freetype_C.FT_Bitmap.item := FT_GlyphSlot_Get_Bitmap (glyth_Slot);
|
||||
begin
|
||||
Self.destWidth := Bitmap.Width;
|
||||
Self.destHeight := Bitmap.Rows;
|
||||
|
||||
if Self.destWidth /= 0
|
||||
and then Self.destHeight /= 0
|
||||
then
|
||||
glPixelStorei (GL_UNPACK_ALIGNMENT, 1);
|
||||
|
||||
glBindTexture (GL_TEXTURE_2D, Self.glTextureID);
|
||||
Errors.log;
|
||||
|
||||
glTexSubImage2D (GL_TEXTURE_2D, 0,
|
||||
GLint (xOffset), GLint (yOffset),
|
||||
Self.destWidth, Self.destHeight,
|
||||
GL_ALPHA,
|
||||
GL_UNSIGNED_BYTE,
|
||||
to_GLvoid_access (Bitmap.Buffer));
|
||||
Errors.log;
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- 0
|
||||
-- +----+
|
||||
-- | |
|
||||
-- | |
|
||||
-- | |
|
||||
-- +----+
|
||||
-- 1
|
||||
|
||||
Self.UV (1).S := Real (xOffset) / Real (Width);
|
||||
Self.UV (1).T := Real (yOffset) / Real (Height);
|
||||
|
||||
Self.UV (2).S := Real (GLint (xOffset) + Self.destWidth) / Real (Width);
|
||||
Self.UV (2).T := Real (GLint (yOffset) + Self.destHeight) / Real (Height);
|
||||
|
||||
Self.Corner := [Real (FT_GlyphSlot_Get_bitmap_left (glyth_Slot)),
|
||||
Real (FT_GlyphSlot_Get_bitmap_top (glyth_Slot)),
|
||||
0.0];
|
||||
declare
|
||||
use openGL.Primitive;
|
||||
the_Indices : constant openGL.Indices := [1, 2, 3, 4];
|
||||
begin
|
||||
Self.Primitive := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
|
||||
end;
|
||||
|
||||
return Self;
|
||||
end new_GlyphImpl;
|
||||
|
||||
|
||||
--------------
|
||||
-- Attributes
|
||||
--
|
||||
|
||||
function Quad (Self : in Item; Pen : in Vector_3) return Quad_t
|
||||
is
|
||||
dx : constant Real := Real'Floor (Pen (1) + Self.Corner (1));
|
||||
dy : constant Real := Real'Floor (Pen (2) + Self.Corner (2));
|
||||
|
||||
the_Quad : aliased constant Quad_t := (NW => (Site => [dx,
|
||||
dy,
|
||||
0.0],
|
||||
Coords => [S => Self.UV (1).S,
|
||||
T => Self.UV (1).T]),
|
||||
|
||||
SW => (Site => [dx,
|
||||
dy - Real (Self.destHeight),
|
||||
0.0],
|
||||
Coords => [S => Self.UV (1).S,
|
||||
T => Self.UV (2).T]),
|
||||
|
||||
SE => (Site => [dx + Real (Self.destWidth),
|
||||
dy - Real (Self.destHeight),
|
||||
0.0],
|
||||
Coords => [S => Self.UV (2).S,
|
||||
T => Self.UV (2).T]),
|
||||
|
||||
NE => (Site => [dx + Real (Self.destWidth),
|
||||
dy,
|
||||
0.0],
|
||||
Coords => [S => Self.UV (2).S,
|
||||
T => Self.UV (1).T]),
|
||||
|
||||
Advance => Self.Advance);
|
||||
begin
|
||||
return the_Quad;
|
||||
end Quad;
|
||||
|
||||
|
||||
--------------
|
||||
-- Operations
|
||||
--
|
||||
|
||||
function renderImpl (Self : in Item; Pen : in Vector_3;
|
||||
renderMode : in Integer) return Vector_3
|
||||
is
|
||||
pragma unreferenced (renderMode);
|
||||
begin
|
||||
return Self.Advance;
|
||||
end renderImpl;
|
||||
|
||||
|
||||
end openGL.GlyphImpl.Texture;
|
||||
@@ -0,0 +1,99 @@
|
||||
with
|
||||
openGL.Texture,
|
||||
freetype_c.FT_GlyphSlot;
|
||||
|
||||
private
|
||||
with
|
||||
openGL.Geometry.lit_textured,
|
||||
openGL.Primitive.indexed,
|
||||
GL;
|
||||
|
||||
package openGL.GlyphImpl.texture
|
||||
--
|
||||
-- Implements a texture-based glyph.
|
||||
--
|
||||
is
|
||||
type Item is new GlyphImpl.item with private;
|
||||
type View is access all Item'Class;
|
||||
|
||||
|
||||
---------
|
||||
-- Types
|
||||
--
|
||||
|
||||
type Vertex is
|
||||
record
|
||||
Site : Vector_3;
|
||||
Coords : Coordinate_2D;
|
||||
end record;
|
||||
|
||||
type Quad_t is
|
||||
record
|
||||
NW, NE,
|
||||
SW, SE : Vertex;
|
||||
Advance : Vector_3;
|
||||
end record;
|
||||
|
||||
|
||||
---------
|
||||
-- Forge
|
||||
--
|
||||
function new_GlyphImpl (glyth_Slot : in freetype_c.FT_GlyphSlot.item;
|
||||
texture_Id : in openGL.Texture.texture_Name;
|
||||
xOffset, yOffset : in Integer;
|
||||
Width, Height : in Integer) return GlyphImpl.texture.view;
|
||||
--
|
||||
-- glyth_Slot: The Freetype glyph to be processed.
|
||||
-- texture_Id: The Id of the texture that this glyph will be drawn in.
|
||||
-- xOffset, yOffset: The x any y offset into the parent texture to draw this glyph.
|
||||
-- Width, Height: The width and height (number of rows) of the parent texture.
|
||||
|
||||
|
||||
--------------
|
||||
-- Attributes
|
||||
--
|
||||
|
||||
function Quad (Self : in Item; Pen : in Vector_3) return Quad_t;
|
||||
|
||||
|
||||
--------------
|
||||
-- Operations
|
||||
--
|
||||
|
||||
function renderImpl (Self : in Item; Pen : in Vector_3;
|
||||
renderMode : in Integer) return Vector_3;
|
||||
--
|
||||
-- Pen: The current pen position.
|
||||
-- renderMode: Render mode to display.
|
||||
--
|
||||
-- Returns the advance distance for this glyph.
|
||||
|
||||
|
||||
-------------
|
||||
-- Protected - for derived class use only.
|
||||
--
|
||||
|
||||
procedure ResetActiveTexture;
|
||||
--
|
||||
-- Reset the currently active texture to zero to get into a known
|
||||
-- state before drawing a string. This is to get around possible threading issues.
|
||||
|
||||
|
||||
|
||||
private
|
||||
|
||||
type Item is new GlyphImpl.item with
|
||||
record
|
||||
destWidth, -- The width and height of the glyph 'image'.
|
||||
destHeight : GL.GLint;
|
||||
|
||||
Corner : Vector_3; -- Vector from the pen site to the top left of the pixmap.
|
||||
|
||||
UV : Coordinates_2D (1 .. 2); -- The texture co-ords of this glyph within the texture.
|
||||
glTextureID : openGL.texture.texture_Name; -- The texture index that this glyph is contained in.
|
||||
|
||||
Geometry : access Geometry.lit_textured.item;
|
||||
Primitive : openGL.Primitive.indexed.view;
|
||||
end record;
|
||||
|
||||
end openGL.GlyphImpl.texture;
|
||||
94
3-mid/opengl/source/lean/text/private/opengl-glyphimpl.adb
Normal file
94
3-mid/opengl/source/lean/text/private/opengl-glyphimpl.adb
Normal file
@@ -0,0 +1,94 @@
|
||||
with
|
||||
freetype_c.Binding,
|
||||
freetype_c.FT_BBox,
|
||||
freetype_c.FT_Vector;
|
||||
|
||||
package body openGL.GlyphImpl
|
||||
is
|
||||
-----------
|
||||
-- Utility
|
||||
--
|
||||
|
||||
function Bounds_of (glyth_Slot : in freetype_c.FT_GlyphSlot.item) return Bounds
|
||||
is
|
||||
use freetype_c.Binding;
|
||||
|
||||
bBox : aliased freetype_c.FT_BBox.item;
|
||||
the_Bounds : Bounds;
|
||||
|
||||
begin
|
||||
FT_Outline_Get_CBox (FT_GlyphSlot_Get_Outline (glyth_Slot).all'unchecked_Access,
|
||||
bBox'unchecked_Access);
|
||||
|
||||
the_Bounds := (Ball => <>,
|
||||
Box => (Lower => [1 => Real (bbox.xMin) / 64.0,
|
||||
2 => Real (bbox.yMin) / 64.0,
|
||||
3 => 0.0],
|
||||
Upper => [1 => Real (bbox.xMax) / 64.0,
|
||||
2 => Real (bbox.yMax) / 64.0,
|
||||
3 => 0.0]));
|
||||
set_Ball_from_Box (the_Bounds);
|
||||
|
||||
return the_Bounds;
|
||||
end Bounds_of;
|
||||
|
||||
|
||||
---------
|
||||
-- Forge
|
||||
--
|
||||
|
||||
procedure define (Self : in out Item; glyth_Slot : in freetype_c.FT_GlyphSlot.item)
|
||||
is
|
||||
use type freetype_c.FT_GlyphSlot.item;
|
||||
begin
|
||||
Self.Err := no_Error;
|
||||
|
||||
if glyth_Slot /= null
|
||||
then
|
||||
Self.bBox := Bounds_of (glyth_Slot);
|
||||
|
||||
declare
|
||||
use freetype_c.Binding;
|
||||
the_Advance : constant freetype_c.FT_Vector.item := FT_GlyphSlot_Get_Advance (glyth_Slot);
|
||||
begin
|
||||
Self.Advance := [Real (the_Advance.x) / 64.0,
|
||||
Real (the_Advance.y) / 64.0,
|
||||
0.0];
|
||||
end;
|
||||
end if;
|
||||
end define;
|
||||
|
||||
|
||||
procedure destruct (Self : in out Item)
|
||||
is
|
||||
begin
|
||||
null;
|
||||
end destruct;
|
||||
|
||||
|
||||
--------------
|
||||
-- Attributes
|
||||
--
|
||||
|
||||
function Advance (Self : in Item) return Real
|
||||
is
|
||||
begin
|
||||
return Self.Advance (1);
|
||||
end Advance;
|
||||
|
||||
|
||||
function BBox (Self : in Item) return Bounds
|
||||
is
|
||||
begin
|
||||
return Self.bBox;
|
||||
end BBox;
|
||||
|
||||
|
||||
function Error (Self : in Item) return error_Kind
|
||||
is
|
||||
begin
|
||||
return Self.Err;
|
||||
end Error;
|
||||
|
||||
|
||||
end openGL.GlyphImpl;
|
||||
51
3-mid/opengl/source/lean/text/private/opengl-glyphimpl.ads
Normal file
51
3-mid/opengl/source/lean/text/private/opengl-glyphimpl.ads
Normal file
@@ -0,0 +1,51 @@
|
||||
with
|
||||
freetype_C.FT_GlyphSlot;
|
||||
|
||||
package openGL.GlyphImpl
|
||||
--
|
||||
-- Implements an openGL glyph.
|
||||
--
|
||||
is
|
||||
type Item is tagged private;
|
||||
type View is access all Item'Class;
|
||||
|
||||
|
||||
---------
|
||||
-- Types
|
||||
--
|
||||
subtype error_Kind is freetype_C.FT_Error;
|
||||
|
||||
no_Error : constant error_Kind;
|
||||
|
||||
|
||||
---------
|
||||
-- Forge
|
||||
--
|
||||
procedure define (Self : in out Item; glyth_Slot : in freetype_c.FT_GlyphSlot.item);
|
||||
--
|
||||
-- glyth_Slot: The Freetype glyph to be processed.
|
||||
|
||||
|
||||
--------------
|
||||
-- Attributes
|
||||
--
|
||||
function Advance (Self : in Item) return Real; -- The advance distance for this glyph.
|
||||
function BBox (Self : in Item) return Bounds; -- Return the bounding box for this glyph.
|
||||
function Error (Self : in Item) return error_Kind; -- Return the current error code.
|
||||
|
||||
|
||||
|
||||
private
|
||||
|
||||
type Item is tagged
|
||||
record
|
||||
Advance : Vector_3;
|
||||
bBox : Bounds;
|
||||
Err : error_Kind;
|
||||
end record;
|
||||
|
||||
procedure destruct (Self : in out Item);
|
||||
|
||||
no_Error : constant error_Kind := 0;
|
||||
|
||||
end openGL.GlyphImpl;
|
||||
Reference in New Issue
Block a user