nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add initial prototype.

Browse Source
This commit is contained in:
Rod Kay
2022-07-31 17:34:54 +10:00
commit 54a53b2ac0
1421 changed files with 358874 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

107
3-mid/opengl/source/lean/buffer/opengl-buffer-general.adb Normal file
View File

@@ -0,0 +1,107 @@
with
openGL.Errors,
openGL.Tasks,
GL.Pointers;
package body openGL.Buffer.general
is
--------------------------
-- 'vertex buffer' Object
--
package body Forge
is
function to_Buffer (From : access constant Element_Array;
Usage : in Buffer.Usage) return Object
is
use GL.Pointers;
begin
Tasks.check;
return new_Buffer : Object
do
new_Buffer.Usage := Usage;
new_Buffer.Length := From'Length;
new_Buffer.verify_Name;
new_Buffer.enable;
glBufferData (to_GL_Enum (new_Buffer.Kind),
From.all'Size / 8,
+From (From'First)'Address,
to_GL_Enum (Usage));
Errors.log;
end return;
end to_Buffer;
function to_Buffer (From : in Element_Array;
Usage : in Buffer.Usage) return Object
is
use GL.Pointers;
begin
Tasks.check;
return new_Buffer : Object
do
new_Buffer.Usage := Usage;
new_Buffer.Length := From'Length;
new_Buffer.verify_Name;
new_Buffer.enable;
glBufferData (to_GL_Enum (new_Buffer.Kind),
From'Size / 8,
+From (From'First)'Address,
to_GL_Enum (Usage));
end return;
end to_Buffer;
end Forge;
procedure set (Self : in out Object; Position : in Positive := 1;
To : in Element_Array)
is
use GL.Pointers;
new_Vertices : aliased Element_Array := To;
Vertex_Size_in_bits : constant Natural := To (To'First)'Size;
begin
Tasks.check;
if Self.Length = To'Length
then
Self.enable;
glBufferSubData (Target => to_GL_Enum (Self.Kind),
Offset => GLintptr ((Position - 1) * Vertex_Size_in_bits / 8),
Size => new_Vertices'Size / 8,
Data => +new_Vertices (new_Vertices'First)'Address);
else
Self.destroy;
Self.verify_Name;
Self.Length := To'Length;
Self.enable;
glBufferData (to_GL_Enum (Self.Kind),
To'Size / 8,
+To (To'First)'Address,
to_GL_Enum (Self.Usage));
end if;
Errors.log;
end set;
procedure set (Self : in out Object; Position : in Positive := 1;
To : access constant Element_Array)
is
begin
Self.set (Position, To.all);
end set;
end openGL.Buffer.general;

53
3-mid/opengl/source/lean/buffer/opengl-buffer-general.ads Normal file
View File

@@ -0,0 +1,53 @@
generic
type base_Object is new openGL.Buffer.Object with private;
type Index is range <>;
type Element is private;
type Element_Array is array (Index range <>) of Element;
package openGL.Buffer.general
--
-- A generic for producing various types of openGL vertex buffer objects.
--
is
type Object is new base_Object with private;
type View is access all Object'Class;
---------
-- Forge
--
package Forge
is
function to_Buffer (From : access constant Element_Array;
Usage : in Buffer.Usage) return Object;
function to_Buffer (From : in Element_Array;
Usage : in Buffer.Usage) return Object;
end Forge;
--------------
-- Operations
--
procedure set (Self : in out Object; Position : in Positive := 1;
To : in Element_Array);
procedure set (Self : in out Object; Position : in Positive := 1;
To : access constant Element_Array);
private
type Object is new base_Object with
record
Usage : Buffer.Usage;
end record;
default_Terminator : Element; -- No 'Interfaces.C.Pointers' subprogram is called which uses the default terminator, so
-- a default 'Element' should suffice.
end openGL.Buffer.general;

7
3-mid/opengl/source/lean/buffer/opengl-buffer-indices.ads Normal file
View File

@@ -0,0 +1,7 @@
with
openGL.Buffer.general;
package openGL.Buffer.indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object,
Index => long_Index_t,
Element => Index_t,
Element_Array => Indices);

7
3-mid/opengl/source/lean/buffer/opengl-buffer-long_indices.ads Normal file
View File

@@ -0,0 +1,7 @@
with
openGL.Buffer.general;
package openGL.Buffer.long_indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object,
Index => long_Index_t,
Element => long_Index_t,
Element_Array => long_Indices);

7
3-mid/opengl/source/lean/buffer/opengl-buffer-normals.ads Normal file
View File

@@ -0,0 +1,7 @@
with
openGL.Buffer.general;
package openGL.Buffer.normals is new openGL.Buffer.general (base_Object => Buffer.array_Object,
Index => Index_t,
Element => Normal,
Element_Array => Normals);

7
3-mid/opengl/source/lean/buffer/opengl-buffer-short_indices.ads Normal file
View File

@@ -0,0 +1,7 @@
with
openGL.Buffer.general;
package openGL.Buffer.short_indices is new openGL.Buffer.general (base_Object => Buffer.element_array_Object,
Index => long_Index_t,
Element => short_Index_t,
Element_Array => short_Indices);

7
3-mid/opengl/source/lean/buffer/opengl-buffer-texture_coords.ads Normal file
View File

@@ -0,0 +1,7 @@
with
openGL.Buffer.general;
package openGL.Buffer.texture_coords is new openGL.Buffer.general (base_Object => Buffer.array_Object,
Index => Index_t,
Element => Coordinate_2D,
Element_Array => Coordinates_2D);

7
3-mid/opengl/source/lean/buffer/opengl-buffer-vertex.ads Normal file
View File

@@ -0,0 +1,7 @@
with
openGL.Buffer.general;
package openGL.Buffer.vertex is new openGL.Buffer.general (base_Object => Buffer.array_Object,
Index => Index_t,
Element => Site,
Element_Array => Sites);

134
3-mid/opengl/source/lean/buffer/opengl-buffer.adb Normal file
View File

@@ -0,0 +1,134 @@
with
openGL.Errors,
openGL.Tasks,
ada.unchecked_Deallocation;
package body openGL.Buffer
is
use type a_Name;
---------------
-- Buffer Name
--
function new_vbo_Name return a_Name
is
Name : aliased a_Name;
begin
Tasks.check;
glGenBuffers (1, Name'unchecked_Access);
return Name;
end new_vbo_Name;
procedure free (vbo_Name : in a_Name)
is
Name : aliased a_Name := vbo_Name;
begin
Tasks.check;
glDeleteBuffers (1, Name'unchecked_Access);
end free;
pragma Unreferenced (free);
----------
-- Object
--
procedure verify_Name (Self : in out Object'Class)
is
begin
if Self.Name = 0 then
Self.Name := new_vbo_Name;
end if;
end verify_Name;
function Name (Self : in Object) return Buffer.a_Name
is
begin
return Self.Name;
end Name;
procedure enable (Self : in Object'Class)
is
pragma assert (Self.Name > 0);
begin
Tasks.check;
glBindBuffer (to_GL_Enum (Self.Kind),
Self.Name);
openGL.Errors.log;
end enable;
procedure destroy (Self : in out Object'Class)
is
begin
Tasks.check;
glBindBuffer (to_GL_Enum (Self.Kind), 0);
openGL.Errors.log;
glDeleteBuffers (1, Self.Name'Access);
openGL.Errors.log;
Self.Name := 0;
end destroy;
procedure free (Self : in out View)
is
procedure deallocate is new ada.unchecked_Deallocation (Buffer.Object'Class,
Buffer.view);
begin
if Self /= null
then
Self.destroy;
deallocate (Self);
end if;
end free;
function Length (Self : in Object) return Positive
is
begin
return Self.Length;
end Length;
-------------------------
-- 'array' Buffer Object
--
overriding
function Kind (Self : in array_Object) return Buffer.a_Kind
is
pragma Unreferenced (Self);
begin
return array_Buffer;
end Kind;
---------------------------------
-- 'element array' Buffer object
--
overriding
function Kind (Self : in element_array_Object) return Buffer.a_Kind
is
pragma Unreferenced (Self);
begin
return element_array_Buffer;
end Kind;
end openGL.Buffer;

124
3-mid/opengl/source/lean/buffer/opengl-buffer.ads Normal file
View File

@@ -0,0 +1,124 @@
private
with
GL.lean,
ada.unchecked_Conversion;
package openGL.Buffer
--
-- Models a buffer object.
--
is
--------------
--- Core Types
--
subtype a_Name is GL.GLuint; -- An openGL vertex buffer 'Name', which is a natural integer.
type a_Kind is (array_Buffer, element_array_Buffer);
type Usage is (stream_Draw, static_Draw, dynamic_Draw);
-----------------
-- Buffer Object
--
type Object is abstract tagged limited private;
type View is access all Object'Class;
procedure destroy (Self : in out Object'Class);
procedure free (Self : in out View);
--------------
-- Attributes
--
function Name (Self : in Object) return Buffer.a_Name;
function Kind (Self : in Object) return Buffer.a_Kind is abstract;
function Length (Self : in Object) return Positive;
--------------
-- Operations
--
procedure enable (Self : in Object'Class);
-----------------------------------------------
-- Derived 'array' and 'element array' Classes
--
type array_Object is new Object with private;
type element_array_Object is new Object with private;
--
-- Refer to child packages, for specific buffers:
--
-- - gl.Buffer.vertex
-- - gl.Buffer.texture_coords
-- - gl.Buffer.normals
-- - gl.Buffer.indices
--
-- (TODO: pixel pack/unpack buffers)
----------
-- Errors
--
no_platform_Support : exception;
--
-- Raised by buffer 'Map' functions when OS platform does not
-- support GL Buffer objects.
private
use GL.lean;
-- Buffer Kinds
--
for a_Kind use (array_Buffer => GL_ARRAY_BUFFER,
element_array_Buffer => GL_ELEMENT_ARRAY_BUFFER);
for a_Kind'Size use gl.GLenum'Size;
function to_GL_Enum is new ada.unchecked_Conversion (a_Kind, gl.GLenum);
-- Usage
--
for Usage use (stream_Draw => GL_STREAM_DRAW,
static_Draw => GL_STATIC_DRAW,
dynamic_Draw => GL_DYNAMIC_DRAW);
for Usage'Size use GL.GLenum'Size;
function to_GL_Enum is new ada.unchecked_Conversion (Usage, gl.GLenum);
----------
-- Object
--
type Object is abstract tagged limited
record
Name : aliased Buffer.a_Name := 0;
Length : Positive;
end record;
overriding
function Kind (Self : in array_Object) return Buffer.a_Kind;
overriding
function Kind (Self : in element_array_Object) return Buffer.a_Kind;
type array_Object is new Object with null record;
type element_array_Object is new Object with null record;
-- Support
--
procedure verify_Name (Self : in out Object'Class);
end openGL.Buffer;