From a362e5aeffccfc7565cf5dd2b4e6f05d92e58c8a Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Mon, 29 May 2023 21:41:00 +1000 Subject: [PATCH] opengl.geometry: Rid obsolete prototype code. --- .../opengl-geometry-lit_textured_x2.adb | 325 ------------------ .../opengl-geometry-lit_textured_x2.ads | 70 ---- .../opengl-geometry-texturing (copy 1).adb-1 | 186 ---------- .../opengl-geometry-texturing (copy 1).ads-1 | 49 --- .../opengl-model-hexagon-lit_textured_x2.adb | 164 --------- .../opengl-model-hexagon-lit_textured_x2.ads | 70 ---- 6 files changed, 864 deletions(-) delete mode 100644 3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb delete mode 100644 3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads delete mode 100644 3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).adb-1 delete mode 100644 3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).ads-1 delete mode 100644 3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb delete mode 100644 3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb deleted file mode 100644 index cd31328..0000000 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb +++ /dev/null @@ -1,325 +0,0 @@ -with - openGL.Buffer.general, - openGL.Shader, - openGL.Program.lit, - openGL.Attribute, - openGL.Texture, - openGL.Palette, - openGL.Model, - openGL.Tasks, - openGL.Errors, - - GL.lean, - GL.Pointers, - - Interfaces.C.Strings, - System.storage_Elements; - --- with ada.Text_IO; use ada.Text_IO; - - -package body openGL.Geometry.lit_textured_x2 -is - use GL.lean, - GL.Pointers, - Interfaces; - - ----------- - -- Globals - -- - - vertex_Shader : aliased Shader.item; - fragment_Shader : aliased Shader.item; - - the_Program : openGL.Program.lit.view; - white_Texture : openGL.Texture.Object; - - Name_1 : constant String := "Site"; - Name_2 : constant String := "Normal"; - Name_3 : constant String := "Coords"; - Name_4 : constant String := "Shine"; - - Attribute_1_Name : aliased C.char_array := C.to_C (Name_1); - Attribute_2_Name : aliased C.char_array := C.to_C (Name_2); - Attribute_3_Name : aliased C.char_array := C.to_C (Name_3); - Attribute_4_Name : aliased C.char_array := C.to_C (Name_4); - - Attribute_1_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_1_Name'Access); - Attribute_2_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_2_Name'Access); - Attribute_3_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_3_Name'Access); - Attribute_4_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_4_Name'Access); - - - --------- - -- Forge - -- - - function new_Geometry return View - is - use System, - System.storage_Elements; - use type openGL.Program.lit.view; - - Self : constant View := new Geometry.lit_textured_x2.item; - - begin - Tasks.check; - - if the_Program = null - then -- Define the shaders and program. - declare - use Palette, - Attribute.Forge; - - Sample : Vertex; - - Attribute_1 : Attribute.view; - Attribute_2 : Attribute.view; - Attribute_3 : Attribute.view; - Attribute_4 : Attribute.view; - - white_Image : constant Image := [1 .. 2 => [1 .. 2 => +White]]; - - begin - white_Texture := openGL.Texture.Forge.to_Texture (white_Image); - - vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/lit_textured_x2.vert"); - - fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"), - 2 => to_Asset ("assets/opengl/shader/texturing.frag"), - 3 => to_Asset ("assets/opengl/shader/lit_textured_x2.frag")))); - the_Program := new openGL.Program.lit.item; - the_Program.define ( vertex_Shader'Access, - fragment_Shader'Access); - the_Program.enable; - - Attribute_1 := new_Attribute (Name => Name_1, - gl_Location => the_Program.attribute_Location (Name_1), - Size => 3, - data_Kind => attribute.GL_FLOAT, - Stride => lit_textured_x2.Vertex'Size / 8, - Offset => 0, - Normalized => False); - - Attribute_2 := new_Attribute (Name => Name_2, - gl_Location => the_Program.attribute_Location (Name_2), - Size => 3, - data_Kind => attribute.GL_FLOAT, - Stride => lit_textured_x2.Vertex'Size / 8, - Offset => Sample.Normal (1)'Address - - Sample.Site (1)'Address, - Normalized => False); - - Attribute_3 := new_Attribute (Name => Name_3, - gl_Location => the_Program.attribute_Location (Name_3), - Size => 2, - data_Kind => attribute.GL_FLOAT, - Stride => lit_textured_x2.Vertex'Size / 8, - Offset => Sample.Coords.S'Address - - Sample.Site (1)'Address, - Normalized => False); - - Attribute_4 := new_Attribute (Name => Name_4, - gl_Location => the_Program.attribute_Location (Name_4), - Size => 1, - data_Kind => attribute.GL_FLOAT, - Stride => lit_textured_x2.Vertex'Size / 8, - Offset => Sample.Shine 'Address - - Sample.Site (1)'Address, - Normalized => False); - - the_Program.add (Attribute_1); - the_Program.add (Attribute_2); - the_Program.add (Attribute_3); - the_Program.add (Attribute_4); - - glBindAttribLocation (program => the_Program.gl_Program, - index => the_Program.Attribute (named => Name_1).gl_Location, - name => +Attribute_1_Name_ptr); - Errors.log; - - glBindAttribLocation (program => the_Program.gl_Program, - index => the_Program.Attribute (named => Name_2).gl_Location, - name => +Attribute_2_Name_ptr); - Errors.log; - - glBindAttribLocation (program => the_Program.gl_Program, - index => the_Program.Attribute (named => Name_3).gl_Location, - name => +Attribute_3_Name_ptr); - Errors.log; - - glBindAttribLocation (program => the_Program.gl_Program, - index => the_Program.Attribute (named => Name_4).gl_Location, - name => +Attribute_4_Name_ptr); - Errors.log; - end; - end if; - - Self.Program_is (the_Program.all'Access); - - return Self; - end new_Geometry; - - - ---------- - -- Vertex - -- - - function is_Transparent (Self : in Vertex_array) return Boolean -- TODO: Do these properly. - is - pragma Unreferenced (Self); - begin - return False; - end is_Transparent; - - - - function is_Transparent (Self : in Vertex_large_array) return Boolean - is - pragma Unreferenced (Self); - begin - return False; - end is_Transparent; - - - -------------- - -- Attributes - -- - - package openGL_Buffer_of_geometry_Vertices is new Buffer.general (base_Object => Buffer.array_Object, - Index => Index_t, - Element => Vertex, - Element_Array => Vertex_array); - - package openGL_large_Buffer_of_geometry_Vertices is new Buffer.general (base_Object => Buffer.array_Object, - Index => long_Index_t, - Element => Vertex, - Element_Array => Vertex_large_array); - - - procedure Vertices_are (Self : in out Item; Now : in Vertex_array) - is - use openGL_Buffer_of_geometry_Vertices.Forge; - begin - Self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (to_Buffer (Now, - usage => Buffer.static_Draw)); - Self.is_Transparent := is_Transparent (Now); - - -- Set the bounds. - -- - declare - function get_Site (Index : in Index_t) return Vector_3 - is (Now (Index).Site); - - function bounding_Box is new get_Bounds (Index_t, get_Site); - begin - Self.Bounds_are (bounding_Box (Count => Now'Length)); - end; - end Vertices_are; - - - - procedure Vertices_are (Self : in out Item; Now : in Vertex_large_array) - is - use openGL_large_Buffer_of_geometry_Vertices.Forge; - begin - Self.Vertices := new openGL_large_Buffer_of_geometry_Vertices.Object' (to_Buffer (Now, - usage => Buffer.static_Draw)); - Self.is_Transparent := is_Transparent (Now); - - -- Set the bounds. - -- - declare - function get_Site (Index : in long_Index_t) return Vector_3 - is (Now (Index).Site); - - function bounding_Box is new get_Bounds (long_Index_t, get_Site); - begin - Self.Bounds_are (bounding_Box (Count => Now'Length)); - end; - end Vertices_are; - - - - overriding - procedure Indices_are (Self : in out Item; Now : in Indices; - for_Facia : in Positive) - is - begin - raise Error with "TODO"; - end Indices_are; - - - - procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level) - is - begin - Self.Textures.Textures (Which).Fade := Now; - end Fade_is; - - - function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level - is - begin - return Self.Textures.Textures (Which).Fade; - end Fade; - - - - - - procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object) - is - use openGL.Geometry.texturing; - begin - Texture_is (in_Set => Self.Textures, - Which => Which, - Now => Now); - end Texture_is; - - - - function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object - is - begin - return openGL.Geometry.texturing.Texture (in_Set => Self.Textures, - Which => Which); - end Texture; - - - - overriding - procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) - is - use openGL.Geometry.texturing; - begin - Texture_is (in_Set => Self.Textures, - Now => Now); - end Texture_is; - - - - overriding - function Texture (Self : in Item) return openGL.Texture.Object - is - begin - return openGL.Geometry.texturing.Texture (in_Set => Self.Textures, - Which => 1); - end Texture; - - - - overriding - procedure enable_Texture (Self : in out Item) - is - use openGL.Geometry.texturing; - begin - Self.Textures.Textures (1).Fade := Self.Model.Fade (which => 1); - Self.Textures.Textures (2).Fade := Self.Model.Fade (which => 2); - - - enable (Self.Textures, Self.Program); - end enable_Texture; - - -end openGL.Geometry.lit_textured_x2; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads deleted file mode 100644 index 6763006..0000000 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.ads +++ /dev/null @@ -1,70 +0,0 @@ -with - openGL.Geometry.texturing; - - -package openGL.Geometry.lit_textured_x2 --- --- Supports per-vertex site texture and lighting. --- -is - type Item is new openGL.Geometry.item with private; - type View is access all Item'Class; - - - function new_Geometry return View; - - - ---------- - -- Vertex - -- - - type Vertex is - record - Site : Vector_3; - Normal : Vector_3; - Coords : Coordinate_2D; - Shine : Real; - end record; - - type Vertex_array is array ( Index_t range <>) of aliased Vertex; - type Vertex_large_array is array (long_Index_t range <>) of aliased Vertex; - - - -------------- - -- Attributes - -- - - procedure Vertices_are (Self : in out Item; Now : in Vertex_array); - procedure Vertices_are (Self : in out Item; Now : in Vertex_large_array); - - overriding - procedure Indices_are (Self : in out Item; Now : in Indices; - for_Facia : in Positive); - - procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level); - function Fade (Self : in Item; Which : texture_ID) return Geometry.texturing.fade_Level; - - - procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object); - function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object; - - overriding - procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object); - - overriding - function Texture (Self : in Item) return openGL.Texture.Object; - - - -private - - type Item is new Geometry.item with - record - Textures : Geometry.texturing.texture_Set; - end record; - - - overriding - procedure enable_Texture (Self : in out Item); - -end openGL.Geometry.lit_textured_x2; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).adb-1 b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).adb-1 deleted file mode 100644 index 59ee3f6..0000000 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).adb-1 +++ /dev/null @@ -1,186 +0,0 @@ -with - openGL.Tasks, - - GL.Binding, - GL.lean, - - ada.Strings.fixed; - -with ada.Text_IO; use ada.Text_IO; - - -package body openGL.Geometry.texturing -is - - procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object) - is - begin - in_Set.Textures (Which) := (0.0, - Now, - texture_Uniform => <>, - fade_Uniform => <>); - - in_Set.is_Transparent := in_Set.is_Transparent - or Now .is_Transparent; - - if Natural (Which) > in_Set.Count - then - in_Set.Count := Natural (Which); - end if; - end Texture_is; - - - - - function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object - is - begin - return in_Set.Textures (Which).Object; - end Texture; - - - - - function Texture (in_Set : in texture_Set) return openGL.Texture.Object - is - begin - return in_Set.Textures (1).Object; - end Texture; - - - - - procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object) - is - begin - in_Set.Textures (1).Object := Now; - in_Set.is_Transparent := in_Set.is_Transparent - or Now .is_Transparent; - - if in_Set.Count = 0 - then - in_Set.Count := 1; - end if; - end Texture_is; - - - - procedure enable (the_Textures : in out texture_Set; - Program : in openGL.Program.view) - is - use GL, - GL.Binding, - openGL.Texture; - - begin - Tasks.check; - - if not the_Textures.initialised - then - for i in 1 .. the_Textures.Count - loop - declare - use ada.Strings, - ada.Strings.fixed; - - Id : constant texture_Id := texture_Id (i); - begin - null; - - declare - uniform_Name : aliased constant String :="Textures[" & Trim (Natural'Image (i - 1), Left) & "]"; - begin - the_Textures.Textures (Id).texture_Uniform := Program.uniform_Variable (Named => uniform_Name); - end; - - -- declare - -- uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]"; - -- begin - -- the_Textures.Textures (Id).fade_Uniform := Program.uniform_Variable (Named => uniform_Name); - -- end; - end; - end loop; - - the_Textures.Initialised := True; - end if; - - - for i in 1 .. the_Textures.Count - loop - declare - use GL.lean; - - use type GL.GLint; - - type texture_Units is array (texture_Id) of GLenum; - - all_texture_Units : constant texture_Units := (GL_TEXTURE0, - GL_TEXTURE1, - GL_TEXTURE2, - GL_TEXTURE3, - GL_TEXTURE4, - GL_TEXTURE5, - GL_TEXTURE6, - GL_TEXTURE7, - GL_TEXTURE8, - GL_TEXTURE9, - GL_TEXTURE10, - GL_TEXTURE11, - GL_TEXTURE12, - GL_TEXTURE13, - GL_TEXTURE14, - GL_TEXTURE15, - GL_TEXTURE16, - GL_TEXTURE17, - GL_TEXTURE18, - GL_TEXTURE19, - GL_TEXTURE20, - GL_TEXTURE21, - GL_TEXTURE22, - GL_TEXTURE23, - GL_TEXTURE24, - GL_TEXTURE25, - GL_TEXTURE26, - GL_TEXTURE27, - GL_TEXTURE28, - GL_TEXTURE29, - GL_TEXTURE30, - GL_TEXTURE31); - - Id : constant texture_Id := texture_Id (i); - begin - null; - glUniform1i (the_Textures.Textures (Id).texture_Uniform.gl_Variable, - GLint (i) - 1); - glActiveTexture (all_texture_Units (Id)); - glBindTexture (GL_TEXTURE_2D, - the_Textures.Textures (Id).Object.Name); - end; - - - -- declare - -- use ada.Strings, - -- ada.Strings.fixed; - -- - -- uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]"; - -- Uniform : constant openGL.Variable.uniform.float := Program.uniform_Variable (uniform_Name); - -- Id : constant texture_Id := texture_Id (i); - -- begin - -- -- put_Line ("Fade:" & the_Textures.Textures (texture_Id (i)).Fade'Image); - -- - -- -- the_Textures.Textures (Id).fade_Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade)); - -- -- Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade)); - -- null; - -- end; - end loop; - - - -- declare - -- the_texture_count_Uniform : constant openGL.Variable.uniform.int := Program.uniform_Variable ("texture_Count"); - -- begin - -- the_texture_count_Uniform.Value_is (the_Textures.Count); - -- end; - end enable; - - -end openGL.Geometry.texturing; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).ads-1 b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).ads-1 deleted file mode 100644 index 0f74ae3..0000000 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing (copy 1).ads-1 +++ /dev/null @@ -1,49 +0,0 @@ -with - openGL.Program, - openGL.Texture, - openGL.Variable.uniform; - - -package openGL.Geometry.texturing --- --- Facilitates texturing of geometries. --- -is - - type fade_Level is delta 0.001 range 0.0 .. 1.0 -- '0.0' is no fading, '1.0' is fully faded (ie invisible). - with Atomic; - - type fade_Levels is array (texture_Id range <>) of fade_Level; - - - type fadeable_Texture is - record - Fade : fade_Level := 0.0; - Object : openGL.Texture.Object := openGL.Texture.null_Object; - texture_Uniform : openGL.Variable.uniform.sampler2D; - fade_Uniform : openGL.Variable.uniform.float; - end record; - - type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture; - - type texture_Set is - record - Textures : fadeable_Textures; - Count : Natural := 0; - is_Transparent : Boolean := False; -- Any of the textures contains lucid colors. - initialised : Boolean := False; - end record; - - procedure enable (the_Textures : in out texture_Set; - Program : in openGL.Program.view); - - - - procedure Texture_is (in_Set : in out texture_Set; Which : texture_ID; Now : in openGL.Texture.Object); - function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object; - - procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object); - function Texture (in_Set : in texture_Set) return openGL.Texture.Object; - - -end openGL.Geometry.texturing; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb deleted file mode 100644 index 46f9d3b..0000000 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb +++ /dev/null @@ -1,164 +0,0 @@ -with - openGL.Geometry.lit_textured_x2, - openGL.Primitive.indexed; - - -package body openGL.Model.hexagon.lit_textured_x2 -is - --------- - --- Forge - -- - - function new_Hexagon (Radius : in Real; - Face : in lit_textured_x2.Face) return View - is - Self : constant View := new Item; - begin - Self.Radius := Radius; - Self.Face := Face; - - return Self; - end new_Hexagon; - - - - - -------------- - --- 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 - is - pragma unreferenced (Fonts); - - use Geometry.lit_textured_x2, - Texture; - - the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius); - the_Indices : aliased constant Indices := (1, 2, 3, 4, 5, 6, 7, 2); - - - function new_Face (Vertices : in geometry.lit_textured_x2.Vertex_array) return Geometry.lit_textured_x2.view - is - use Primitive; - - the_Geometry : constant Geometry.lit_textured_x2.view - := Geometry.lit_textured_x2.new_Geometry; - - the_Primitive : constant Primitive.indexed.view - := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices); - begin - the_Geometry.Vertices_are (Vertices); - the_Geometry.add (Primitive.view (the_Primitive)); - - - if Self.Face.Texture_1 /= null_Asset - then - the_Geometry.Texture_is (Textures.fetch (Self.Face.Texture_1)); - the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent); - the_Geometry.Fade_is (which => 1, - now => Self.Face.Fade_1); - else - raise Program_Error; - end if; - - if Self.Face.Texture_2 /= null_Asset - then - the_Geometry.Texture_is (which => 2, - Now => Textures.fetch (Self.Face.Texture_2)); - - -- the_Geometry.Texture_2_is (Which => 2, Now => Textures.fetch (Self.Face.Texture_2)); - -- the_Geometry.is_Transparent (now => the_Geometry.Texture_2.is_Transparent); - the_Geometry.Fade_is (which => 2, - now => Self.Face.Fade_2); - end if; - - - return the_Geometry; - end new_Face; - - - upper_Face : Geometry.lit_textured_x2.view; - - begin - -- Upper Face - -- - declare - the_Vertices : constant Geometry.lit_textured_x2.Vertex_array - := (1 => (Site => (0.0, 0.0, 0.0), Normal => Normal, Coords => (0.50, 0.50), Shine => default_Shine), -- Center. - - 2 => (Site => the_Sites (1), Normal => Normal, Coords => (1.00, 0.50), Shine => default_Shine), -- Mid right. - 3 => (Site => the_Sites (2), Normal => Normal, Coords => (0.75, 1.00), Shine => default_Shine), -- Bottom right. - 4 => (Site => the_Sites (3), Normal => Normal, Coords => (0.25, 1.00), Shine => default_Shine), -- Bottom left. - 5 => (Site => the_Sites (4), Normal => Normal, Coords => (0.00, 0.50), Shine => default_Shine), -- Mid left. - 6 => (Site => the_Sites (5), Normal => Normal, Coords => (0.25, 0.00), Shine => default_Shine), -- Top left. - 7 => (Site => the_Sites (6), Normal => Normal, Coords => (0.75, 0.00), Shine => default_Shine)); -- Top right. - begin - upper_Face := new_Face (Vertices => the_Vertices); - end; - - upper_Face.Model_is (Self.all'unchecked_Access); - - return (1 => upper_Face.all'Access); - end to_GL_Geometries; - - - - - ------------ - -- Texturing - -- - - procedure Texture_1_is (Self : in out Item; Now : in openGL.asset_Name) - is - begin - Self.Face.Texture_1 := Now; - end Texture_1_is; - - - procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name) - is - begin - Self.Face.Texture_2 := Now; - end Texture_2_is; - - - - - -- overriding - procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level) - is - begin - Self.Face.Fade_1 := Now; - end Fade_1_is; - - - -- overriding - procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level) - is - begin - Self.Face.Fade_2 := Now; - end Fade_2_is; - - - - -- overriding - function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level - is - begin - return Self.Face.Fade_1; - end Fade_1; - - - -- overriding - function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level - is - begin - return Self.Face.Fade_2; - end Fade_2; - - - -end openGL.Model.hexagon.lit_textured_x2; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads deleted file mode 100644 index ffde978..0000000 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads +++ /dev/null @@ -1,70 +0,0 @@ -with - openGL.Geometry.texturing, - openGL.Texture; - - -package openGL.Model.hexagon.lit_textured_x2 --- --- 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 - Texture_1 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex. - Texture_2 : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex. - Fade_1 : openGL.Geometry.texturing.fade_Level := 0.5; - Fade_2 : openGL.Geometry.texturing.fade_Level := 0.5; - end record; - - - --------- - --- Forge - -- - - function new_Hexagon (Radius : in Real; - Face : in lit_textured_x2.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 - -- - - procedure Texture_1_is (Self : in out Item; Now : in openGL.asset_Name); - procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name); - - - -- overriding - procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level); - - -- overriding - procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level); - - - -- overriding - function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level; - - -- overriding - function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level; - - - -private - - type Item is new Model.hexagon.item with - record - Face : lit_textured_x2.Face; - end record; - -end openGL.Model.hexagon.lit_textured_x2;