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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198 | with
openGL.Primitive.indexed,
openGL.Geometry.textured,
openGL.io,
ada.unchecked_Deallocation;
package body openGL.Model.billboard.textured
is
---------
--- Forge
--
package body Forge
is
function new_Billboard (Size : in Size_t := default_Size;
Plane : in billboard.Plane;
Texture : in asset_Name;
Lucid : in Boolean := False) return View
is
Self : constant View := new Item (Lucid);
begin
Self.Plane := Plane;
Self.Texture_Name := Texture;
Self.define (Size);
return Self;
end new_Billboard;
end Forge;
--------------
--- Attributes
--
overriding
function to_GL_Geometries (Self : access Item; Textures : access openGL.Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views
is
pragma unreferenced (Textures, Fonts);
use Geometry,
Geometry.textured,
openGL.Texture;
the_Indices : aliased constant Indices := (1, 2, 3, 4);
the_Sites : constant billboard.Sites := vertex_Sites (Self.Plane,
Self.Width,
Self.Height);
function new_Face (Vertices : in Geometry.textured.Vertex_array) return Geometry.textured.view
is
use Primitive;
the_Geometry : constant Geometry.textured.view := Geometry.textured.new_Geometry;
the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
the_Indices).all'Access;
begin
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (the_Primitive);
the_Geometry.is_Transparent;
return the_Geometry;
end new_Face;
the_Face : Geometry.textured.view;
begin
declare
the_Vertices : constant Geometry.textured.Vertex_array
:= (1 => (site => the_Sites (1), coords => Self.texture_Coords (1)),
2 => (site => the_Sites (2), coords => Self.texture_Coords (2)),
3 => (site => the_Sites (3), coords => Self.texture_Coords (3)),
4 => (site => the_Sites (4), coords => Self.texture_Coords (4)));
begin
the_Face := new_Face (Vertices => the_Vertices);
if Self.texture_Name /= null_Asset
then
Self.Texture := IO.to_Texture (Self.texture_Name);
end if;
if Self.Lucid
then
if Self.lucid_Image /= null
then
if Self.Texture /= null_Object
then
set_Image (Self.Texture, Self.lucid_Image.all);
else
Self.Texture := openGL.Texture.Forge.to_Texture (Self.lucid_Image.all);
end if;
end if;
else
if Self.Image /= null
then
if Self.Texture /= null_Object
then
Self.Texture.set_Image (Self.Image.all);
else
Self.Texture := openGL.Texture.Forge.to_Texture (Self.Image.all);
end if;
end if;
end if;
if Self.Texture /= null_Object
then
the_Face.Texture_is (Self.Texture);
end if;
end;
return (1 => the_Face.all'Access);
end to_GL_Geometries;
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
is
begin
Self.Texture := Now;
end Texture_is;
function Texture (Self : in Item) return openGL.Texture.Object
is
begin
return Self.Texture;
end Texture;
procedure Texture_Coords_are (Self : in out Item; Now : in Coordinates)
is
begin
Self.texture_Coords := Now;
Self.needs_Rebuild := True;
end Texture_Coords_are;
procedure Size_is (Self : in out Item; Now : in Size_t)
is
begin
Self.Size := Now;
Self.needs_Rebuild := True;
end Size_is;
procedure Image_is (Self : in out Item; Now : in Image)
is
procedure deallocate is new ada.unchecked_Deallocation (Image,
Image_view);
begin
if Self.Image = null
then
Self.Image := new Image' (Now);
elsif Self.Image'Length (1) = Now'Length (1)
and Self.Image'Length (2) = Now'Length (2)
then
Self.Image.all := Now;
else
deallocate (Self.Image);
Self.Image := new Image' (Now);
end if;
Self.needs_Rebuild := True;
end Image_is;
procedure Image_is (Self : in out Item; Now : in lucid_Image)
is
procedure deallocate is new ada.unchecked_Deallocation (lucid_Image,
lucid_Image_view);
begin
if Self.lucid_Image = null
then
Self.lucid_Image := new lucid_Image' (Now);
elsif Self.lucid_Image'Length (1) = Now'Length (1)
and Self.lucid_Image'Length (2) = Now'Length (2)
then
Self.lucid_Image.all := Now;
else
deallocate (Self.lucid_Image);
Self.lucid_Image := new lucid_Image' (Now);
end if;
Self.needs_Rebuild := True;
end Image_is;
end openGL.Model.billboard.textured;
|