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

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

Browse Source
This commit is contained in:
Rod Kay
2023-11-23 23:09:12 +11:00
parent 715394a719
commit f12686d233
8 changed files with 338 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

180
3-mid/opengl/source/lean/model/opengl-model-circle-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.circle.lit_textured
is
---------
--- Forge
--
function new_circle (Radius : in Real;
Face : in lit_textured.Face;
Sides : in Positive := 24) return View
is
Self : constant View := new Item;
begin
Self.Radius := Radius;
Self.Face := Face;
Self.Sides := Sides;
return Self;
end new_circle;
------------------
--- 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;
---------------------
--- openGL Geometries
--
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;
function to_Indices return Indices
is
Result : Indices (1 .. long_Index_t (Self.Sides) + 2);
begin
for i in 1 .. Index_t (Self.Sides) + 1
loop
Result (long_Index_t (i)) := i; -- Index_t (Self.Sides) + 1 - i;
end loop;
Result (Result'Last) := 2;
return Result;
end to_Indices;
the_Indices : aliased constant Indices := to_Indices;
the_Sites : constant Vector_2_array := vertex_Sites (Self.Radius,
Self.Sides);
function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view
is
use Primitive,
texture_Set;
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 Texture.Coordinates;
the_Coords : constant Texture.Coordinates.Coords_2D_and_Centroid := to_Coordinates (the_Sites);
the_Vertices : Geometry.lit_textured.Vertex_array (1 .. Index_t (Self.Sides + 1));
begin
-- Center.
--
the_Vertices (1) := (Site => [0.0, 0.0, 0.0],
Normal => Normal,
Coords => (0.50, 0.50),
Shine => default_Shine);
-- Circumference
--
for i in 2 .. the_Vertices'Last
loop
the_Vertices (i) := (Site => Vector_3 (the_Sites (Positive (i - 1)) & 0.0),
Normal => Normal,
Coords => the_Coords.Coords (i - 1),
Shine => default_Shine);
end loop;
upper_Face := new_Face (Vertices => the_Vertices);
end;
return [1 => upper_Face.all'Access];
end to_GL_Geometries;
end openGL.Model.circle.lit_textured;

66
3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads Normal file
View File

@@ -0,0 +1,66 @@
with
openGL.texture_Set,
openGL.Texture;
package openGL.Model.circle.lit_textured
--
-- Models a lit, colored and textured hexagon.
--
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_circle (Radius : in Real;
Face : in lit_textured.Face;
Sides : in Positive := 24) 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.circle.item with
record
Face : lit_textured.Face;
end record;
end openGL.Model.circle.lit_textured;

24
3-mid/opengl/source/lean/model/opengl-model-circle.adb Normal file
View File

@@ -0,0 +1,24 @@
package body openGL.Model.circle
is
function vertex_Sites (Radius : in Real;
Sides : in Positive := 24) return Vector_2_array
is
use linear_Algebra_2d;
the_Site : Vector_2 := [Radius, 0.0];
Rotation : constant Matrix_2x2 := to_rotation_Matrix (to_Radians (360.0 / Degrees (Sides)));
Result : Vector_2_array (1 .. Sides);
begin
for i in Result'Range
loop
Result (i) := the_Site;
the_Site := the_Site * Rotation;
end loop;
return Result;
end vertex_Sites;
end openGL.Model.circle;

25
3-mid/opengl/source/lean/model/opengl-model-circle.ads Normal file
View File

@@ -0,0 +1,25 @@
package openGL.Model.circle
--
-- Provides an abstract model of a circle.
--
is
type Item is abstract new Model.item with private;
-- Sites begin at 'middle right' and proceed in an anti-clockwise direction.
--
function vertex_Sites (Radius : in Real;
Sides : in Positive := 24) return Vector_2_array;
private
type Item is abstract new Model.item with
record
Radius : Real := 1.0;
Sides : Positive range 3 .. 360;
end record;
Normal : constant Vector_3 := [0.0, 0.0, 1.0];
end openGL.Model.circle;

3
3-mid/opengl/source/lean/opengl-texture-coordinates.adb
View File

@@ -53,6 +53,7 @@ is
overriding
function to_Coordinates (Self : in xz_Generator; the_Vertices : access Sites) return Coordinates_2D
is
@@ -88,6 +89,7 @@ is
overriding
function to_Coordinates (Self : in xy_Generator; the_Vertices : access Sites) return Coordinates_2D
is
@@ -123,6 +125,7 @@ is
overriding
function to_Coordinates (Self : in zy_Generator; the_Vertices : access Sites) return Coordinates_2D
is

10
3-mid/opengl/source/lean/opengl-texture-coordinates.ads
View File

@@ -3,9 +3,8 @@ package openGL.Texture.Coordinates
-- Provides openGL texture co-ordinates.
--
is
------
--- 2D
---------------
--- 2D Textures
--
type Coords_2D_and_Centroid (coords_Count : Index_t) is
@@ -21,7 +20,7 @@ is
--- Generator
--- Generators
--
type coordinate_Generator is abstract tagged null record;
@@ -66,7 +65,4 @@ is
function to_Coordinates (Self : in mercator_Generator; the_Vertices : access Sites) return Coordinates_2D;
end openGL.Texture.Coordinates;

44
3-mid/opengl/source/lean/opengl-texture.adb
View File

@@ -9,6 +9,9 @@ with
ada.unchecked_Deallocation;
with ada.Text_IO;
package body openGL.Texture
is
use GL,
@@ -84,7 +87,7 @@ is
function to_Texture (the_Image : in Image;
use_Mipmaps : in Boolean := True) return Object
use_Mipmaps : in Boolean := True) return Object
is
Self : aliased Texture.Object;
begin
@@ -96,7 +99,7 @@ is
function to_Texture (the_Image : in lucid_Image;
use_Mipmaps : in Boolean := True) return Object
use_Mipmaps : in Boolean := True) return Object
is
Self : aliased Texture.Object;
begin
@@ -153,7 +156,9 @@ is
procedure set_Image (Self : in out Object; To : in Image;
use_Mipmaps : in Boolean := True)
is
use GL.Binding;
use GL.Binding,
ada.Text_IO;
the_Image : Image renames To;
min_Width : constant Positive := the_Image'Length (2);
min_Height : constant Positive := the_Image'Length (1);
@@ -163,17 +168,23 @@ is
Self.is_Transparent := False;
Self.Dimensions.Width := min_Width;
Self.Dimensions.Height := min_Height;
new_Line (3);
put_Line ("openGL.Texture.set_Image ~ GLsizei (Self.Dimensions.Width) =>" & GLsizei (Self.Dimensions.Width) 'Image);
put_Line (" ~ GLsizei (Self.Dimensions.Height) =>" & GLsizei (Self.Dimensions.Height)'Image);
put_Line (" ~ the_Image =>");
put_Line (the_Image'Image);
new_Line (3);
Self.enable;
glPixelStorei (GL_UNPACK_ALIGNMENT, 1);
glPixelStorei (GL_UNPACK_ALIGNMENT, 1); Errors.log;
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); Errors.log;
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); Errors.log;
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
Errors.log;
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); Errors.log;
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); Errors.log;
glTexImage2D (GL_TEXTURE_2D,
0,
@@ -212,15 +223,13 @@ is
Self.Dimensions.Height := min_Height;
Self.enable;
glPixelStorei (GL_UNPACK_ALIGNMENT, 1);
glPixelStorei (GL_UNPACK_ALIGNMENT, 1); Errors.log;
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); Errors.log;
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); Errors.log;
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
Errors.log;
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); Errors.log;
glTexParameteri (GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); Errors.log;
glTexImage2D (GL_TEXTURE_2D,
0,
@@ -258,6 +267,7 @@ is
begin
Tasks.check;
glBindTexture (GL.GL_TEXTURE_2D, Self.Name);
Errors.log;
end enable;