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 | with
openGL.Tasks,
openGL.Errors,
GL.lean,
GL.Pointers,
ada.Characters.latin_1,
ada.Strings.unbounded,
ada.Text_IO,
ada.IO_Exceptions,
interfaces.C.Strings;
package body openGL.Shader
is
use GL.lean,
Interfaces;
-----------
-- Utility
--
function read_text_File (Filename : in String) return C.char_array;
---------
-- Forge
--
procedure define (Self : in out Item; Kind : in shader.Kind;
source_Filename : in String)
is
use GL.Pointers,
C.Strings;
the_Source : aliased C.char_array := read_text_File (source_Filename);
the_Source_ptr : aliased
constant chars_ptr := to_chars_ptr (the_Source'unchecked_Access);
the_Source_Array : aliased chars_ptr_array := (1 => the_Source_ptr);
begin
Tasks.check;
Self.Kind := Kind;
if Kind = Vertex
then Self.gl_Shader := glCreateShader (GL_VERTEX_SHADER);
else Self.gl_Shader := glCreateShader (GL_FRAGMENT_SHADER);
end if;
Errors.log;
glShaderSource (Self.gl_Shader,
1,
to_GLchar_Pointer_access (the_Source_array'Access),
null);
Errors.log;
glCompileShader (Self.gl_Shader);
Errors.log;
declare
use type C.int;
Status : aliased gl.glInt;
begin
glGetShaderiv (self.gl_Shader,
GL_COMPILE_STATUS,
Status'unchecked_Access);
if Status = 0
then
declare
compile_Log : constant String := Self.shader_info_Log;
begin
Self.destroy;
raise Error with "'" & source_Filename & "' compilation failed ~ " & compile_Log;
end;
end if;
end;
end define;
procedure destroy (Self : in out Item)
is
begin
Tasks.check;
glDeleteShader (self.gl_Shader);
end destroy;
--------------
-- Attributes
--
function shader_info_Log (Self : in Item) return String
is
use C, GL;
info_log_Length : aliased glInt := 0;
chars_Written : aliased glSizei := 0;
begin
Tasks.check;
glGetShaderiv (Self.gl_Shader,
GL_INFO_LOG_LENGTH,
info_log_Length'unchecked_Access);
if info_log_Length = 0
then
return "";
end if;
declare
use gl.Pointers;
info_Log : aliased C.char_array := C.char_array' (1 .. C.size_t (info_log_Length) => <>);
info_Log_ptr : constant C.Strings.chars_Ptr := C.Strings.to_chars_ptr (info_Log'unchecked_Access);
begin
glGetShaderInfoLog (self.gl_Shader,
glSizei (info_log_Length),
chars_Written'unchecked_Access,
to_GLchar_access (info_Log_ptr));
return C.to_Ada (info_Log);
end;
end shader_info_Log;
----------
-- Privvy
--
function gl_Shader (Self : in Item) return a_gl_Shader
is
begin
return Self.gl_Shader;
end gl_Shader;
-----------
-- Utility
--
NL : constant String := "" & ada.characters.latin_1.LF;
function read_text_File (Filename : in String) return C.char_array
is
use ada.Text_IO,
ada.Strings.unbounded;
the_File : ada.Text_IO.File_type;
Pad : unbounded_String;
begin
open (the_File, in_File, Filename);
while not end_of_File (the_File)
loop
append (Pad, get_Line (the_File) & NL);
end loop;
close (the_File);
declare
use type Interfaces.C.size_t;
the_Data : C.char_array (1 .. C.size_t (Length (Pad)) + 1);
begin
for i in 1 .. the_Data'Last - 1
loop
the_Data (i) := C.char (Element (Pad, Integer (i)));
end loop;
the_Data (the_Data'Last) := C.char'Val (0);
return the_Data;
end;
exception
when ada.IO_Exceptions.name_Error =>
raise Error with "Unable to locate shader asset named '" & Filename & "'.";
end read_text_File;
end openGL.Shader;
|