lace_opengl_0.1.0_672a6415/source/lean/text/opengl-font-texture.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
with
     openGL.FontImpl.texture,
     ada.unchecked_Deallocation;

package body openGL.Font.texture
is
   ---------
   --  Forge
   --

   function to_Font_texture (fontFilePath : in String) return Font.texture.item
   is
   begin
      return Self : Font.texture.item
      do
         Self.define (fontImpl.texture.new_FontImpl_texture (Self'Access,
                                                             fontFilePath));
      end return;
   end to_Font_texture;


   function new_Font_texture (fontFilePath : in String) return Font.texture.view
   is
      Self : constant Font.texture.view := new Font.texture.item;
   begin
      Self.define (fontImpl.Texture.new_FontImpl_texture (Self,
                                                          fontFilePath));
      return Self;
   end new_Font_texture;


   function to_Font_texture (pBufferBytes      : in FontImpl.unsigned_char_Pointer;
                             bufferSizeInBytes : in Natural) return Font.texture.item
   is
   begin
      return Self : Font.texture.item
      do
         Self.define (fontImpl.Texture.new_FontImpl_texture (Self'Access,
                                                             pBufferBytes,
                                                             bufferSizeInBytes));
      end return;
   end to_Font_texture;


   overriding
   procedure destruct (Self : in out Item)
   is
   begin
      destruct (openGL.Font.item (Self));   -- Destroy base class.
   end destruct;


   procedure free (Self : in out View)
   is
      procedure deallocate is new ada.unchecked_Deallocation (Item'Class, View);
   begin
      Self.destruct;
      deallocate (Self);
   end free;


   --------------
   --  Attributes
   --

   function gl_Texture (Self : in Item) return openGL.Texture.texture_Name
   is
   begin
      return fontImpl.texture.view (Self.Impl).gl_Texture;
   end gl_Texture;


   function Quad (Self : in Item;   for_Character : in Character) return GlyphImpl.Texture.Quad_t
   is
   begin
      return fontImpl.texture.view (Self.Impl).Quad (for_Character);
   end Quad;


   --------------
   --  Operations
   --

   overriding
   function MakeGlyph (Self : access Item;   Slot : in freetype_c.FT_GlyphSlot.item) return glyph.Container.Glyph_view
   is
      type FontImpl_texture_view is access all FontImpl.texture.Item'Class;

      myimpl : constant FontImpl_texture_view := FontImpl_texture_view (Self.impl);
   begin
      if myimpl = null then
         return null;
      end if;

      return myimpl.MakeGlyphImpl (Slot);
   end MakeGlyph;


end openGL.Font.texture;