diff --git a/3-mid/opengl/source/demo/opengl-demo.adb b/3-mid/opengl/source/demo/opengl-demo.adb index 3ee4fc2..4bdb9d4 100644 --- a/3-mid/opengl/source/demo/opengl-demo.adb +++ b/3-mid/opengl/source/demo/opengl-demo.adb @@ -11,6 +11,7 @@ with openGL.Model.box .lit_textured, openGL.Model.capsule .lit_textured, + openGL.Model.circle .lit_textured, openGL.Model.grid, openGL.Model.hexagon .lit_colored, @@ -188,6 +189,14 @@ is := Model.capsule.lit_textured.new_Capsule (Radius => 0.5, Height => 2.0, Image => the_Texture); + + the_lit_textured_circle_Model : constant Model.circle.lit_textured.view + := Model.circle.lit_textured.new_Circle (Radius => 1.5, + Face => (Fades => (1 => 0.0, others => <>), + Textures => (1 => the_Texture, others => <>), + texture_Count => 1), + Sides => 24); + the_grid_Model : constant Model.grid.view := Model.grid.new_grid_Model (Color => Red, Width => 3, @@ -297,6 +306,7 @@ is the_box_3_Model.all'Access, the_capsule_Model.all'Access, + the_lit_textured_circle_Model.all'Access, the_grid_Model.all'Access, the_hexagon_Model.all'Access, diff --git a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb new file mode 100644 index 0000000..dadd5fd --- /dev/null +++ b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb @@ -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; diff --git a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads new file mode 100644 index 0000000..7a7438a --- /dev/null +++ b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.ads @@ -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; diff --git a/3-mid/opengl/source/lean/model/opengl-model-circle.adb b/3-mid/opengl/source/lean/model/opengl-model-circle.adb new file mode 100644 index 0000000..32734ce --- /dev/null +++ b/3-mid/opengl/source/lean/model/opengl-model-circle.adb @@ -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; diff --git a/3-mid/opengl/source/lean/model/opengl-model-circle.ads b/3-mid/opengl/source/lean/model/opengl-model-circle.ads new file mode 100644 index 0000000..488c869 --- /dev/null +++ b/3-mid/opengl/source/lean/model/opengl-model-circle.ads @@ -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; diff --git a/3-mid/opengl/source/lean/opengl-texture-coordinates.adb b/3-mid/opengl/source/lean/opengl-texture-coordinates.adb index 86e045b..4c1d6a4 100644 --- a/3-mid/opengl/source/lean/opengl-texture-coordinates.adb +++ b/3-mid/opengl/source/lean/opengl-texture-coordinates.adb @@ -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 diff --git a/3-mid/opengl/source/lean/opengl-texture-coordinates.ads b/3-mid/opengl/source/lean/opengl-texture-coordinates.ads index 8663a9e..a930031 100644 --- a/3-mid/opengl/source/lean/opengl-texture-coordinates.ads +++ b/3-mid/opengl/source/lean/opengl-texture-coordinates.ads @@ -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; diff --git a/3-mid/opengl/source/lean/opengl-texture.adb b/3-mid/opengl/source/lean/opengl-texture.adb index f3671bf..5e2707b 100644 --- a/3-mid/opengl/source/lean/opengl-texture.adb +++ b/3-mid/opengl/source/lean/opengl-texture.adb @@ -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;