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

opengl.demos: Update code to use new openGL updates.

Browse Source
This commit is contained in:
Rod Kay
2025-09-15 11:07:24 +10:00
parent 52376f5b0a
commit 242b2d7828
25 changed files with 134 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb
View File

@@ -60,17 +60,20 @@ is
use type GLint;
begin
for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count)
loop
Uniforms.Textures (i).fade_Uniform .Value_is (Real (for_Model.Fade (Which => i)));
Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (Which => i));
if for_Model.texture_Count > 0
then
for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count)
loop
Uniforms.Textures (i).fade_Uniform .Value_is (Real (for_Model.Fade (Which => i)));
Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (Which => i));
glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable,
GLint (i) - 1);
glActiveTexture (all_texture_Units (i));
glBindTexture (GL_TEXTURE_2D,
texture_Set.Textures (i).Object.Name);
end loop;
glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable,
GLint (i) - 1);
glActiveTexture (all_texture_Units (i));
glBindTexture (GL_TEXTURE_2D,
texture_Set.Textures (i).Object.Name);
end loop;
end if;
Uniforms.Count.Value_is (for_Model.texture_Count);
end enable;

6
3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.adb
View File

@@ -14,7 +14,8 @@ is
function new_Billboard (Size : in Size_t := default_Size;
Plane : in billboard.Plane;
Color : in lucid_Color;
Texture : in asset_Name) return View
Texture : in asset_Name;
texture_Details : in texture_Set.Details) return View
is
Self : constant View := new Item;
begin
@@ -23,6 +24,7 @@ is
Self.Plane := Plane;
Self.Color := Color;
Self.Texture_Name := Texture;
Self.texture_Details_is (texture_Details);
return Self;
end new_Billboard;
@@ -58,6 +60,7 @@ is
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);
the_Geometry.is_Transparent;
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Face;
@@ -90,6 +93,7 @@ is
Self.Geometry := the_Face;
return [1 => Geometry.view (the_Face)];
end to_GL_Geometries;

13
3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.ads
View File

@@ -1,6 +1,7 @@
with
openGL.Geometry.colored_textured,
openGL.Texture,
openGL.Model.texturing,
openGL.Font,
openGL.Palette;
@@ -10,7 +11,11 @@ package openGL.Model.billboard.colored_textured
-- Models a colored, textured billboard.
--
is
type Item is new Model.billboard.item with private;
package textured_Model is new texturing.Mixin (openGL.Model.billboard.item);
type Item is new textured_Model.textured_item with private;
-- type Item is new Model.billboard.item with private;
type View is access all Item'Class;
@@ -21,7 +26,8 @@ is
function new_Billboard (Size : in Size_t := default_Size;
Plane : in billboard.Plane;
Color : in lucid_Color;
Texture : in asset_Name) return View;
Texture : in asset_Name;
texture_Details : in texture_Set.Details) return View;
--------------
--- Attributes
@@ -44,7 +50,8 @@ is
private
type Item is new Model.billboard.item with
type Item is new textured_Model.textured_item with
-- type Item is new Model.billboard.item with
record
Color : lucid_Color := (Palette.White, Opaque);

1
3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured.adb
View File

@@ -53,6 +53,7 @@ is
begin
the_Geometry.Vertices_are (Vertices.all);
the_Geometry.add (the_Primitive);
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Face;

9
3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured.ads
View File

@@ -1,6 +1,7 @@
with
openGL.Geometry,
openGL.Font,
openGL.Model.texturing,
openGL.Texture;
@@ -12,7 +13,10 @@ package openGL.Model.Box.lit_colored_textured
-- Each face may have a separate texture.
--
is
type Item is new Model.box.item with private;
package textured_Model is new texturing.Mixin (openGL.Model.box.item);
-- type Item is new Model.box.item with private;
type Item is new textured_Model.textured_item with private;
type View is access all Item'Class;
@@ -44,7 +48,8 @@ is
private
type Item is new Model.box.item with
-- type Item is new Model.box.item with
type Item is new textured_Model.textured_item with
record
Faces : lit_colored_textured.Faces;
end record;

1
3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured_x1.adb
View File

@@ -90,6 +90,7 @@ is
the_Primitive : constant Primitive.view := Primitive.indexed .new_Primitive (Triangles, the_Indices).all'Access;
begin
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.Vertices_are (the_Vertices);
the_Geometry.add (the_Primitive);

9
3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured_x1.ads
View File

@@ -1,6 +1,7 @@
with
openGL.Geometry,
openGL.Font,
openGL.Model.texturing,
openGL.Texture;
@@ -12,7 +13,10 @@ package openGL.Model.Box.lit_colored_textured_x1
-- All faces use the same texture.
--
is
type Item is new Model.box.item with private;
package textured_Model is new texturing.Mixin (openGL.Model.box.item);
-- type Item is new Model.box.item with private;
type Item is new textured_Model.textured_item with private;
type View is access all Item'Class;
@@ -44,7 +48,8 @@ is
private
type Item is new Model.box.item with
-- type Item is new Model.box.item with
type Item is new textured_Model.textured_item with
record
Faces : lit_colored_textured_x1.Faces;
texture_Name : asset_Name := null_Asset; -- The texture applied to all faces.

7
3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.adb
View File

@@ -9,9 +9,10 @@ is
--- Forge
--
function new_Box (Size : in Vector_3;
Faces : in lit_textured.Faces;
texture_Details : in texture_Set.Details) return View
function new_Box (Size : in Vector_3;
Faces : in lit_textured.Faces;
texture_Details : in texture_Set.Details := texture_Set.no_Details) return View
is
Self : constant View := new Item;
begin

9
3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.ads
View File

@@ -1,7 +1,8 @@
with
openGL.Geometry,
openGL.Font,
openGL.Model.texturing;
openGL.Model.texturing,
openGL.texture_Set;
package openGL.Model.Box.lit_textured
@@ -30,9 +31,9 @@ is
--- Forge
--
function new_Box (Size : in Vector_3;
Faces : in lit_textured.Faces;
texture_Details : in texture_Set.Details) return View;
function new_Box (Size : in Vector_3;
Faces : in lit_textured.Faces;
texture_Details : in texture_Set.Details := texture_Set.no_Details) return View;
--------------

4
3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored_textured.adb
View File

@@ -197,6 +197,8 @@ is
begin
the_shaft_Geometry.add (Primitive.view (the_Primitive));
end;
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
end;
@@ -395,6 +397,8 @@ is
end;
end;
cap_Geometry.Model_is (Self.all'unchecked_Access);
return cap_Geometry;
end new_Cap;

12
3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored_textured.ads
View File

@@ -1,5 +1,6 @@
with
openGL.Geometry;
openGL.Geometry,
openGL.Model.texturing;
package openGL.Model.capsule.lit_colored_textured
@@ -7,7 +8,10 @@ package openGL.Model.capsule.lit_colored_textured
-- Models a lit, colored and textured capsule.
--
is
type Item is new Model.capsule.item with private;
package textured_Model is new texturing.Mixin (openGL.Model.capsule.item);
-- type Item is new Model.capsule.item with private;
type Item is new textured_Model.textured_item with private;
type View is access all Item'Class;
@@ -32,7 +36,9 @@ is
private
type Item is new Model.capsule.item with
-- type Item is new Model.capsule.item with
type Item is new textured_Model.textured_item with
record
Radius : Real;
Height : Real;

2
3-mid/opengl/source/lean/model/opengl-model-terrain.adb
View File

@@ -19,7 +19,7 @@ is
Row, Col : in Integer;
Heights : in height_Map_view;
color_Map : in asset_Name;
texture_Details : in texture_Set.Details;
texture_Details : in texture_Set.Details := texture_Set.no_Details;
Tiling : in texture_Transform_2d := (S => (0.0, 1.0),
T => (0.0, 1.0))) return View
is

7
3-mid/opengl/source/lean/model/opengl-model-terrain.ads
View File

@@ -1,6 +1,7 @@
with
openGL.Geometry,
openGL.Model.texturing;
openGL.Model.texturing,
openGL.texture_Set;
package openGL.Model.terrain
@@ -25,9 +26,9 @@ is
Row, Col : in Integer;
Heights : in height_Map_view;
color_Map : in asset_Name;
texture_Details : in texture_Set.Details;
texture_Details : in texture_Set.Details := texture_Set.no_Details;
Tiling : in texture_Transform_2d := (S => (0.0, 1.0),
T => (0.0, 1.0))) return View;
T => (0.0, 1.0))) return View;
overriding
procedure destroy (Self : in out Item);

3
3-mid/opengl/source/lean/opengl-terrain.adb
View File

@@ -1,10 +1,12 @@
with
openGL.Model.Terrain,
openGL.IO,
openGL.texture_Set,
ada.unchecked_Deallocation,
ada.unchecked_Conversion;
package body openGL.Terrain
is
type Heightmap_view is access all height_Map;
@@ -121,6 +123,7 @@ is
Col => Col,
Heights => the_Region.all'Access,
color_Map => texture_File,
texture_Details => texture_Set.to_Details ([1 => texture_File]),
Tiling => Tiling);
the_height_Extents : constant Vector_2 := height_Extent (the_Region.all);

7
3-mid/opengl/source/lean/opengl-texture_set.ads
View File

@@ -111,7 +111,7 @@ is
function to_Details (texture_Assets : in asset_Names;
Animation : in Animation_view := null) return Details;
no_Details : constant Details;
@@ -142,6 +142,8 @@ is
private
-----------
--- Streams
--
@@ -156,4 +158,7 @@ private
for Animation_view'read use read;
no_Details : constant Details := (others => <>);
end openGL.texture_Set;