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

opengl.model.polygon: Add a lit and textured model.

Browse Source
This commit is contained in:
Rod Kay
2023-11-14 19:50:14 +11:00
parent a4a75d528e
commit eadf53f890
6 changed files with 267 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
3-mid/opengl/applet/demo/renderer/render_models/launch_render_models.adb
View File

@@ -78,7 +78,7 @@ begin
the_Visuals (i) := new_Visual (the_Models (i));
end loop;
the_Visuals (3).Site_is ([0.0, 0.0, -50.0]);
the_Visuals (4).Site_is ([0.0, 0.0, -50.0]);
-- Main loop.

14
3-mid/opengl/source/demo/opengl-demo.adb
View File

@@ -21,6 +21,7 @@ with
openGL.Model.line .colored,
openGL.Model.any,
openGL.Model.polygon .lit_colored,
openGL.Model.polygon .lit_textured,
openGL.Model.segment_line,
openGL.Model.sphere .colored,
@@ -157,7 +158,7 @@ is
Plane => Billboard.xy,
Texture => the_Texture);
the_colored_billboard_Model : constant Model.billboard.textured.view
the_colored_billboard_Model : constant Model.billboard.textured.view -- TODO: Add color.
:= Model.billboard.textured.forge.new_Billboard (Size => (1.0, 1.0),
Plane => Billboard.xy,
Texture => the_Texture);
@@ -236,10 +237,16 @@ is
Texture => the_Texture,
Texture_is_lucid => False);
the_polygon_Model : constant Model.polygon.lit_colored.view
the_lit_colored_polygon_Model : constant Model.polygon.lit_colored.view
:= Model.polygon.lit_colored.new_Polygon (Vertices => [Origin_2D, [1.0, 0.0], [1.0, 1.0], [-1.0, 0.5]],
Color => (Red, Opaque));
the_lit_textured_polygon_Model : constant Model.polygon.lit_textured.view
:= Model.polygon.lit_textured.new_Polygon (vertex_Sites => [Origin_2D, [1.0, 0.0], [1.0, 1.0], [-1.0, 0.5]],
Face => (Fades => (1 => 0.0, others => <>),
Textures => (1 => the_Texture, others => <>),
texture_Count => 1));
the_text_Model : constant Model.Text.lit_colored.view
:= Model.Text.lit_colored.new_Text (Text => "Once upon a midnight dreary ...",
Font => the_font_Id,
@@ -274,7 +281,8 @@ is
the_segment_line_Model.add_Segment (end_Site => [0.0, 2.0, 0.0]);
return [ the_ground_Model.all'Access,
the_polygon_Model.all'Access,
the_lit_textured_polygon_Model.all'Access,
the_lit_colored_polygon_Model.all'Access,
the_text_Model.all'Access,
the_arrow_Model.all'Access,
the_ball_1_Model.all'Access,

180
3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb Normal file
View File

@@ -0,0 +1,180 @@
with
openGL.Geometry.lit_textured,
openGL.Primitive.indexed,
openGL.Texture.Coordinates;
package body openGL.Model.polygon.lit_textured
is
---------
--- Forge
--
function new_polygon (vertex_Sites : in Vector_2_array;
Face : in lit_textured.Face) return View
is
Self : constant View := new Item;
begin
Self.vertex_Sites (1 .. vertex_Sites'Length) := vertex_Sites;
Self.vertex_Count := vertex_Sites'Length;
Self.Face := Face;
return Self;
end new_polygon;
------------------
--- Attributes ---
------------------
------------
-- Texturing
--
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level)
is
begin
Self.Face.Fades (which) := Now;
end Fade_is;
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level
is
begin
return Self.Face.Fades (which);
end Fade;
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in openGL.asset_Name)
is
begin
Self.Face.Textures (Positive (which)) := Now;
end Texture_is;
overriding
function texture_Count (Self : in Item) return Natural
is
begin
return Self.Face.texture_Count;
end texture_Count;
overriding
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views
is
pragma unreferenced (Fonts);
use Geometry,
Geometry.lit_textured,
Texture;
the_Sites : Vector_2_array renames Self.vertex_Sites (1 .. Self.vertex_Count);
function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view
is
use Primitive,
texture_Set;
function the_Indices return Indices
is
Result : Indices (1 .. the_Sites'Length);
begin
for i in Result'Range
loop
Result (i) := Index_t (i);
end loop;
return Result;
end the_Indices;
the_Geometry : constant Geometry.lit_textured.view
:= Geometry.lit_textured.new_Geometry;
the_Primitive : constant Primitive.indexed.view
:= Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
Id : texture_Set.texture_Id;
begin
the_Geometry.Vertices_are (Vertices);
the_Geometry.add (Primitive.view (the_Primitive));
for i in 1 .. Self.Face.texture_Count
loop
Id := texture_Id (i);
the_Geometry.Fade_is (which => Id,
now => Self.Face.Fades (Id));
the_Geometry.Texture_is (which => Id,
now => Textures.fetch (Self.Face.Textures (i)));
the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent);
end loop;
the_Geometry.is_Transparent (True); -- TODO: Do transparency properly.
the_Geometry.Model_is (Self.all'unchecked_Access);
return the_Geometry;
end new_Face;
upper_Face : Geometry.lit_textured.view;
begin
-- Upper Face
--
declare
use openGL.Texture.Coordinates;
the_Vertices : Geometry.lit_textured.Vertex_array (1 .. the_Sites'Length + 1);
the_Coords : constant Coordinates_2D := to_Coordinates (the_Sites);
Centroid : Vector_2 := (0.0, 0.0);
begin
--- Calculate the centroid and min/max of x and y.
--
for i in the_Sites'Range
loop
Centroid := Centroid + the_Sites (i);
end loop;
Centroid := Centroid / Real (the_Sites'Length);
for i in the_Sites'Range
loop
the_Vertices (Index_t (i)) := (Site => Vector_3 (the_Sites (i) & 0.0),
Normal => Normal,
Coords => the_Coords (Index_t (i)),
Shine => default_Shine);
end loop;
the_Vertices (the_Vertices'Last) := (Site => Vector_3 (Centroid & 0.0),
Normal => Normal,
Coords => (0.5, 0.5),
Shine => default_Shine);
upper_Face := new_Face (Vertices => the_Vertices);
end;
return (1 => upper_Face.all'Access);
end to_GL_Geometries;
end openGL.Model.polygon.lit_textured;

68
3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.ads Normal file
View File

@@ -0,0 +1,68 @@
with
openGL.texture_Set,
openGL.Texture;
package openGL.Model.polygon.lit_textured
--
-- Models a lit and textured polygon.
--
is
type Item is new Model.item with private;
type View is access all Item'Class;
type Face is
record
Fades : texture_Set.fade_Levels (texture_Set.texture_Id) := [others => 0.0];
Textures : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex.
texture_Count : Natural := 0;
end record;
---------
--- Forge
--
function new_Polygon (vertex_Sites : in Vector_2_array;
Face : in lit_textured.Face) return View;
--------------
--- Attributes
--
overriding
function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class;
Fonts : in Font.font_id_Map_of_font) return Geometry.views;
------------
-- Texturing
--
overriding
function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
overriding
procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in texture_Set.fade_Level);
procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id;
Now : in asset_Name);
overriding
function texture_Count (Self : in Item) return Natural;
private
type Item is new Model.polygon.item with
record
vertex_Sites : Vector_2_array (1 .. 8);
vertex_Count : Positive;
Face : lit_textured.Face;
end record;
end openGL.Model.polygon.lit_textured;

6
3-mid/opengl/source/lean/model/opengl-model-polygon.ads
View File

@@ -5,4 +5,10 @@ package openGL.Model.polygon
is
type Item is abstract new Model.item with null record;
private
Normal : constant Vector_3 := [0.0, 0.0, 1.0];
end openGL.Model.polygon;

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

@@ -31,6 +31,7 @@ is
type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture;
type Item is
record
Textures : fadeable_Textures;