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
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367 | -- SPDX-License-Identifier: Apache-2.0
--
-- Copyright (c) 2017 onox <denkpadje@gmail.com>
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
with Ada.Characters.Latin_1;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Unchecked_Conversion;
with GL.Pixels.Extensions;
package body Orka.KTX is
use Ada.Streams;
type Four_Bytes_Array is array (Positive range 1 .. 4) of Stream_Element
with Size => 32, Pack;
function Convert_Size is new Ada.Unchecked_Conversion
(Source => Four_Bytes_Array, Target => Unsigned_32);
type Header_Array is array (Positive range 1 .. 13 * 4) of Stream_Element
with Size => 32 * 13, Pack;
type Internal_Header is record
Endianness : Unsigned_32;
Data_Type : Unsigned_32;
Type_Size : Unsigned_32;
Format : Unsigned_32;
Internal_Format : Unsigned_32;
Base_Internal_Format : Unsigned_32;
Width : Unsigned_32;
Height : Unsigned_32;
Depth : Unsigned_32;
Array_Elements : Unsigned_32;
Faces : Unsigned_32;
Mipmap_Levels : Unsigned_32;
Bytes_Key_Value_Data : Unsigned_32;
end record
with Size => 32 * 13, Pack;
Identifier : constant Resources.Byte_Array
:= (16#AB#, 16#4B#, 16#54#, 16#58#, 16#20#, 16#31#,
16#31#, 16#BB#, 16#0D#, 16#0A#, 16#1A#, 16#0A#);
Endianness_Reference : constant := 16#04030201#;
function Valid_Identifier (Bytes : Bytes_Reference) return Boolean is
(Identifier = Bytes (Bytes.Value'First .. Bytes.Value'First + Identifier'Length - 1));
function Get_Header (Bytes : Bytes_Reference) return Header is
function Convert is new Ada.Unchecked_Conversion
(Source => Header_Array, Target => Internal_Header);
function Convert_To_Data_Type is new Ada.Unchecked_Conversion
(Source => Unsigned_32, Target => GL.Pixels.Data_Type);
function Convert_To_Format is new Ada.Unchecked_Conversion
(Source => Unsigned_32, Target => GL.Pixels.Format);
function Convert_To_Internal_Format is new Ada.Unchecked_Conversion
(Source => Unsigned_32, Target => GL.Pixels.Internal_Format);
function Convert_To_Compressed_Format is new Ada.Unchecked_Conversion
(Source => Unsigned_32, Target => GL.Pixels.Compressed_Format);
Offset : constant Stream_Element_Offset := Bytes.Value'First + Identifier'Length;
File_Header : constant Internal_Header := Convert (Header_Array
(Bytes (Offset .. Offset + Header_Array'Length - 1)));
Compressed : constant Boolean := File_Header.Data_Type = 0;
begin
pragma Assert (File_Header.Endianness = Endianness_Reference);
-- Endianness conversion is not supported in the code
if Compressed then
pragma Assert (File_Header.Type_Size in 0 | 1);
-- Compressed textures should have a Type_Size = 1, but some files
-- set this to 0
else
pragma Assert (File_Header.Type_Size in 1 | 2 | 4);
end if;
return Result : Header (Compressed) do
pragma Assert (File_Header.Width > 0);
if File_Header.Depth > 0 then
pragma Assert (File_Header.Height > 0);
end if;
-- Set dimensions of a single texture
Result.Width := Size (File_Header.Width);
Result.Height := Size (File_Header.Height);
Result.Depth := Size (File_Header.Depth);
-- Set texture kind based on faces, array elements, and dimensions
if File_Header.Faces = 6 then
pragma Assert (File_Header.Width = File_Header.Height);
pragma Assert (File_Header.Depth = 0);
if File_Header.Array_Elements > 0 then
Result.Kind := Texture_Cube_Map_Array;
else
Result.Kind := Texture_Cube_Map;
end if;
else
if File_Header.Array_Elements > 0 then
if File_Header.Depth > 0 then
raise Constraint_Error with "OpenGL does not support 3D texture arrays";
elsif File_Header.Height > 0 then
Result.Kind := Texture_2D_Array;
else
Result.Kind := Texture_1D_Array;
end if;
else
if File_Header.Depth > 0 then
Result.Kind := Texture_3D;
elsif File_Header.Height > 0 then
Result.Kind := Texture_2D;
else
Result.Kind := Texture_1D;
end if;
end if;
end if;
Result.Array_Elements := Size (File_Header.Array_Elements);
Result.Mipmap_Levels := Size (File_Header.Mipmap_Levels);
-- If mipmap levels is 0, then client should generate full
-- mipmap pyramid
Result.Bytes_Key_Value := Size (File_Header.Bytes_Key_Value_Data);
if Compressed then
pragma Assert (File_Header.Format = 0);
pragma Assert (File_Header.Type_Size in 0 | 1);
pragma Assert (File_Header.Mipmap_Levels > 0);
-- Format / Internal format
begin
Result.Compressed_Format
:= Convert_To_Compressed_Format (File_Header.Internal_Format);
exception
when Constraint_Error =>
raise Invalid_Enum_Error with
"invalid internal format (" & File_Header.Internal_Format'Image & ")";
end;
else
-- Data type
begin
Result.Data_Type := Convert_To_Data_Type (File_Header.Data_Type);
exception
when Constraint_Error =>
raise Invalid_Enum_Error with
"invalid data type (" & File_Header.Data_Type'Image & ")";
end;
-- Format
begin
Result.Format := Convert_To_Format (File_Header.Format);
exception
when Constraint_Error =>
raise Invalid_Enum_Error with
"invalid format (" & File_Header.Format'Image & ")";
end;
-- Internal format
begin
Result.Internal_Format
:= Convert_To_Internal_Format (File_Header.Internal_Format);
exception
when Constraint_Error =>
raise Invalid_Enum_Error with
"invalid internal format (" & File_Header.Internal_Format'Image & ")";
end;
end if;
end return;
end Get_Header;
function Get_Key_Value_Map
(Bytes : Bytes_Reference;
Length : Size) return KTX.String_Maps.Map
is
Result : KTX.String_Maps.Map;
Non_Header_Index : constant Stream_Element_Offset := Get_Data_Offset (Bytes, 0);
Data_Index : constant Stream_Element_Offset
:= Non_Header_Index + Stream_Element_Offset (Length);
pragma Assert (Data_Index <= Bytes.Value'Last);
Bytes_Remaining : Natural := Natural (Length);
Pair_Index : Stream_Element_Offset := Non_Header_Index;
begin
while Bytes_Remaining > 0 loop
declare
Key_Value_Size : constant Natural := Get_Length (Bytes, Pair_Index);
Padding_Size : constant Natural := 3 - ((Key_Value_Size + 3) mod 4);
Pair_Size : constant Natural := 4 + Key_Value_Size + Padding_Size;
pragma Assert (Pair_Size <= Bytes_Remaining);
type Key_Value_Array is array (Positive range 1 .. Key_Value_Size) of Stream_Element
with Pack;
type Character_Array is array (Positive range 1 .. Key_Value_Size) of Character
with Pack;
function Convert_Pair is new Ada.Unchecked_Conversion
(Source => Key_Value_Array, Target => Character_Array);
Key_Value_Pair : constant Key_Value_Array := Key_Value_Array (Bytes
(Pair_Index + 4 .. Pair_Index + 4 + Stream_Element_Offset (Key_Value_Size) - 1));
Key_Value : constant String := String (Convert_Pair (Key_Value_Pair));
Position_NUL : constant Natural := Ada.Strings.Fixed.Index
(Key_Value, Ada.Strings.Maps.To_Set (Ada.Characters.Latin_1.NUL));
pragma Assert (Position_NUL > 0);
begin
-- Extract key and value here
declare
Key : constant String := Key_Value (1 .. Position_NUL - 1);
Value : constant String := Key_Value (Position_NUL + 1 .. Key_Value'Last);
begin
Result.Insert (Key, Value);
end;
Bytes_Remaining := Bytes_Remaining - Pair_Size;
Pair_Index := Pair_Index + Stream_Element_Offset (Pair_Size);
end;
end loop;
pragma Assert (Pair_Index = Data_Index);
return Result;
end Get_Key_Value_Map;
function Get_Length
(Bytes : Bytes_Reference;
Offset : Stream_Element_Offset) return Natural
is
Size_Bytes : constant Four_Bytes_Array := Four_Bytes_Array
(Bytes (Offset .. Offset + 4 - 1));
begin
return Natural (Convert_Size (Size_Bytes));
end Get_Length;
function Get_Data_Offset
(Bytes : Bytes_Reference;
Bytes_Key_Value : Size) return Stream_Element_Offset
is (Bytes.Value'First + Identifier'Length + Header_Array'Length
+ Stream_Element_Offset (Bytes_Key_Value));
function Create_KTX_Bytes
(KTX_Header : Header;
Get_Data : not null access function (Level : GL.Objects.Textures.Mipmap_Level)
return Resources.Byte_Array_Pointers.Pointer)
return Resources.Byte_Array_Pointers.Pointer
is
function Convert is new Ada.Unchecked_Conversion
(Source => Internal_Header, Target => Header_Array);
function Convert is new Ada.Unchecked_Conversion
(Source => Unsigned_32, Target => Four_Bytes_Array);
function Convert is new Ada.Unchecked_Conversion
(Source => GL.Pixels.Data_Type, Target => Unsigned_32);
function Convert is new Ada.Unchecked_Conversion
(Source => GL.Pixels.Format, Target => Unsigned_32);
function Convert is new Ada.Unchecked_Conversion
(Source => GL.Pixels.Internal_Format, Target => Unsigned_32);
function Convert is new Ada.Unchecked_Conversion
(Source => GL.Pixels.Compressed_Format, Target => Unsigned_32);
package PE renames GL.Pixels.Extensions;
Compressed : Boolean renames KTX_Header.Compressed;
Type_Size : constant Size
:= (if Compressed then 1 else PE.Bytes (KTX_Header.Data_Type));
Faces : constant Unsigned_32
:= (if KTX_Header.Kind in Texture_Cube_Map | Texture_Cube_Map_Array then 6 else 1);
File_Header : constant Internal_Header
:= (Endianness => Endianness_Reference,
Data_Type => (if Compressed then 0 else Convert (KTX_Header.Data_Type)),
Type_Size => Unsigned_32 (if Compressed then 1 else Type_Size),
Format => (if Compressed then 0 else Convert (KTX_Header.Format)),
Internal_Format =>
(if Compressed then
Convert (KTX_Header.Compressed_Format)
else
Convert (KTX_Header.Internal_Format)),
Base_Internal_Format =>
(if Compressed then
Convert (KTX_Header.Compressed_Format)
else
Convert (KTX_Header.Format)),
Width => Unsigned_32 (KTX_Header.Width),
Height => Unsigned_32 (KTX_Header.Height),
Depth => Unsigned_32 (if Faces = 6 then 0 else KTX_Header.Depth),
Array_Elements => Unsigned_32 (KTX_Header.Array_Elements),
Faces => Faces,
Mipmap_Levels => Unsigned_32 (KTX_Header.Mipmap_Levels),
Bytes_Key_Value_Data => 0);
-- TODO Support key value map?
Pointer : Resources.Byte_Array_Pointers.Pointer;
--------------------------------------------------------------------------
Data : array (0 .. KTX_Header.Mipmap_Levels - 1) of Resources.Byte_Array_Pointers.Pointer;
Total_Size : Stream_Element_Offset := 0;
begin
for Level in Data'Range loop
Data (Level) := Get_Data (Level);
Total_Size := Total_Size + Data (Level).Get.Value'Length;
end loop;
Total_Size := Total_Size + 4 * Data'Length;
pragma Assert (if not Compressed then
(for all Pointer of Data => Pointer.Get.Value'Length mod 4 = 0));
-- Data must be a multiple of 4 bytes because of the requirement
-- of GL.Pixels.Unpack_Alignment = Words (= 4)
-- Note: assertion is not precise because length of a row might
-- not be a multiple of 4 bytes
-- Note: Cube padding and mipmap padding can be assumed to be 0
declare
Result : constant not null Resources.Byte_Array_Access := new Resources.Byte_Array
(1 .. Identifier'Length + Header_Array'Length + Total_Size);
Header_Offset : constant Stream_Element_Offset := Result'First + Identifier'Length;
Size_Offset : Stream_Element_Offset := Header_Offset + Header_Array'Length;
begin
Result (Result'First .. Header_Offset - 1) := Identifier;
Result (Header_Offset .. Size_Offset - 1) := Stream_Element_Array (Convert (File_Header));
for Level_Data of Data loop
declare
Image_Size : constant Unsigned_32
:= (if KTX_Header.Kind = Texture_Cube_Map then
Level_Data.Get.Value'Length / 6
else
Level_Data.Get.Value'Length);
Data_Offset : constant Stream_Element_Offset := Size_Offset + 4;
Next_Offset : constant Stream_Element_Offset
:= Data_Offset + Level_Data.Get.Value'Length;
begin
Result (Size_Offset .. Data_Offset - 1)
:= Stream_Element_Array (Convert (Image_Size));
Result (Data_Offset .. Next_Offset - 1)
:= Level_Data.Get;
Size_Offset := Next_Offset;
end;
end loop;
Pointer.Set (Result);
return Pointer;
end;
end Create_KTX_Bytes;
end Orka.KTX;
|