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

This commit is contained in:
Rod Kay
2025-09-14 10:11:21 +10:00
parent d357ce109b
commit 5afee0e2e4
41 changed files with 677 additions and 347 deletions

View File

@@ -1,7 +1,7 @@
with
openGL.texture_Set;
private
-- private
with
openGL.Geometry.texturing;
@@ -11,7 +11,11 @@ package openGL.Geometry.lit_colored_textured
-- Supports 'per-vertex' site, color, texture and lighting.
--
is
type Item is new openGL.Geometry.item with private;
package textured_Geometry is new texturing.Mixin;
-- type Item is new openGL.Geometry.item with private;
type Item is new textured_Geometry.item with private;
type View is access all Item'Class;
function new_Geometry (texture_is_Alpha : in Boolean) return access Geometry.lit_colored_textured.item'Class;
@@ -65,9 +69,6 @@ is
private
package textured_Geometry is new texturing.Mixin;
type Item is new textured_Geometry.item with
record
null;

View File

@@ -8,7 +8,7 @@ with
openGL.Model;
private
-- private
package openGL.Geometry.texturing
--
-- Provides texturing support for geometries.

View File

@@ -13,6 +13,7 @@ is
function new_Capsule (Radius : in Real;
Height : in Real;
texture_Details : in texture_Set.Details;
Image : in asset_Name := null_Asset) return View
is
Self : constant View := new Item;
@@ -21,6 +22,8 @@ is
Self.Height := Height;
Self.Image := Image;
Self.texture_Details_is (texture_Details);
return Self;
end new_Capsule;
@@ -368,6 +371,10 @@ is
cap_2_Geometry := new_Cap (is_Fore => False);
end;
the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
cap_1_Geometry .Model_is (Self.all'unchecked_Access);
cap_2_Geometry .Model_is (Self.all'unchecked_Access);
return (1 => the_shaft_Geometry.all'Access,
2 => cap_1_Geometry.all'Access,
3 => cap_2_Geometry.all'Access);

View File

@@ -1,5 +1,6 @@
with
openGL.Geometry;
openGL.Geometry,
openGL.Model.texturing;
package openGL.Model.capsule.textured
@@ -7,8 +8,10 @@ package openGL.Model.capsule.textured
-- Models a textured capsule.
--
is
type Item is new Model.capsule.item with private;
type View is access all Item'Class;
-- type Item is new Model.capsule.item with private;
package textured_Model is new texturing.Mixin (openGL.Model.capsule.item);
type Item is new textured_Model.textured_item with private; type View is access all Item'Class;
---------
@@ -17,6 +20,7 @@ is
function new_Capsule (Radius : in Real;
Height : in Real;
texture_Details : in texture_Set.Details;
Image : in asset_Name := null_Asset) return View;
--------------
@@ -31,7 +35,8 @@ 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;

View File

@@ -3,6 +3,8 @@ with
openGL.Primitive.indexed,
openGL.Texture.Coordinates;
with ada.Text_IO; use ada.Text_IO;
package body openGL.Model.circle.lit_textured
is
@@ -83,6 +85,9 @@ is
for i in 1 .. Self.texture_Details.texture_Count
loop
put_Line ("KKK" & Self.texture_Details'Image);
Id := texture_Id (i);
the_Geometry.Fade_is (which => Id,

View File

@@ -15,6 +15,7 @@ is
lat_Count : in Positive := 26;
long_Count : in Positive := 52;
Image : in asset_Name := null_Asset;
texture_Details : in texture_Set.Details;
is_Skysphere : in Boolean := False) return View
is
Self : constant View := new Item;
@@ -26,6 +27,8 @@ is
Self.define (Radius);
Self.texture_Details_is (texture_Details);
return Self;
end new_Sphere;
@@ -196,6 +199,8 @@ is
the_Geometry.add (Primitive.view (the_Primitive));
end;
the_Geometry.Model_is (Self.all'unchecked_Access);
return [1 => Geometry.view (the_Geometry)];
end to_GL_Geometries;

View File

@@ -1,6 +1,7 @@
with
openGL.Font,
openGL.Geometry;
openGL.Geometry,
openGL.Model.texturing;
package openGL.Model.sphere.textured
@@ -8,7 +9,10 @@ package openGL.Model.sphere.textured
-- Models a textured sphere.
--
is
type Item is new Model.sphere.item with private;
package textured_Model is new texturing.Mixin (openGL.Model.sphere.item);
type Item is new textured_Model.textured_item with private;
-- type Item is new Model.sphere.item with private;
type View is access all Item'Class;
@@ -20,6 +24,7 @@ is
lat_Count : in Positive := 26;
long_Count : in Positive := 52;
Image : in asset_Name := null_Asset;
texture_Details : in texture_Set.Details;
is_Skysphere : in Boolean := False) return View;
--------------
@@ -33,7 +38,8 @@ is
private
type Item is new Model.sphere.item with
-- type Item is new Model.sphere.item with
type Item is new textured_Model.textured_item with
record
Image : asset_Name := null_Asset; -- Usually a mercator projection to be mapped onto the sphere.
is_Skysphere : Boolean := False;

View File

@@ -81,14 +81,14 @@ is
is
pragma unreferenced (Textures);
-- text_Scale : constant Vector_3 := [2.0 * 4.0 / 78.0, -- TODO: Fix scaling.
-- 2.0 * 4.0 / 95.0,
-- 1.0 / 1.0];
text_Scale : constant Vector_3 := [1.0 * 1.0 / 78.0, -- TODO: Fix scaling.
1.0 * 1.0 / 95.0,
text_Scale : constant Vector_3 := [2.0 * 4.0 / 78.0, -- TODO: Fix scaling.
2.0 * 4.0 / 95.0,
1.0 / 1.0];
-- text_Scale : constant Vector_3 := [1.0 * 1.0 / 78.0, -- TODO: Fix scaling.
-- 1.0 * 1.0 / 95.0,
-- 1.0 / 1.0];
begin
if Self.Text.all = ""
then
@@ -290,6 +290,8 @@ is
the_Geometry.Model_is (Self.all'unchecked_Access);
the_Geometry.is_Transparent;
-- the_Geometry.texture_Details_is (openGL.texture_Set.to_Details ([1 => to_Asset ("assets/textures/Face1.bmp")]));
return [1 => Geometry.view (the_Geometry)];
end;
end to_GL_Geometries;

View File

@@ -137,8 +137,8 @@ is
is
the_Source : aliased constant C.char_array := to_C_char_array (shader_Filename);
begin
put_Line ("SHADER NAME: " & shader_Filename);
put_Line (interfaces.C.to_Ada (the_Source));
-- put_Line ("SHADER NAME: " & shader_Filename);
-- put_Line (interfaces.C.to_Ada (the_Source));
create_Shader (Self, Kind, the_Source);
end define;