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

opengl.geometry: Add multi-texture support to more geometries.

Browse Source
This commit is contained in:
Rod Kay
2023-05-07 11:39:57 +10:00
parent 263f7e8095
commit 8d7f78b74f
13 changed files with 418 additions and 95 deletions
Download Patch File Download Diff File Expand all files Collapse all files

98
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb
View File

@@ -15,6 +15,7 @@ with
Interfaces.C.Strings,
System.storage_Elements;
package body openGL.Geometry.lit_colored_textured
is
use GL.lean,
@@ -273,23 +274,96 @@ is
end Indices_are;
--- Texturing
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level)
is
begin
Self.Textures.Textures (Which).Fade := Now;
end Fade_is;
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level
is
begin
return Self.Textures.Textures (Which).Fade;
end Fade;
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Which => Which,
Now => Now);
end Texture_is;
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
Which => Which);
end Texture;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Now => Now);
end Texture_is;
overriding
function Texture (Self : in Item) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
Which => 1);
end Texture;
overriding
procedure enable_Texture (Self : in out Item)
is
use GL,
GL.Binding,
openGL.Texture;
use openGL.Geometry.texturing;
begin
Tasks.check;
glActiveTexture (gl.GL_TEXTURE0);
Errors.log;
if Self.Texture = openGL.Texture.null_Object
then enable (white_Texture);
else enable (Self.Texture);
end if;
enable (Self.Textures, Self.Program);
end enable_Texture;
-- overriding
-- procedure enable_Texture (Self : in out Item)
-- is
-- use GL,
-- GL.Binding,
-- openGL.Texture;
-- begin
-- Tasks.check;
--
-- glActiveTexture (gl.GL_TEXTURE0);
-- Errors.log;
--
-- if Self.Texture = openGL.Texture.null_Object
-- then enable (white_Texture);
-- else enable (Self.Texture);
-- end if;
-- end enable_Texture;
end openGL.Geometry.lit_colored_textured;

26
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads
View File

@@ -1,3 +1,7 @@
with
openGL.Geometry.texturing;
package openGL.Geometry.lit_colored_textured
--
-- Supports per-vertex site color, texture and lighting.
@@ -35,11 +39,31 @@ is
procedure Indices_are (Self : in out Item; Now : in Indices;
for_Facia : in Positive);
--- Texturing.
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level);
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level;
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object);
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
overriding
function Texture (Self : in Item) return openGL.Texture.Object;
private
type Item is new Geometry.item with null record;
type Item is new Geometry.item with
record
Textures : Geometry.texturing.texture_Set;
end record;
overriding
procedure enable_Texture (Self : in out Item);

86
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb
View File

@@ -8,13 +8,14 @@ with
openGL.Tasks,
openGL.Errors,
GL.Binding,
GL.lean,
GL.Pointers,
Interfaces.C.Strings,
System.storage_Elements;
-- with ada.Text_IO; use ada.Text_IO;
package body openGL.Geometry.lit_textured
is
@@ -82,8 +83,10 @@ is
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/lit_textured.vert");
fragment_Shader.define (Shader.Fragment, "assets/opengl/shader/lit_textured.frag");
fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
2 => to_Asset ("assets/opengl/shader/texturing.frag"),
3 => to_Asset ("assets/opengl/shader/lit_textured.frag"))));
the_Program := new openGL.Program.lit.item;
the_Program.define ( vertex_Shader'Access,
fragment_Shader'Access);
@@ -152,6 +155,7 @@ is
end if;
Self.Program_is (the_Program.all'Access);
return Self;
end new_Geometry;
@@ -245,25 +249,73 @@ is
end Indices_are;
--- Texturing
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level)
is
begin
Self.Textures.Textures (Which).Fade := Now;
end Fade_is;
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level
is
begin
return Self.Textures.Textures (Which).Fade;
end Fade;
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Which => Which,
Now => Now);
end Texture_is;
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
Which => Which);
end Texture;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Now => Now);
end Texture_is;
overriding
function Texture (Self : in Item) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
Which => 1);
end Texture;
overriding
procedure enable_Texture (Self : in out Item)
is
use GL,
GL.Binding,
openGL.Texture;
check_is_OK : constant Boolean := openGL.Tasks.Check; pragma Unreferenced (check_is_OK);
use openGL.Geometry.texturing;
begin
Tasks.check;
glActiveTexture (gl.GL_TEXTURE0);
Errors.log;
if Self.Texture = openGL.Texture.null_Object
then enable (white_Texture);
else enable (Self.Texture);
end if;
enable (Self.Textures, Self.Program);
end enable_Texture;

28
3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads
View File

@@ -1,3 +1,7 @@
with
openGL.Geometry.texturing;
package openGL.Geometry.lit_textured
--
-- Supports per-vertex site texture and lighting.
@@ -38,9 +42,31 @@ is
for_Facia : in Positive);
--- Texturing.
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level);
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level;
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object);
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
overriding
function Texture (Self : in Item) return openGL.Texture.Object;
private
type Item is new Geometry.item with null record;
type Item is new Geometry.item with
record
Textures : Geometry.texturing.texture_Set;
end record;
overriding
procedure enable_Texture (Self : in out Item);

107
3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb
View File

@@ -6,9 +6,6 @@ with
openGL.Attribute,
openGL.Texture,
openGL.Tasks,
openGL.Errors,
GL.Binding,
GL.lean,
GL.Pointers,
@@ -75,9 +72,10 @@ is
begin
white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
vertex_Shader .define (openGL.Shader.vertex, "assets/opengl/shader/textured.vert");
fragment_Shader.define (openGL.Shader.fragment, "assets/opengl/shader/textured.frag");
vertex_Shader .define (Shader.vertex, "assets/opengl/shader/textured.vert");
fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
2 => to_Asset ("assets/opengl/shader/texturing.frag"),
3 => to_Asset ("assets/opengl/shader/textured.frag"))));
the_Program := new openGL.Program.item;
the_Program.define ( vertex_Shader'Access,
@@ -118,6 +116,8 @@ is
end new_Geometry;
--------------
-- Attributes
--
@@ -163,23 +163,94 @@ is
end Indices_are;
--- Texturing
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level)
is
begin
Self.Textures.Textures (Which).Fade := Now;
end Fade_is;
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level
is
begin
return Self.Textures.Textures (Which).Fade;
end Fade;
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Which => Which,
Now => Now);
end Texture_is;
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
Which => Which);
end Texture;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object)
is
use openGL.Geometry.texturing;
begin
Texture_is (in_Set => Self.Textures,
Now => Now);
end Texture_is;
overriding
function Texture (Self : in Item) return openGL.Texture.Object
is
begin
return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
Which => 1);
end Texture;
overriding
procedure enable_Texture (Self : in out Item)
is
use GL,
GL.Binding,
openGL.Texture;
use openGL.Geometry.texturing;
begin
Tasks.check;
glActiveTexture (gl.GL_TEXTURE0);
Errors.log;
if Self.Texture = openGL.Texture.null_Object
then white_Texture.enable;
else Self.Texture .enable;
end if;
enable (Self.Textures, Self.Program);
end enable_Texture;
-- overriding
-- procedure enable_Texture (Self : in out Item)
-- is
-- use GL,
-- GL.Binding,
-- openGL.Texture;
-- begin
-- Tasks.check;
--
-- glActiveTexture (gl.GL_TEXTURE0);
-- Errors.log;
--
-- if Self.Texture = openGL.Texture.null_Object
-- then white_Texture.enable;
-- else Self.Texture .enable;
-- end if;
-- end enable_Texture;
end openGL.Geometry.textured;

28
3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads
View File

@@ -1,3 +1,7 @@
with
openGL.Geometry.texturing;
package openGL.Geometry.textured
--
-- Supports per-vertex site and texture.
@@ -35,9 +39,31 @@ is
for_Facia : in Positive);
--- Texturing.
--
procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level);
function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level;
procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object);
function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object;
overriding
procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object);
overriding
function Texture (Self : in Item) return openGL.Texture.Object;
private
type Item is new Geometry.item with null record;
type Item is new Geometry.item with
record
Textures : Geometry.texturing.texture_Set;
end record;
overriding
procedure enable_Texture (Self : in out Item);

11
3-mid/opengl/source/lean/shader/opengl-shader.adb
View File

@@ -74,6 +74,7 @@ is
is
use GL.Pointers,
C.Strings;
use ada.Text_IO;
use type interfaces.C.char_array;
@@ -84,10 +85,12 @@ is
begin
Tasks.check;
-- for i in the_Source'Range
-- loop
-- put (Character (the_Source (i)));
-- end loop;
new_Line (20);
for i in the_Source'Range
loop
put (Character (the_Source (i)));
end loop;
Self.Kind := Kind;