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

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

View File

@@ -1,7 +1,9 @@
with openGL.Model.texturing;
with
openGL.Light,
openGL.Visual,
openGL.Model.Box.lit_textured,
openGL.texture_Set,
openGL.Palette,
openGL.Demo;
@@ -38,7 +40,8 @@ begin
Upper => (texture_Name => the_Texture),
Lower => (texture_Name => the_Texture),
Left => (texture_Name => the_Texture),
Right => (texture_Name => the_Texture)));
Right => (texture_Name => the_Texture)),
texture_Details => openGL.texture_Set.to_Details ([1 => the_Texture]));
-- The Visual.
--
the_Visuals : constant openGL.Visual.views := (1 => new_Visual (the_Box.all'Access));

View File

@@ -3,6 +3,7 @@ with
openGL.Visual,
openGL.Model.Sphere.lit_colored_textured,
openGL.Model.Sphere.lit_colored,
openGL.texture_Set,
openGL.Palette,
openGL.Demo;
@@ -30,6 +31,7 @@ begin
--
the_Ball_1_Model : constant Model.Sphere.lit_colored_textured.view
:= openGL.Model.Sphere.lit_colored_textured.new_Sphere (Radius => 1.0,
texture_Details => openGL.texture_Set.to_Details ([1 => the_Texture]),
Image => the_Texture);
the_Ball_2_Model : constant Model.Sphere.lit_colored.view
:= openGL.Model.Sphere.lit_colored.new_Sphere (Radius => 1.0,

View File

@@ -1,7 +1,8 @@
with
openGL.Model.any,
openGL.Visual,
openGL.Light.directional,
openGL.Light,
openGL.texture_Set,
openGL.Demo;
procedure launch_render_Asteroids
@@ -16,24 +17,30 @@ is
begin
Demo.define ("openGL 'Render Asteroids' Demo");
Demo.print_Usage ("Use space ' ' to cycle through models.");
Demo.Camera.Position_is ((0.0, 0.0, 200.0),
Demo.Camera.Position_is ([0.0, 0.0, 200.0],
y_Rotation_from (to_Radians (0.0)));
declare
the_Light : openGL.Light.directional.item := Demo.Renderer.Light (1);
the_Light : openGL.Light.item := Demo.Renderer.new_Light;
begin
the_Light.Site_is ((5_000.0, 2_000.0, 5_000.0));
Demo.Renderer.Light_is (1, the_Light);
the_Light.Site_is ([5_000.0, 2_000.0, 5_000.0]);
the_Light.ambient_Coefficient_is (0.05);
Demo.Renderer.set (the_Light);
end;
declare
-- The models.
--
-- gaspra_Model : constant openGL.Model.any.view := openGL.Model.any.new_Model (Model => to_Asset ("assets/gaspra.tab"),
-- Texture => null_Asset,
-- texture_Details => openGL.texture_Set.no_Details,
-- Texture_is_lucid => False);
gaspra_Model : constant openGL.Model.any.view := openGL.Model.any.new_Model (Model => to_Asset ("assets/gaspra.tab"),
Texture => null_Asset,
Texture => to_Asset ("./assets/opengl/texture/Face1.bmp"),
texture_Details => openGL.texture_Set.to_Details ([1 => to_Asset ("./assets/opengl/texture/Face1.bmp")]),
Texture_is_lucid => False);
the_Models : constant openGL.Model.views := (1 => gaspra_Model.all'unchecked_Access);
the_Models : constant openGL.Model.views := [1 => gaspra_Model.all'unchecked_Access];
-- The visuals.
--
@@ -79,7 +86,7 @@ begin
-- Render all visuals.
--
Demo.Camera.render ((1 => the_Visuals (Current)));
Demo.Camera.render ([1 => the_Visuals (Current)]);
while not Demo.Camera.cull_Completed
loop

View File

@@ -2,6 +2,7 @@ with
openGL.Visual,
openGL.Model.Billboard. textured,
openGL.Model.Billboard.colored_textured,
openGL.texture_Set,
openGL.Palette,
openGL.Demo;
@@ -27,21 +28,23 @@ begin
the_Billboard_Model : constant Model.Billboard.textured.view
:= Model.Billboard.textured.forge.new_Billboard (--Scale => (1.0, 1.0, 1.0),
Plane => Billboard.xy,
Texture => the_Texture);
Texture => the_Texture,
texture_Details => openGL.texture_Set.to_Details ([1 => the_Texture]));
the_colored_Billboard_Model : constant Model.Billboard.colored_textured.view
:= Model.Billboard.colored_textured.new_Billboard (--Scale => (1.0, 1.0, 1.0),
Plane => Billboard.xy,
Color => (Palette.Green, Opaque),
Texture => the_Texture);
Texture => the_Texture,
texture_Details => openGL.texture_Set.to_Details ([1 => the_Texture]));
-- The Sprites.
--
use openGL.Visual.Forge;
the_Sprites : constant openGL.Visual.views := [new_Visual ( the_Billboard_Model.all'Access),
the_Visuals : constant openGL.Visual.views := [new_Visual ( the_Billboard_Model.all'Access),
new_Visual (the_colored_Billboard_Model.all'Access)];
begin
the_Sprites (2).Site_is ([3.0, 0.0, 0.0]);
the_Visuals (2).Site_is ([3.0, 0.0, 0.0]);
-- Main loop.
--
@@ -54,7 +57,7 @@ begin
-- Render the sprites.
--
Demo.Camera.render (the_Sprites);
Demo.Camera.render (the_Visuals);
while not Demo.Camera.cull_Completed
loop

View File

@@ -1,3 +1,4 @@
with openGL.texture_Set;
with
openGL.Visual,
@@ -5,9 +6,11 @@ with
openGL.Model.Box.textured,
openGL.Model.Box.lit_colored_textured,
openGL.texture_Set,
openGL.Palette,
openGL.Demo;
procedure launch_render_Boxes
--
-- Exercise the rendering of box models.
@@ -58,7 +61,8 @@ begin
Upper => (texture_Name => the_Texture),
Lower => (texture_Name => the_Texture),
Left => (texture_Name => the_Texture),
Right => (texture_Name => the_Texture)]);
Right => (texture_Name => the_Texture)],
texture_Details => texture_Set.to_Details ([1 => the_Texture]));
-- The Visuals.
--

View File

@@ -33,7 +33,7 @@ begin
the_Capsule_Model : constant Model.Capsule.lit_colored_textured.view
:= Model.Capsule.lit_colored_textured.new_Capsule (Radius => 0.5,
Height => 2.0,
Color => (White, Opaque),
Color => (Green, Opaque),
Image => the_Texture);
-- The Visuals.
--
@@ -42,6 +42,7 @@ begin
the_Visuals : constant openGL.Visual.views := [1 => new_Visual (the_Capsule_Model.all'Access)];
begin
the_Light.Site_is ([0.0, 5.0, 10.0]);
the_Light.ambient_Coefficient_is (0.05);
Demo.Renderer.set (the_Light);
-- Main loop.

View File

@@ -83,7 +83,7 @@ begin
the_Visuals (4).Site_is ([0.0, 0.0, -50.0]);
the_Visuals (1).Scale_is ([2.0, 2.0, 1.0]); -- Text visual.
the_Visuals (1).Scale_is ([0.2, 0.2, 1.0]); -- Text visual.
-- Main loop.
--

View File

@@ -45,6 +45,9 @@ begin
the_Visuals (i) := new_Visual (the_Models (i));
end loop;
the_Visuals (1).Scale_is ([0.2, 0.2, 1.0]); -- Text visual.
-- Main loop.
--
while not Demo.Done

View File

@@ -3,8 +3,10 @@ with
openGL.Palette,
openGL.Font,
openGL.Model.Text.lit_colored,
openGL.texture_Set,
openGL.Demo;
procedure launch_render_Text
--
-- Render updated text.
@@ -35,16 +37,20 @@ begin
:= Model.Text.lit_colored.new_Text (Text => "Howdy",
Font => the_font_Id,
Color => (Red, Opaque),
texture_Details => openGL.texture_Set.to_Details ([1 => openGL.to_Asset ("assets/texture/Face1.bmp")]),
Centered => False);
-- The sprites.
--
use openGL.Visual.Forge;
the_Sprites : constant openGL.Visual.views := [1 => new_Visual (the_Text_Model.all'Access)];
Current : constant Integer := the_Sprites'First;
the_Visuals : constant openGL.Visual.views := [1 => new_Visual (the_Text_Model.all'Access)];
Current : constant Integer := the_Visuals'First;
begin
the_Visuals (1).Scale_is ([0.2, 0.2, 1.0]);
-- Main loop.
--
while not Demo.Done
@@ -78,7 +84,7 @@ begin
-- Render all sprites.
--
Demo.Camera.render ([1 => the_Sprites (Current)]);
Demo.Camera.render ([1 => the_Visuals (Current)]);
while not Demo.Camera.cull_Completed
loop

View File

@@ -1,3 +1,4 @@
with openGL.texture_Set;
with
openGL.Camera,
openGL.Palette,
@@ -54,7 +55,8 @@ begin
right => (colors => [others => (Red, Opaque)], texture_name => the_Face)]);
the_ball_Model : constant Model.Sphere.lit_colored_textured.view
:= Model.Sphere.lit_colored_textured.new_Sphere (radius => 0.5);
:= Model.Sphere.lit_colored_textured.new_Sphere (radius => 0.5,
texture_Details => texture_Set.to_Details ([1 => the_Face]));
-- The Sprites.
--

View File

@@ -60,6 +60,8 @@ is
use type GLint;
begin
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)));
@@ -71,6 +73,7 @@ is
glBindTexture (GL_TEXTURE_2D,
texture_Set.Textures (i).Object.Name);
end loop;
end if;
Uniforms.Count.Value_is (for_Model.texture_Count);
end enable;

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;

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);

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;

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;

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);

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.

View File

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

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
@@ -32,7 +33,7 @@ is
function new_Box (Size : in Vector_3;
Faces : in lit_textured.Faces;
texture_Details : in texture_Set.Details) return View;
texture_Details : in texture_Set.Details := texture_Set.no_Details) return View;
--------------

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;

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;

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

View File

@@ -1,6 +1,7 @@
with
openGL.Geometry,
openGL.Model.texturing;
openGL.Model.texturing,
openGL.texture_Set;
package openGL.Model.terrain
@@ -25,7 +26,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;
overriding

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);

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;