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

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