diff --git a/3-mid/opengl/applet/demo/renderer/render_models/launch_render_models.adb b/3-mid/opengl/applet/demo/renderer/render_models/launch_render_models.adb index 3060425..7d8917f 100644 --- a/3-mid/opengl/applet/demo/renderer/render_models/launch_render_models.adb +++ b/3-mid/opengl/applet/demo/renderer/render_models/launch_render_models.adb @@ -3,9 +3,7 @@ with openGL.Visual, openGL.Light, openGL.Palette, - openGL.Demo, - - ada.Text_IO; + openGL.Demo; procedure launch_render_Models @@ -16,8 +14,7 @@ is use openGL, openGL.Math, openGL.linear_Algebra_3D, - openGL.Palette, - ada.Text_IO; + openGL.Palette; begin Demo.print_Usage ("Use space ' ' to cycle through models."); diff --git a/3-mid/opengl/source/demo/opengl-demo.adb b/3-mid/opengl/source/demo/opengl-demo.adb index 967cd31..3d682ea 100644 --- a/3-mid/opengl/source/demo/opengl-demo.adb +++ b/3-mid/opengl/source/demo/opengl-demo.adb @@ -1,6 +1,5 @@ -with openGL.Model.texturing; -with openGL.texture_Set; with + openGL.texture_Set, openGL.Palette, openGL.Font, openGL.IO, diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb index ba683ee..6b95cc8 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.adb @@ -1,14 +1,11 @@ with openGL.Program.lit, - openGL.Palette, openGL.Shader, openGL.Buffer.general, openGL.Attribute, - openGL.Texture, openGL.Tasks, openGL.Errors, - GL.Binding, GL.lean, GL.Pointers, @@ -18,8 +15,7 @@ with package body openGL.Geometry.lit_colored_textured is - use openGL.texture_Set, - GL.lean, + use GL.lean, GL.Pointers, Interfaces, System; @@ -64,7 +60,6 @@ is Attribute_4_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_4_Name'Access); Attribute_5_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_5_Name'Access); - white_Texture : openGL.Texture.Object; --------- @@ -81,8 +76,7 @@ is procedure define (the_Program : access Program; use_fragment_Shader : in String) is - use openGL.Palette, - Attribute.Forge, + use Attribute.Forge, system.Storage_Elements; Sample : Vertex; @@ -93,10 +87,7 @@ is Attribute_4 : openGL.Attribute.view; Attribute_5 : openGL.Attribute.view; - white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; - begin - white_Texture := openGL.Texture.Forge.to_Texture (white_Image); the_Program.Program := new openGL.Program.lit.item; the_Program.vertex_Shader.define (Shader.Vertex, "assets/opengl/shader/lit_colored_textured.vert"); @@ -288,6 +279,7 @@ is end Vertices_are; + overriding procedure Indices_are (Self : in out Item; Now : in Indices; for_Facia : in Positive) @@ -297,93 +289,4 @@ is end Indices_are; - - - - --- Texturing - -- - - -- procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level) - -- is - -- begin - -- Self.Textures.Textures (Which).Fade := Now; - -- end Fade_is; - -- - -- - -- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.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 - -- 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.texture_Set.Texture (in_Set => Self.Textures, - -- which => Which); - -- end Texture; - -- - -- - -- - -- overriding - -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) - -- is - -- 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.texture_Set.Texture (in_Set => Self.Textures, - -- which => 1); - -- end Texture; - -- - -- - -- - -- overriding - -- procedure enable_Textures (Self : in out Item) - -- is - -- begin - -- enable (Self.Textures, Self.Program); - -- end enable_Textures; - -- - - - -- overriding - -- procedure enable_Texture (Self : in out Item) - -- is - -- use GL, - -- GL.Binding, - -- openGL.Texture; - -- begin - -- Tasks.check; - -- - -- glActiveTexture (gl.GL_TEXTURE0); - -- Errors.log; - -- - -- if Self.Texture = openGL.Texture.null_Object - -- then enable (white_Texture); - -- else enable (Self.Texture); - -- end if; - -- end enable_Texture; - - end openGL.Geometry.lit_colored_textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads index e3f24ef..1762a4d 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured.ads @@ -1,7 +1,3 @@ -with - openGL.texture_Set; - --- private with openGL.Geometry.texturing; @@ -47,25 +43,6 @@ is procedure Indices_are (Self : in out Item; Now : in Indices; for_Facia : in Positive); - --- Texturing. - -- - - -- procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level; - -- Which : in texture_Set.texture_ID := 1); - -- function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level; - -- - -- - -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object; - -- Which : in texture_Set.texture_ID); - -- function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) 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 @@ -75,13 +52,4 @@ private end record; - -- type Item is new Geometry.item with - -- record - -- Textures : texture_Set.Item; - -- end record; - - - -- overriding - -- procedure enable_Textures (Self : in out Item); - end openGL.Geometry.lit_colored_textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb index 4d5b3de..2c56205 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.adb @@ -2,12 +2,9 @@ with openGL.Shader, openGL.Attribute, openGL.Buffer.general, - openGL.Texture, - openGL.Palette, openGL.Tasks, openGL.Errors, - GL.Binding, GL.lean, GL.Pointers, @@ -51,7 +48,6 @@ is Attribute_6_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_6_Name'Access); Attribute_7_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_7_Name'Access); - white_Texture : openGL.Texture.Object; ---------- @@ -93,8 +89,7 @@ is procedure define_Program is - use Palette, - Attribute.Forge, + use Attribute.Forge, GL.lean, GL.Pointers, System.storage_Elements; @@ -109,8 +104,6 @@ is Attribute_6 : openGL.Attribute.view; Attribute_7 : openGL.Attribute.view; - white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; - begin Tasks.check; @@ -123,8 +116,6 @@ is -- Define the shaders and program. -- - white_Texture := openGL.Texture.Forge.to_Texture (white_Image); - vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/lit_colored_textured_skinned.vert"); fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"), 2 => to_Asset ("assets/opengl/shader/lighting-frag.snippet"), @@ -242,6 +233,7 @@ is end define_Program; + -------------- -- Attributes -- diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads index a39bb50..de1b2e4 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_colored_textured_skinned.ads @@ -1,6 +1,5 @@ with - openGL.Program.lit.colored_textured_skinned, - openGL.texture_Set; + openGL.Program.lit.colored_textured_skinned; private @@ -8,7 +7,6 @@ with openGL.Geometry.texturing; - package openGL.Geometry.lit_colored_textured_skinned -- -- Supports 'per-vertex' site, color, texture, lighting and skinning. @@ -67,9 +65,4 @@ private end record; - -- type Item is new Geometry.item with null record; - -- - -- overriding - -- procedure enable_Textures (Self : in out Item); - end openGL.Geometry.lit_colored_textured_skinned; 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 1ad1a9c..d0bf300 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,30 +1,22 @@ with - openGL.Geometry.texturing, openGL.Buffer.general, - openGL.Model, openGL.Shader, openGL.Program.lit, openGL.Attribute, - openGL.Texture, - openGL.Palette, openGL.Tasks, openGL.Errors, GL.lean, GL.Pointers, - ada.Strings.fixed, Interfaces.C.Strings, System.storage_Elements; --- with ada.Text_IO; use ada.Text_IO; - package body openGL.Geometry.lit_textured is use GL.lean, GL.Pointers, - openGL.texture_Set, Interfaces; ----------- @@ -34,8 +26,7 @@ is 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; Name_1 : constant String := "Site"; Name_2 : constant String := "Normal"; @@ -52,8 +43,6 @@ is 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); - -- texture_Uniforms : texturing.Uniforms; - --------- @@ -62,8 +51,7 @@ is procedure create_Program is - use Palette, - Attribute.Forge, + use Attribute.Forge, System.storage_Elements; use type system.Address; @@ -75,11 +63,7 @@ is 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.snippet"), @@ -150,27 +134,6 @@ is 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 - -- texture_Uniforms.Textures (Id).texture_Uniform := the_Program.uniform_Variable (named => texture_uniform_Name); - -- texture_Uniforms.Textures (Id). fade_Uniform := the_Program.uniform_Variable (named => fade_uniform_Name); - -- end; - -- end loop; - -- - -- texture_Uniforms.Count := the_Program.uniform_Variable ("texture_Count"); - textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access); end create_Program; @@ -291,75 +254,4 @@ is end Indices_are; - - - - --- Texturing - -- - - -- procedure Fade_is (Self : in out Item; Which : texture_ID; Now : in texture_Set.fade_Level) - -- is - -- begin - -- Self.texture_Set.Textures (which).Fade := Now; - -- end Fade_is; - -- - -- - -- - -- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level - -- is - -- begin - -- return Self.texture_Set.Textures (which).Fade; - -- end Fade; - -- - -- - -- - -- procedure Texture_is (Self : in out Item; Which : texture_ID; Now : in openGL.Texture.Object) - -- is - -- begin - -- Texture_is (in_Set => Self.texture_Set, - -- Which => Which, - -- Now => Now); - -- end Texture_is; - -- - -- - -- - -- function Texture (Self : in Item; Which : texture_ID) return openGL.Texture.Object - -- is - -- begin - -- return openGL.texture_Set.Texture (in_Set => Self.texture_Set, - -- Which => Which); - -- end Texture; - -- - -- - -- - -- overriding - -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) - -- is - -- begin - -- Texture_is (in_Set => Self.texture_Set, - -- Now => Now); - -- end Texture_is; - -- - -- - -- - -- overriding - -- function Texture (Self : in Item) return openGL.Texture.Object - -- is - -- begin - -- return texture_Set.Texture (in_Set => Self.texture_Set, - -- Which => 1); - -- end Texture; - - - - -- overriding - -- procedure enable_Textures (Self : in out Item) - -- is - -- begin - -- texturing.enable (for_Model => Self.Model.all'Access, - -- Uniforms => texture_Uniforms, - -- texture_Set => Self.texture_Set); - -- end enable_Textures; - - end openGL.Geometry.lit_textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads index 4ad0194..1aa6826 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads @@ -1,6 +1,3 @@ -with - openGL.texture_Set; - private with openGL.Geometry.texturing; @@ -46,24 +43,6 @@ is for_Facia : in Positive); - --- Texturing. - -- - - -- procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level); - -- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level; - -- - -- - -- procedure Texture_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in openGL.Texture.Object); - -- function Texture (Self : in Item; Which : texture_Set.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 package textured_Geometry is new texturing.Mixin; @@ -75,7 +54,4 @@ private end record; - -- overriding - -- procedure enable_Textures (Self : in out Item); - end openGL.Geometry.lit_textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb index 678f887..02c213b 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.adb @@ -2,12 +2,9 @@ with openGL.Shader, openGL.Attribute, openGL.Buffer.general, - openGL.Texture, - openGL.Palette, openGL.Tasks, openGL.Errors, - GL.Binding, GL.lean, GL.Pointers, @@ -49,7 +46,6 @@ is Attribute_5_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_5_Name'Access); Attribute_6_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_6_Name'Access); - white_Texture : openGL.Texture.Object; ---------- @@ -83,8 +79,7 @@ is procedure define_Program is - use Palette, - Attribute.Forge, + use Attribute.Forge, GL.lean, GL.Pointers, System.storage_Elements; @@ -98,8 +93,6 @@ is Attribute_5 : openGL.Attribute.view; Attribute_6 : openGL.Attribute.view; - white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; - begin Tasks.check; @@ -112,8 +105,6 @@ is -- Define the shaders and program. -- - white_Texture := openGL.Texture.Forge.to_Texture (white_Image); - vertex_Shader .define (Shader.Vertex, "assets/opengl/shader/lit_textured_skinned.vert"); -- fragment_Shader.define (Shader.Fragment, "assets/opengl/shader/lit_textured_skinned.frag"); fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"), diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads index ea8f430..1b96700 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_skinned.ads @@ -1,6 +1,5 @@ with - openGL.Program.lit.textured_skinned, - openGL.texture_Set; + openGL.Program.lit.textured_skinned; private with @@ -65,9 +64,4 @@ private end record; - -- type Item is new Geometry.item with null record; - -- - -- overriding - -- procedure enable_Textures (Self : in out Item); - end openGL.Geometry.lit_textured_skinned; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb index f6dd1a8..a67a303 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb @@ -2,9 +2,7 @@ with openGL.Buffer.general, openGL.Shader, openGL.Program, - openGL.Palette, openGL.Attribute, - openGL.Texture, openGL.Tasks, GL.lean, GL.Pointers, @@ -19,8 +17,6 @@ is use GL.lean, GL.Pointers, - openGL.texture_Set, - Interfaces, System; @@ -33,7 +29,6 @@ is fragment_Shader : aliased Shader.item; the_Program : openGL.Program.view; - white_Texture : openGL.Texture.Object; Name_1 : constant String := "Site"; Name_2 : constant String := "Coords"; @@ -61,8 +56,7 @@ is if the_Program = null then -- Define the shaders and program. declare - use Palette, - Attribute.Forge, + use Attribute.Forge, system.Storage_Elements; Sample : Vertex; @@ -70,11 +64,7 @@ is Attribute_1 : Attribute.view; Attribute_2 : Attribute.view; - white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; - begin - white_Texture := openGL.Texture.Forge.to_Texture (white_Image); - vertex_Shader .define (Shader.vertex, "assets/opengl/shader/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.snippet"), @@ -170,91 +160,4 @@ is end Indices_are; - - --- Texturing - -- - - -- procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level) - -- is - -- begin - -- Self.Textures.Textures (Which).Fade := Now; - -- end Fade_is; - -- - -- - -- - -- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.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 - -- 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.texture_Set.Texture (in_Set => Self.Textures, - -- Which => Which); - -- end Texture; - -- - -- - -- - -- overriding - -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) - -- is - -- 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.texture_Set.Texture (in_Set => Self.Textures, - -- which => 1); - -- end Texture; - -- - -- - -- - -- overriding - -- procedure enable_Textures (Self : in out Item) - -- is - -- begin - -- enable (Self.Textures, Self.Program); - -- end enable_Textures; - - - - -- overriding - -- procedure enable_Texture (Self : in out Item) - -- is - -- use GL, - -- GL.Binding, - -- openGL.Texture; - -- begin - -- Tasks.check; - -- - -- glActiveTexture (gl.GL_TEXTURE0); - -- Errors.log; - -- - -- if Self.Texture = openGL.Texture.null_Object - -- then white_Texture.enable; - -- else Self.Texture .enable; - -- end if; - -- end enable_Texture; - - end openGL.Geometry.textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads index 6e9ccab..8f17ea5 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads @@ -1,7 +1,3 @@ -with - openGL.texture_Set; - - private with openGL.Geometry.texturing; @@ -45,24 +41,6 @@ is for_Facia : in Positive); - --- Texturing. - -- - - -- procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level); - -- function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level; - -- - -- - -- procedure Texture_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in openGL.Texture.Object); - -- function Texture (Self : in Item; Which : texture_Set.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 package textured_Geometry is new texturing.Mixin; @@ -74,13 +52,4 @@ private end record; - -- type Item is new Geometry.item with - -- record - -- Textures : texture_Set.Item; - -- end record; - -- - -- - -- overriding - -- procedure enable_Textures (Self : in out Item); - end openGL.Geometry.textured; 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 44e05bb..73ba203 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb @@ -4,8 +4,6 @@ with GL.Binding, ada.Strings.fixed; -with ada.Text_IO; - package body openGL.Geometry.texturing is @@ -14,7 +12,7 @@ is type texture_Units is array (texture_Set.texture_Id) of GLenum; - all_texture_Units : constant texture_Units := (GL_TEXTURE0, + all_texture_Units : constant texture_Units := [GL_TEXTURE0, GL_TEXTURE1, GL_TEXTURE2, GL_TEXTURE3, @@ -29,7 +27,7 @@ is GL_TEXTURE12, GL_TEXTURE13, GL_TEXTURE14, - GL_TEXTURE15); + GL_TEXTURE15]; -- GL_TEXTURE16, -- GL_TEXTURE17, -- GL_TEXTURE18, diff --git a/3-mid/opengl/source/lean/model/opengl-model-arrow-colored.adb b/3-mid/opengl/source/lean/model/opengl-model-arrow-colored.adb index f4c4195..3a83044 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-arrow-colored.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-arrow-colored.adb @@ -99,8 +99,6 @@ is procedure set_side_Bits (Self : in out Item) is - use linear_Algebra_3d; - End_1 : Vector_3 renames Self.Vertices (1).Site; End_2 : Vector_3 renames Self.Vertices (2).Site; diff --git a/3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.ads index c2764e6..07ee790 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.ads @@ -11,11 +11,9 @@ package openGL.Model.billboard.colored_textured -- Models a colored, textured billboard. -- is - package textured_Model is new texturing.Mixin (openGL.Model.billboard.item); + package textured_Model is new texturing.Mixin (openGL.Model.billboard.item); type Item is new textured_Model.textured_item with private; - - -- type Item is new Model.billboard.item with private; type View is access all Item'Class; @@ -51,7 +49,6 @@ is private type Item is new textured_Model.textured_item with - -- type Item is new Model.billboard.item with record Color : lucid_Color := (Palette.White, Opaque); diff --git a/3-mid/opengl/source/lean/model/opengl-model-billboard-textured.adb b/3-mid/opengl/source/lean/model/opengl-model-billboard-textured.adb index 5504312..8067797 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-billboard-textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-billboard-textured.adb @@ -200,47 +200,4 @@ is end Image_is; - - ------------ - -- Texturing - -- - - -- overriding - -- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in texture_Set.fade_Level) - -- is - -- begin - -- null; - -- end Fade_is; - -- - -- - -- - -- overriding - -- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level - -- is - -- begin - -- return 0.0; - -- end Fade; - -- - -- - -- - -- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in openGL.asset_Name) - -- is - -- begin - -- null; - -- end Texture_is; - -- - -- - -- - -- - -- overriding - -- function texture_Count (Self : in Item) return Natural - -- is - -- begin - -- return 1; - -- end texture_Count; - - - end openGL.Model.billboard.textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-billboard-textured.ads b/3-mid/opengl/source/lean/model/opengl-model-billboard-textured.ads index fb93692..50dc4e3 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-billboard-textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-billboard-textured.ads @@ -12,7 +12,6 @@ is package textured_Model is new texturing.Mixin (openGL.Model.billboard.item); type Item (Lucid : Boolean) is new textured_Model.textured_item with private; - -- type Item (Lucid : Boolean) is new Model.billboard.item with private; type View is access all Item'Class; type Image_view is access Image; @@ -51,28 +50,9 @@ is procedure Image_is (Self : in out Item; Now : in lucid_Image); - ------------ - -- 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 (Lucid : Boolean) is new Model.billboard.item with type Item (Lucid : Boolean) is new textured_Model.textured_item with record texture_Name : asset_Name := null_Asset; diff --git a/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured.adb index 1b83769..c7fbac4 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured.adb @@ -73,7 +73,7 @@ is the_Vertices : aliased Geometry.lit_colored_textured.Vertex_array := [1 => (Site => the_Sites ( Left_Lower_Front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (1), Coords => (0.0, 0.0), Shine => default_Shine), 2 => (Site => the_Sites (Right_Lower_Front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (2), Coords => (1.0, 0.0), Shine => default_Shine), - 3 => (Site => the_Sites (right_upper_front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (3), Coords => (1.0, 1.0), Shine => default_Shine), + 3 => (Site => the_Sites (Right_Upper_front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (3), Coords => (1.0, 1.0), Shine => default_Shine), 4 => (Site => the_Sites ( Left_Upper_Front), Normal => front_Normal, Color => +Self.Faces (Front).Colors (4), Coords => (0.0, 1.0), Shine => default_Shine)]; begin front_Face := new_Face (Vertices => the_Vertices'Access); diff --git a/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured.ads index 45de788..7278266 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured.ads @@ -15,7 +15,6 @@ package openGL.Model.Box.lit_colored_textured is package textured_Model is new texturing.Mixin (openGL.Model.box.item); - -- type Item is new Model.box.item with private; type Item is new textured_Model.textured_item with private; type View is access all Item'Class; @@ -48,7 +47,6 @@ is private - -- type Item is new Model.box.item with type Item is new textured_Model.textured_item with record Faces : lit_colored_textured.Faces; diff --git a/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured_x1.ads b/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured_x1.ads index 33d7a2d..11cd9a2 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured_x1.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-box-lit_colored_textured_x1.ads @@ -15,7 +15,6 @@ package openGL.Model.Box.lit_colored_textured_x1 is package textured_Model is new texturing.Mixin (openGL.Model.box.item); - -- type Item is new Model.box.item with private; type Item is new textured_Model.textured_item with private; type View is access all Item'Class; @@ -48,7 +47,6 @@ is private - -- type Item is new Model.box.item with type Item is new textured_Model.textured_item with record Faces : lit_colored_textured_x1.Faces; diff --git a/3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.adb index 34af209..ab0fc9c 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.adb @@ -194,48 +194,4 @@ is end to_GL_Geometries; - - - ------------ - -- Texturing - -- - - -- overriding - -- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in texture_Set.fade_Level) - -- is - -- begin - -- null; - -- end Fade_is; - -- - -- - -- - -- overriding - -- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level - -- is - -- begin - -- return 0.0; - -- end Fade; - -- - -- - -- - -- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in openGL.asset_Name) - -- is - -- begin - -- null; - -- end Texture_is; - -- - -- - -- - -- - -- overriding - -- function texture_Count (Self : in Item) return Natural - -- is - -- begin - -- return 1; - -- end texture_Count; - - - end openGL.Model.box.lit_textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.ads index bc6bca0..9208579 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-box-lit_textured.ads @@ -15,7 +15,6 @@ is package textured_Model is new texturing.Mixin (openGL.Model.box.item); type Item is new textured_Model.textured_item with private; - -- type Item is new Model.box.item with private; type View is access all Item'Class; @@ -45,31 +44,12 @@ is 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.box.item with type Item is new textured_Model.textured_item with record Faces : lit_textured.Faces; end record; + end openGL.Model.Box.lit_textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-box-textured.adb b/3-mid/opengl/source/lean/model/opengl-model-box-textured.adb index 467be36..36103d7 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-box-textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-box-textured.adb @@ -9,10 +9,10 @@ is --- Forge -- - function new_Box (Size : in Vector_3; - Faces : in textured.Faces; + function new_Box (Size : in Vector_3; + Faces : in textured.Faces; texture_Details : in texture_Set.Details; - is_Skybox : in Boolean := False) return View + is_Skybox : in Boolean := False) return View is Self : constant View := new Item; begin @@ -200,46 +200,4 @@ is end to_GL_Geometries; - - - ------------ - -- Texturing - -- - - -- overriding - -- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in texture_Set.fade_Level) - -- is - -- begin - -- null; - -- end Fade_is; - -- - -- - -- - -- overriding - -- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level - -- is - -- begin - -- return 0.0; - -- end Fade; - -- - -- - -- - -- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in openGL.asset_Name) - -- is - -- begin - -- null; - -- end Texture_is; - -- - -- - -- - -- overriding - -- function texture_Count (Self : in Item) return Natural - -- is - -- begin - -- return 1; - -- end texture_Count; - - end openGL.Model.box.textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-box-textured.ads b/3-mid/opengl/source/lean/model/opengl-model-box-textured.ads index 1e501ab..6cde3ba 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-box-textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-box-textured.ads @@ -15,7 +15,6 @@ is package textured_Model is new texturing.Mixin (openGL.Model.box.item); type Item is new textured_Model.textured_item with private; - -- type Item is new Model.box.item with private; type View is access all Item'Class; @@ -31,10 +30,10 @@ is --- Forge -- - function new_Box (Size : in Vector_3; - Faces : in textured.Faces; + function new_Box (Size : in Vector_3; + Faces : in textured.Faces; texture_Details : in texture_Set.Details; - is_Skybox : in Boolean := False) return View; + is_Skybox : in Boolean := False) return View; -------------- @@ -45,32 +44,14 @@ is 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.box.item with type Item is new textured_Model.textured_item with record Faces : textured.Faces; is_Skybox : Boolean := False; end record; + end openGL.Model.Box.textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored_textured.ads index c8c73f0..0ff5073 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored_textured.ads @@ -10,7 +10,6 @@ package openGL.Model.capsule.lit_colored_textured is package textured_Model is new texturing.Mixin (openGL.Model.capsule.item); - -- type Item is new Model.capsule.item with private; type Item is new textured_Model.textured_item with private; type View is access all Item'Class; @@ -36,8 +35,6 @@ is private - -- type Item is new Model.capsule.item with - type Item is new textured_Model.textured_item with record Radius : Real; @@ -47,4 +44,5 @@ private Image : asset_Name := null_Asset; end record; + end openGL.Model.capsule.lit_colored_textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.adb index dea9adb..6b48e2b 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.adb @@ -32,9 +32,6 @@ is --- Attributes -- --- type Geometry_view is access all Geometry.lit_textured.item'Class; - - 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 @@ -407,45 +404,4 @@ is end to_GL_Geometries; - - ------------ - -- Texturing - -- - - -- overriding - -- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in texture_Set.fade_Level) - -- is - -- begin - -- null; - -- end Fade_is; - -- - -- - -- - -- overriding - -- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level - -- is - -- begin - -- return 0.0; - -- end Fade; - -- - -- - -- - -- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in openGL.asset_Name) - -- is - -- begin - -- null; - -- end Texture_is; - -- - -- - -- - -- overriding - -- function texture_Count (Self : in Item) return Natural - -- is - -- begin - -- return 1; - -- end texture_Count; - - end openGL.Model.capsule.lit_textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.ads index 8d29e19..79a7e1f 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_textured.ads @@ -11,7 +11,6 @@ is package textured_Model is new texturing.Mixin (openGL.Model.capsule.item); type Item is new textured_Model.textured_item with private; - -- type Item is new Model.capsule.item with private; type View is access all Item'Class; @@ -33,28 +32,8 @@ is 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.capsule.item with type Item is new textured_Model.textured_item with record Radius : Real; @@ -63,4 +42,5 @@ private Image : asset_Name := null_Asset; end record; + end openGL.Model.capsule.lit_textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.ads b/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.ads index 7785d04..d053847 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.ads @@ -8,7 +8,6 @@ package openGL.Model.capsule.textured -- Models a textured capsule. -- is - -- type Item is new Model.capsule.item with private; package textured_Model is new texturing.Mixin (openGL.Model.capsule.item); type Item is new textured_Model.textured_item with private; type View is access all Item'Class; @@ -35,7 +34,6 @@ is private - -- type Item is new Model.capsule.item with type Item is new textured_Model.textured_item with record Radius : Real; @@ -44,4 +42,5 @@ private Image : asset_Name := null_Asset; end record; + end openGL.Model.capsule.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 index 181dac0..00e3f73 100644 --- 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 @@ -37,4 +37,5 @@ private type Item is new textured_Model.textured_Item with null record; + end openGL.Model.circle.lit_textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_colored_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_colored_textured.adb index 7ca70e5..069bdfb 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_colored_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_colored_textured.adb @@ -39,7 +39,7 @@ is Texture; the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius); - the_Indices : aliased constant Indices := (1, 2, 3, 4, 5, 6, 7, 2); + the_Indices : aliased constant Indices := [1, 2, 3, 4, 5, 6, 7, 2]; function new_Face (Vertices : in geometry.lit_colored_textured.Vertex_array) return Geometry_view @@ -66,13 +66,13 @@ is -- declare the_Vertices : constant Geometry.lit_colored_textured.Vertex_array - := (1 => (Site => (0.0, 0.0, 0.0), Normal => Normal, Color => +Self.Face.center_Color, Coords => (0.0, 0.0), Shine => default_Shine), + := [1 => (Site => [0.0, 0.0, 0.0], Normal => Normal, Color => +Self.Face.center_Color, Coords => (0.0, 0.0), Shine => default_Shine), 2 => (Site => the_Sites (1), Normal => Normal, Color => +Self.Face.Colors (1), Coords => (0.0, 0.0), Shine => default_Shine), 3 => (Site => the_Sites (2), Normal => Normal, Color => +Self.Face.Colors (2), Coords => (1.0, 0.0), Shine => default_Shine), 4 => (Site => the_Sites (3), Normal => Normal, Color => +Self.Face.Colors (3), Coords => (1.0, 1.0), Shine => default_Shine), 5 => (Site => the_Sites (4), Normal => Normal, Color => +Self.Face.Colors (4), Coords => (0.0, 1.0), Shine => default_Shine), 6 => (Site => the_Sites (5), Normal => Normal, color => +Self.Face.Colors (5), Coords => (0.0, 1.0), Shine => default_Shine), - 7 => (Site => the_Sites (6), Normal => Normal, Color => +Self.Face.Colors (6), Coords => (0.0, 1.0), Shine => default_Shine)); + 7 => (Site => the_Sites (6), Normal => Normal, Color => +Self.Face.Colors (6), Coords => (0.0, 1.0), Shine => default_Shine)]; begin upper_Face := new_Face (Vertices => the_Vertices); @@ -82,7 +82,7 @@ is end if; end; - return (1 => upper_Face.all'Access); + return [1 => upper_Face.all'Access]; end to_GL_Geometries; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_colored_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_colored_textured.ads index 114ba16..f71835a 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_colored_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_colored_textured.ads @@ -1,6 +1,7 @@ with openGL.Geometry, - openGL.Texture; + openGL.Texture, + openGL.Model.texturing; package openGL.Model.hexagon.lit_colored_textured @@ -8,14 +9,16 @@ package openGL.Model.hexagon.lit_colored_textured -- Models a lit, colored and textured hexagon. -- is - type Item is new Model.item with private; + package textured_Model is new texturing.Mixin (Model.hexagon.item); + + type Item is new textured_Model.textured_Item with private; type View is access all Item'Class; type Face is record center_Color : lucid_Color; -- The color at the center of the hex. Colors : lucid_Colors (1 .. 6); -- The color at each of the hexes 6 vertices. - Texture : openGL.Texture.Object := openGL.Texture.null_Object; -- The texture to be applied to the hex.. + Texture : openGL.Texture.Object := openGL.Texture.null_Object; -- The texture to be applied to the hex. end record; @@ -38,7 +41,7 @@ is private - type Item is new Model.hexagon.item with + type Item is new textured_Model.textured_Item with record Face : lit_colored_textured.Face; end record; 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 d14689e..bf0678e 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 @@ -121,7 +121,7 @@ is Texture; the_Sites : constant hexagon.Sites := vertex_Sites (Self.Radius); - the_Indices : aliased constant Indices := (1, 2, 3, 4, 5, 6, 7, 2); + 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 @@ -166,19 +166,19 @@ is -- declare the_Vertices : constant Geometry.lit_textured.Vertex_array - := (1 => (Site => (0.0, 0.0, 0.0), Normal => Normal, Coords => (0.50, 0.50), Shine => default_Shine), -- Center. + := [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. + 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; - return (1 => upper_Face.all'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 33d8d71..3dacb82 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,6 +1,7 @@ with openGL.texture_Set, - openGL.Texture; + openGL.Texture, + openGL.Model.texturing; package openGL.Model.hexagon.lit_textured @@ -8,26 +9,18 @@ package openGL.Model.hexagon.lit_textured -- Models a lit and textured hexagon. -- is - type Item is new Model.item with private; + package textured_Model is new texturing.Mixin (Model.hexagon.item); + + type Item is new textured_Model.textured_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; - texture_Applies : texture_Set.texture_Apply_array := [others => True]; - Animation : texture_Set.Animation_view; - end record; - - --------- --- Forge -- - function new_Hexagon (Radius : in Real; - Face : in lit_textured.Face) return View; + function new_Hexagon (Radius : in Real; + texture_Details : in texture_Set.Details) return View; -------------- @@ -38,41 +31,10 @@ is 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; - - - overriding - function texture_Applied (Self : in Item; Which : in texture_Set.texture_Id) return Boolean; - - overriding - procedure texture_Applied_is (Self : in out Item; Which : in texture_Set.texture_Id; - Now : in Boolean); - - overriding - procedure animate (Self : in out Item); - - private - type Item is new Model.hexagon.item with - record - Face : lit_textured.Face; - end record; + type Item is new textured_Model.textured_Item with null record; + end openGL.Model.hexagon.lit_textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.ads index db05292..9006169 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.ads @@ -1,6 +1,7 @@ with openGL.Geometry, - openGL.Texture; + openGL.Texture, + openGL.Model.texturing; package openGL.Model.hexagon_Column.lit_colored_textured_faceted @@ -8,7 +9,10 @@ package openGL.Model.hexagon_Column.lit_colored_textured_faceted -- Models a lit, colored and textured column with 6 faceted shaft sides. -- is - type Item is new Model.hexagon_Column.Item with private; + package textured_Model is new texturing.Mixin (Model.hexagon_Column.item); + + + type Item is new textured_Model.textured_Item with private; type View is access all Item'Class; @@ -51,7 +55,7 @@ is private - type Item is new Model.hexagon_Column.item with + type Item is new textured_Model.textured_Item with record upper_Face, lower_Face : hex_Face; diff --git a/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb index 24ea6bf..3996ada 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb @@ -77,12 +77,12 @@ is loop Id := texture_Id (i); - the_Geometry.Fade_is (which => Id, - now => Self.texture_Details.Fades (Id)); + the_Geometry.Fade_is (Which => Id, + Now => Self.texture_Details.Fades (Id)); - the_Geometry.Texture_is (which => Id, - now => Textures.fetch (Self.texture_Details.Textures (i))); - the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent); + the_Geometry.Texture_is (Which => Id, + Now => Textures.fetch (Self.texture_Details.Textures (i))); + the_Geometry.is_Transparent (Now => the_Geometry.Texture.is_Transparent); end loop; the_Geometry.is_Transparent (True); -- TODO: Do transparency properly. diff --git a/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.adb index 59be1cf..2a57c07 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.adb @@ -207,46 +207,4 @@ is end to_GL_Geometries; - - - ------------ - -- Texturing - -- - - -- overriding - -- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in texture_Set.fade_Level) - -- is - -- begin - -- null; - -- end Fade_is; - -- - -- - -- - -- overriding - -- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level - -- is - -- begin - -- return 0.0; - -- end Fade; - -- - -- - -- - -- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in openGL.asset_Name) - -- is - -- begin - -- Self.Image := Now; - -- end Texture_is; - -- - -- - -- - -- overriding - -- function texture_Count (Self : in Item) return Natural - -- is - -- begin - -- return 1; - -- end texture_Count; - - end openGL.Model.sphere.lit_colored_textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.ads index b84dc70..5b7a8c6 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_colored_textured.ads @@ -13,7 +13,6 @@ is package textured_Model is new texturing.Mixin (openGL.Model.sphere.item); type Item is new textured_Model.textured_item with private; - -- type Item is new Model.sphere.item with private; type View is access all Item'Class; @@ -31,28 +30,8 @@ is 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.sphere.item with -- TODO: Add 'Color' component. type Item is new textured_Model.textured_item with record Color : openGL.lucid_Color; diff --git a/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.adb index 3d916ff..1d8b06a 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.adb @@ -9,11 +9,11 @@ is --- Forge -- - function new_Sphere (Radius : in Real; - lat_Count : in Positive := default_latitude_Count; - long_Count : in Positive := default_longitude_Count; + function new_Sphere (Radius : in Real; + lat_Count : in Positive := default_latitude_Count; + long_Count : in Positive := default_longitude_Count; texture_Details : in texture_Set.Details; - Image : in asset_Name := null_Asset) return View + Image : in asset_Name := null_Asset) return View is Self : constant View := new Item; begin @@ -194,47 +194,4 @@ is end to_GL_Geometries; - - - ------------ - -- Texturing - -- - - -- overriding - -- procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in texture_Set.fade_Level) - -- is - -- begin - -- null; - -- end Fade_is; - -- - -- - -- - -- overriding - -- function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level - -- is - -- begin - -- return 0.0; - -- end Fade; - -- - -- - -- - -- procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_Id; - -- Now : in openGL.asset_Name) - -- is - -- begin - -- Self.Image := Now; - -- end Texture_is; - -- - -- - -- - -- overriding - -- function texture_Count (Self : in Item) return Natural - -- is - -- begin - -- return 1; - -- end texture_Count; - - - end openGL.Model.sphere.lit_textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.ads index e3f9b7a..400df84 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.ads @@ -14,16 +14,14 @@ is package textured_Model is new texturing.Mixin (openGL.Model.sphere.item); type Item is new textured_Model.textured_item with private; - - -- type Item is new Model.sphere.item with private; type View is access all Item'Class; - function new_Sphere (Radius : in Real; - lat_Count : in Positive := default_latitude_Count; - long_Count : in Positive := default_longitude_Count; + function new_Sphere (Radius : in Real; + lat_Count : in Positive := default_latitude_Count; + long_Count : in Positive := default_longitude_Count; texture_Details : in texture_Set.Details; - Image : in asset_Name := null_Asset) return View; + Image : in asset_Name := null_Asset) return View; overriding @@ -31,28 +29,8 @@ is 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.sphere.item with type Item is new textured_Model.textured_item with record Image : asset_Name := null_Asset; -- Usually a mercator projection to be mapped onto the sphere. diff --git a/3-mid/opengl/source/lean/model/opengl-model-sphere-textured.ads b/3-mid/opengl/source/lean/model/opengl-model-sphere-textured.ads index a699c80..753f0d3 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-sphere-textured.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-sphere-textured.ads @@ -12,7 +12,6 @@ is package textured_Model is new texturing.Mixin (openGL.Model.sphere.item); type Item is new textured_Model.textured_item with private; - -- type Item is new Model.sphere.item with private; type View is access all Item'Class; @@ -38,11 +37,11 @@ is private - -- type Item is new Model.sphere.item with type Item is new textured_Model.textured_item with record Image : asset_Name := null_Asset; -- Usually a mercator projection to be mapped onto the sphere. is_Skysphere : Boolean := False; end record; + end openGL.Model.sphere.textured; diff --git a/3-mid/opengl/source/lean/model/opengl-model-texturing.adb b/3-mid/opengl/source/lean/model/opengl-model-texturing.adb index ffce1d8..e00c2a1 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-texturing.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-texturing.adb @@ -1,13 +1,5 @@ -with - GL.lean, - GL.Binding, - ada.Strings.fixed; - - package body openGL.Model.texturing is - use GL; - ------------- --- Mixin --- diff --git a/3-mid/opengl/source/lean/opengl-texture.adb b/3-mid/opengl/source/lean/opengl-texture.adb index 5645586..8bad11d 100644 --- a/3-mid/opengl/source/lean/opengl-texture.adb +++ b/3-mid/opengl/source/lean/opengl-texture.adb @@ -9,8 +9,6 @@ with ada.unchecked_Deallocation; -with ada.Text_IO; - package body openGL.Texture is @@ -159,8 +157,7 @@ is procedure set_Image (Self : in out Object; To : in Image; use_Mipmaps : in Boolean := True) is - use GL.Binding, - ada.Text_IO; + use GL.Binding; the_Image : Image renames To; min_Width : constant Positive := the_Image'Length (2); diff --git a/3-mid/opengl/source/lean/renderer/opengl-culler-frustum.ads b/3-mid/opengl/source/lean/renderer/opengl-culler-frustum.ads index 657c2da..8ee339c 100644 --- a/3-mid/opengl/source/lean/renderer/opengl-culler-frustum.ads +++ b/3-mid/opengl/source/lean/renderer/opengl-culler-frustum.ads @@ -1,6 +1,3 @@ -with - ada.unchecked_Conversion; - package openGL.Culler.frustum -- -- Provides a frustrum culler. diff --git a/3-mid/opengl/source/lean/shader/opengl-shader.adb b/3-mid/opengl/source/lean/shader/opengl-shader.adb index 19ff640..70d2e6b 100644 --- a/3-mid/opengl/source/lean/shader/opengl-shader.adb +++ b/3-mid/opengl/source/lean/shader/opengl-shader.adb @@ -116,7 +116,6 @@ is -- and False then declare - use ada.Text_IO; compile_Log : constant String := Self.shader_info_Log; begin new_Line; @@ -149,8 +148,7 @@ is procedure define (Self : in out Item; Kind : in Shader.Kind; shader_Snippets : in asset_Names) is - use ada.Text_IO, - interfaces.C; + use interfaces.C; the_Source : aliased constant C.char_array := to_C_char_array (shader_Snippets); begin @@ -251,14 +249,13 @@ is function read_text_File (Filename : in String) return C.char_array is - use ada.Text_IO, - ada.Strings.unbounded; + use ada.Strings.unbounded; use type interfaces.C.size_t; - NL : constant String := "" & ada.characters.latin_1.LF; - the_File : ada.Text_IO.File_type; - Pad : unbounded_String; + NL : constant String := "" & ada.characters.latin_1.LF; + the_File : ada.Text_IO.File_type; + Pad : unbounded_String; begin if Filename = "" diff --git a/3-mid/opengl/source/opengl.adb b/3-mid/opengl/source/opengl.adb index 477d92c..4043560 100644 --- a/3-mid/opengl/source/opengl.adb +++ b/3-mid/opengl/source/opengl.adb @@ -1,6 +1,6 @@ with - ada.Strings.Hash, - ada.unchecked_Conversion; + ada.Strings.Hash; + package body openGL is diff --git a/3-mid/opengl/source/platform/egl/opengl-surface.adb b/3-mid/opengl/source/platform/egl/opengl-surface.adb index 783b56a..a977954 100644 --- a/3-mid/opengl/source/platform/egl/opengl-surface.adb +++ b/3-mid/opengl/source/platform/egl/opengl-surface.adb @@ -3,7 +3,6 @@ with opengl.Display .privvy, eGL.Binding, - interfaces.c.Strings, System;