diff --git a/3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb b/3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb index 3f101aa..c0fd5fe 100644 --- a/3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb +++ b/3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb @@ -95,6 +95,9 @@ begin if Epoch mod 20 = 0 then + -- the_textured_hexagon_Model.Fade_is (which => 1, now => Fade); + -- the_textured_hexagon_Model.Fade_is (which => 2, now => 1.0 - Fade); + the_textured_hexagon_Model.Fade_1_is (Fade); the_textured_hexagon_Model.Fade_2_is (1.0 - Fade); -- the_textured_hexagon_Model.needs_Rebuild; diff --git a/3-mid/opengl/source/demo/opengl-demo.adb b/3-mid/opengl/source/demo/opengl-demo.adb index 6cdd31b..9b70f42 100644 --- a/3-mid/opengl/source/demo/opengl-demo.adb +++ b/3-mid/opengl/source/demo/opengl-demo.adb @@ -186,7 +186,9 @@ is the_textured_hexagon_Model : constant Model.hexagon.lit_textured.view := Model.hexagon.lit_textured.new_Hexagon (Radius => 0.5, - Face => (Texture => the_Texture)); + Face => (Fades => (1 => 0.0, others => <>), + Textures => (1 => the_Texture, others => <>), + texture_Count => 1)); the_faceted_hexagon_column_Model : constant Model.hexagon_Column.lit_colored_faceted.view := Model.hexagon_Column.lit_colored_faceted.new_hexagon_Column diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb index 2a83033..9ffafdd 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.adb @@ -1,7 +1,9 @@ with openGL.Buffer.general, + openGL.Model, openGL.Shader, openGL.Program.lit, + openGL.Variable.uniform, openGL.Attribute, openGL.Texture, openGL.Palette, @@ -9,8 +11,10 @@ with openGL.Errors, GL.lean, + GL.Binding, GL.Pointers, + ada.Strings.fixed, Interfaces.C.Strings, System.storage_Elements; @@ -27,21 +31,21 @@ is -- Globals -- - vertex_Shader : aliased Shader.item; - fragment_Shader : aliased Shader.item; + vertex_Shader : aliased Shader.item; + fragment_Shader : aliased Shader.item; - the_Program : openGL.Program.lit.view; - white_Texture : openGL.Texture.Object; + 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"; + 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 : 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); @@ -49,117 +53,158 @@ is Attribute_4_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_4_Name'Access); + --- Uniforms + -- + + type texture_Uniforms is + record + texture_Uniform : openGL.Variable.uniform.sampler2D; + fade_Uniform : openGL.Variable.uniform.float; + end record; + + the_Textures : array (texture_Id range 1 .. max_Textures) of texture_Uniforms; + the_texture_count_Uniform : openGL.Variable.uniform.int; + + + --------- -- Forge -- + procedure create_Program + is + use Palette, + Attribute.Forge, + System.storage_Elements; + + use type system.Address; + + 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.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.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.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.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.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.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; + + + --- Set up the texturing uniforms. + -- + + for Id in texture_Id'Range + loop + declare + use ada.Strings, + ada.Strings.fixed; + i : constant Positive := Positive (Id); + texture_uniform_Name : constant String := "Textures[" & trim (Natural'Image (i - 1), Left) & "]"; + fade_uniform_Name : constant String := "Fade[" & trim (Natural'Image (i - 1), Left) & "]"; + begin + the_Textures (Id).texture_Uniform := the_Program.uniform_Variable (named => texture_uniform_Name); + the_Textures (Id). fade_Uniform := the_Program.uniform_Variable (named => fade_uniform_Name); + end; + end loop; + + the_texture_count_Uniform := the_Program.uniform_Variable ("texture_Count"); + end create_Program; + + + + function new_Geometry return View is - use System, - System.storage_Elements; use type openGL.Program.lit.view; Self : constant View := new Geometry.lit_textured.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.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.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.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.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.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.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; + then + create_Program; -- Define the shaders and program. end if; - Self.Program_is (the_Program.all'Access); + Self.Program_is (the_Program.all'Access); return Self; end new_Geometry; + + ---------- -- Vertex -- @@ -181,6 +226,8 @@ is end is_Transparent; + + -------------- -- Attributes -- @@ -218,6 +265,7 @@ is + procedure Vertices_are (Self : in out Item; Now : in Vertex_large_array) is use openGL_large_Buffer_of_geometry_Vertices.Forge; @@ -240,6 +288,7 @@ is + overriding procedure Indices_are (Self : in out Item; Now : in Indices; for_Facia : in Positive) @@ -258,14 +307,15 @@ is procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in Geometry.texturing.fade_Level) is begin - Self.Textures.Textures (Which).Fade := Now; + 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; + return Self.Textures.Textures (which).Fade; end Fade; @@ -300,6 +350,7 @@ is end Texture_is; + overriding function Texture (Self : in Item) return openGL.Texture.Object is @@ -310,12 +361,64 @@ is + + use GL, + GL.Binding; + + 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); + + overriding procedure enable_Texture (Self : in out Item) is - use openGL.Geometry.texturing; begin - enable (Self.Textures, Self.Program); + for i in 1 .. texture_Id (Self.Model.texture_Count) + loop + the_Textures (i).fade_Uniform.Value_is (Real (Self.Model.Fade (i))); + + glUniform1i (the_Textures (i).texture_Uniform.gl_Variable, + GLint (i) - 1); + glActiveTexture (all_texture_Units (i)); + glBindTexture (GL_TEXTURE_2D, + Self.Textures.Textures (i).Object.Name); + end loop; + + the_texture_count_Uniform.Value_is (Self.Textures.Count); end enable_Texture; 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 index ff060ba..cd31328 100644 --- 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 @@ -298,6 +298,7 @@ is end Texture_is; + overriding function Texture (Self : in Item) return openGL.Texture.Object is @@ -313,8 +314,8 @@ is is use openGL.Geometry.texturing; begin - Self.Textures.Textures (1).Fade := Self.Model.Fade_1; - Self.Textures.Textures (2).Fade := Self.Model.Fade_2; + 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); diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb index 384aae1..59ee3f6 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb @@ -17,8 +17,8 @@ is begin in_Set.Textures (Which) := (0.0, Now, - textures_Uniform => <>, - fade_Uniform => <>); + texture_Uniform => <>, + fade_Uniform => <>); in_Set.is_Transparent := in_Set.is_Transparent or Now .is_Transparent; @@ -30,6 +30,8 @@ is end Texture_is; + + function Texture (in_Set : in texture_Set; Which : texture_ID) return openGL.Texture.Object is begin @@ -46,6 +48,8 @@ is end Texture; + + procedure Texture_is (in_Set : in out texture_Set; Now : in openGL.Texture.Object) is begin @@ -81,17 +85,19 @@ is 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).textures_Uniform := Program.uniform_Variable (Named => uniform_Name); + 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; + -- 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; @@ -143,7 +149,8 @@ is Id : constant texture_Id := texture_Id (i); begin - glUniform1i (the_Textures.Textures (Id).textures_Uniform.gl_Variable, + null; + glUniform1i (the_Textures.Textures (Id).texture_Uniform.gl_Variable, GLint (i) - 1); glActiveTexture (all_texture_Units (Id)); glBindTexture (GL_TEXTURE_2D, @@ -151,25 +158,28 @@ is 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); - begin - -- put_Line ("Fade:" & the_Textures.Textures (texture_Id (i)).Fade'Image); - - Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade)); - 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; + -- 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; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads index 20d420a..677b522 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads @@ -10,14 +10,16 @@ package openGL.Geometry.texturing -- 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). + type fade_Level is delta 0.001 range 0.0 .. 1.0; -- '0.0' is no fading, '1.0' is fully faded (ie invisible). + 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; - textures_Uniform : openGL.Variable.uniform.sampler2D; - fade_Uniform : openGL.Variable.uniform.float; + 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; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb index 23e9954..5ffb46e 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.adb @@ -23,30 +23,66 @@ is - -------------- - --- Attributes + ------------------ + --- Attributes --- + ------------------ + + + ------------ + -- Texturing -- - procedure Texture_is (Self : in out Item; Now : in openGL.asset_Name) + overriding + procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id; + Now : in Geometry.Texturing.fade_Level) is begin - Self.Face.Texture := Now; + Self.Face.Fades (which) := Now; + end Fade_is; + + + + overriding + function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level + is + begin + return Self.Face.Fades (which); + end Fade; + + + + procedure Texture_is (Self : in out Item; Which : in Geometry.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.lit_textured, + use Geometry, + Geometry.lit_textured, Texture; - the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius); - the_Indices : aliased constant Indices := (1, 2, 3, 4, 5, 6, 7, 2); + 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.Vertex_array) return Geometry.lit_textured.view @@ -58,17 +94,25 @@ is the_Primitive : constant Primitive.indexed.view := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices); + + Id : texture_Id; begin the_Geometry.Vertices_are (Vertices); the_Geometry.add (Primitive.view (the_Primitive)); - if Self.Face.Texture /= null_Asset - then - the_Geometry.Texture_is (Textures.fetch (Self.Face.Texture)); - the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent); - end if; + for i in 1 .. Self.Face.texture_Count + loop + Id := texture_Id (i); - the_Geometry.is_Transparent (True); + 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. return the_Geometry; end new_Face; @@ -93,6 +137,8 @@ is 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; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads index 76e260b..60ecb98 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured.ads @@ -1,5 +1,5 @@ with - openGL.Geometry, + openGL.Geometry.texturing, openGL.Texture; @@ -13,7 +13,9 @@ is type Face is record - Texture : openGL.asset_Name := null_Asset; -- The texture to be applied to the hex. + Fades : Geometry.texturing.fade_Levels (Geometry.texture_Id) := [others => 0.0]; + Textures : openGL.asset_Names (1 .. Positive (Geometry.texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the hex. + texture_Count : Natural := 0; end record; @@ -29,13 +31,27 @@ is --- Attributes -- - procedure Texture_is (Self : in out Item; Now : in openGL.asset_Name); - - 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 Geometry.texture_Id) return Geometry.Texturing.fade_Level; + + overriding + procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id; + Now : in Geometry.Texturing.fade_Level); + + procedure Texture_is (Self : in out Item; Which : in Geometry.texture_Id; + Now : in openGL.asset_Name); + + function texture_Count (Self : in Item) return Natural; + + private 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 index ec76c1f..46f9d3b 100644 --- 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 @@ -127,7 +127,7 @@ is - overriding + -- overriding procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level) is begin @@ -135,7 +135,7 @@ is end Fade_1_is; - overriding + -- overriding procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level) is begin @@ -144,7 +144,7 @@ is - overriding + -- overriding function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level is begin @@ -152,7 +152,7 @@ is end Fade_1; - overriding + -- overriding function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level is begin 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 index c69b4f9..ffde978 100644 --- 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 @@ -45,17 +45,17 @@ is procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name); - overriding + -- overriding procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level); - overriding + -- overriding procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level); - overriding + -- overriding function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level; - overriding + -- overriding function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level; diff --git a/3-mid/opengl/source/lean/model/opengl-model.adb b/3-mid/opengl/source/lean/model/opengl-model.adb index 4e9cd91..f9ff7a2 100644 --- a/3-mid/opengl/source/lean/model/opengl-model.adb +++ b/3-mid/opengl/source/lean/model/opengl-model.adb @@ -218,37 +218,67 @@ is -- Texturing -- - procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level) + procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id; + Now : in Geometry.Texturing.fade_Level) is begin raise program_Error with "Model does not support texturing."; - end Fade_1_is; + end Fade_is; - procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level) - is - begin - raise program_Error with "Model does not support texturing."; - end Fade_2_is; - - - - function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level + function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level is begin raise program_Error with "Model does not support texturing."; return 0.0; - end Fade_1; + end Fade; - function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level + function texture_Count (Self : in Item) return Natural is begin raise program_Error with "Model does not support texturing."; - return 0.0; - end Fade_2; + return 0; + end texture_Count; + + + + + + + -- procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level) + -- is + -- begin + -- raise program_Error with "Model does not support texturing."; + -- end Fade_1_is; + -- + -- + -- + -- procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level) + -- is + -- begin + -- raise program_Error with "Model does not support texturing."; + -- end Fade_2_is; + -- + -- + -- + -- function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level + -- is + -- begin + -- raise program_Error with "Model does not support texturing."; + -- return 0.0; + -- end Fade_1; + -- + -- + -- + -- function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level + -- is + -- begin + -- raise program_Error with "Model does not support texturing."; + -- return 0.0; + -- end Fade_2; end openGL.Model; diff --git a/3-mid/opengl/source/lean/model/opengl-model.ads b/3-mid/opengl/source/lean/model/opengl-model.ads index c88d4bd..c056e56 100644 --- a/3-mid/opengl/source/lean/model/opengl-model.ads +++ b/3-mid/opengl/source/lean/model/opengl-model.ads @@ -73,11 +73,18 @@ is -- Texturing -- - procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); - procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); + function Fade (Self : in Item; Which : in Geometry.texture_Id) return Geometry.Texturing.fade_Level; + procedure Fade_is (Self : in out Item; Which : in Geometry.texture_Id; + Now : in Geometry.Texturing.fade_Level); - function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level; - function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level; + function texture_Count (Self : in Item) return Natural; + + + -- procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); + -- procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); + -- + -- function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level; + -- function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level;