diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.adb index 47f0f68..32c5f2d 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.adb @@ -129,6 +129,8 @@ is name => +Attribute_3_Name_ptr); Errors.log; end; + + textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access); end if; Self.Program_is (the_Program.all'Access); @@ -182,6 +184,7 @@ is end Vertices_are; + overriding procedure Indices_are (Self : in out Item; Now : in Indices; for_Facia : in Positive) @@ -191,23 +194,23 @@ is end Indices_are; - overriding - procedure enable_Textures (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_Textures; + -- overriding + -- procedure enable_Textures (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_Textures; end openGL.Geometry.colored_textured; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.ads index 5c91512..b183492 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-colored_textured.ads @@ -1,3 +1,12 @@ +with +openGL.texture_Set; + + +private +with + openGL.Geometry.texturing; + + package openGL.Geometry.colored_textured -- -- Supports per-vertex site, color and texture. @@ -36,13 +45,22 @@ is private - type Item is new Geometry.item with + package textured_Geometry is new texturing.Mixin; + + + type Item is new textured_Geometry.item with record null; end record; - overriding - procedure enable_Textures (Self : in out Item); + -- type Item is new Geometry.item with + -- record + -- null; + -- end record; + -- + -- + -- overriding + -- procedure enable_Textures (Self : in out Item); end openGL.Geometry.colored_textured; 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 796a995..b3a603f 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 @@ -180,6 +180,12 @@ is Index => the_Program.Program.Attribute (named => Name_5).gl_Location, Name => +Attribute_5_Name_ptr); Errors.log; + + + + -- TODO: This will fail. Split this package into 'lit_colored_textured' and 'lit_colored_text'. + -- + textured_Geometry.create_Uniforms (for_Program => the_Program.Program.all'Access); end define; Self : constant Geometry_view := new Geometry.lit_colored_textured.item; @@ -281,68 +287,68 @@ is --- 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; - + -- 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 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 51c3bfa..b7ccc7c 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,6 +1,10 @@ with openGL.texture_Set; +private +with + openGL.Geometry.texturing; + package openGL.Geometry.lit_colored_textured -- @@ -42,30 +46,41 @@ is --- 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 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; - - 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; + -- 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 + package textured_Geometry is new texturing.Mixin; + + + type Item is new textured_Geometry.item with record - Textures : texture_Set.Item; + null; end record; - overriding - procedure enable_Textures (Self : in out Item); + -- 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 d421a4f..e137385 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 @@ -287,35 +287,35 @@ is - overriding - procedure enable_Textures (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 - if not white_Texture.is_Defined - then - declare - use Palette; - white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; - begin - white_Texture := openGL.Texture.Forge.to_Texture (white_Image); - end; - end if; - - white_Texture.enable; - else - Self.Texture.enable; - end if; - end enable_Textures; + -- overriding + -- procedure enable_Textures (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 + -- if not white_Texture.is_Defined + -- then + -- declare + -- use Palette; + -- white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; + -- begin + -- white_Texture := openGL.Texture.Forge.to_Texture (white_Image); + -- end; + -- end if; + -- + -- white_Texture.enable; + -- else + -- Self.Texture.enable; + -- end if; + -- end enable_Textures; end openGL.Geometry.lit_colored_textured_skinned; 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 cc6f980..2d8fe72 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,5 +1,12 @@ with - openGL.Program.lit.colored_textured_skinned; + openGL.Program.lit.colored_textured_skinned, + openGL.texture_Set; + + +private +with + openGL.Geometry.texturing; + package openGL.Geometry.lit_colored_textured_skinned @@ -50,9 +57,18 @@ is private - type Item is new Geometry.item with null record; + package textured_Geometry is new texturing.Mixin; - overriding - procedure enable_Textures (Self : in out Item); + + type Item is new textured_Geometry.item with + record + null; + 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.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured.ads index a4efe47..e593ef3 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 @@ -69,11 +69,9 @@ private package textured_Geometry is new texturing.Mixin; - -- type Item is new Geometry.item with type Item is new textured_Geometry.item with record null; - -- texture_Set : openGL.texture_Set.Item; end record; 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 af646b5..fc29b21 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 @@ -261,35 +261,35 @@ is - overriding - procedure enable_Textures (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 - if not white_Texture.is_Defined - then - declare - use Palette; - white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; - begin - white_Texture := openGL.Texture.Forge.to_Texture (white_Image); - end; - end if; - - white_Texture.enable; - else - Self.Texture.enable; - end if; - end enable_Textures; + -- overriding + -- procedure enable_Textures (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 + -- if not white_Texture.is_Defined + -- then + -- declare + -- use Palette; + -- white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]]; + -- begin + -- white_Texture := openGL.Texture.Forge.to_Texture (white_Image); + -- end; + -- end if; + -- + -- white_Texture.enable; + -- else + -- Self.Texture.enable; + -- end if; + -- end enable_Textures; end openGL.Geometry.lit_textured_skinned; 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 537e2a9..fa2a405 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,5 +1,10 @@ with - openGL.Program.lit.textured_skinned; + openGL.Program.lit.textured_skinned, + openGL.texture_Set; + +private +with + openGL.Geometry.texturing; package openGL.Geometry.lit_textured_skinned @@ -49,9 +54,18 @@ is private - type Item is new Geometry.item with null record; + package textured_Geometry is new texturing.Mixin; - overriding - procedure enable_Textures (Self : in out Item); + + type Item is new textured_Geometry.item with + record + null; + 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 0a366e0..f7f2b9a 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.adb @@ -110,6 +110,8 @@ is glBindAttribLocation (program => the_Program.gl_Program, index => the_Program.Attribute (named => Name_2).gl_Location, name => +Attribute_2_Name_ptr); + + textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access); end; end if; @@ -137,6 +139,7 @@ is Element => Vertex, Element_Array => Vertex_array); + procedure Vertices_are (Self : in out Item; Now : in Vertex_array) is use openGL_Buffer_of_geometry_Vertices.Forge; @@ -156,12 +159,13 @@ is end Vertices_are; + overriding procedure Indices_are (Self : in out Item; Now : in Indices; for_Facia : in Positive) is begin - raise Error with "opengl gemoetry textured - 'Indices_are' ~ TODO"; + raise Error with "opengl geometry textured - 'Indices_are' ~ TODO"; end Indices_are; @@ -169,67 +173,67 @@ is --- 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; + -- 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; 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 b151715..d14f92b 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-textured.ads @@ -2,6 +2,11 @@ with openGL.texture_Set; +private +with + openGL.Geometry.texturing; + + package openGL.Geometry.textured -- -- Supports per-vertex site and texture. @@ -42,30 +47,39 @@ is --- 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; + -- 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 - type Item is new Geometry.item with + package textured_Geometry is new texturing.Mixin; + + + type Item is new textured_Geometry.item with record - Textures : texture_Set.Item; + null; end record; - overriding - procedure enable_Textures (Self : in out Item); + -- 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 7ac815f..2ca950c 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb @@ -120,12 +120,9 @@ is - - - overriding - procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_ID; - Now : in texture_Set.fade_Level) + procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level; + Which : in texture_Set.texture_ID := 1) is begin Self.texture_Set.Textures (which).Fade := Now; @@ -134,7 +131,7 @@ is overriding - function Fade (Self : in Item; Which : in texture_Set.texture_ID) return texture_Set.fade_Level + function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level is begin return Self.texture_Set.Textures (which).Fade; @@ -143,8 +140,8 @@ is overriding - procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_ID; - Now : in openGL.Texture.Object) + procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object; + Which : in texture_Set.texture_ID := 1) is begin Texture_is (in_Set => Self.texture_Set, @@ -155,7 +152,7 @@ is overriding - function Texture (Self : in Item; Which : texture_Set.texture_ID) return openGL.Texture.Object + function Texture (Self : in Item; Which : texture_Set.texture_ID := 1) return openGL.Texture.Object is begin return openGL.texture_Set.Texture (in_Set => Self.texture_Set, @@ -164,23 +161,23 @@ is - 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 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; 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 f66a209..0452519 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads @@ -66,21 +66,23 @@ is overriding - procedure Fade_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in texture_Set.fade_Level); + procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level; + Which : in texture_Set.texture_ID := 1); overriding - function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level; + function Fade (Self : in Item; Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level; overriding - procedure Texture_is (Self : in out Item; Which : texture_Set.texture_ID; Now : in openGL.Texture.Object); + procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object; + Which : in texture_Set.texture_ID := 1); overriding - function Texture (Self : in Item; Which : texture_Set.texture_ID) return openGL.Texture.Object; + 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; + -- overriding + -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object); + -- + -- overriding + -- function Texture (Self : in Item) return openGL.Texture.Object; overriding diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb index 9141999..724a8e2 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb @@ -103,7 +103,7 @@ is - function Fade (Self : in Item; Which : texture_Set.texture_ID) return texture_Set.fade_Level + function Fade (Self : in Item; Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level is begin raise program_Error with "Geometry has no texture."; @@ -112,16 +112,16 @@ is - function Texture (Self : in Item) return openGL.Texture.Object - is - begin - raise program_Error with "Geometry has no texture."; - return openGL.Texture.null_Object; - end Texture; + -- function Texture (Self : in Item) return openGL.Texture.Object + -- is + -- begin + -- raise program_Error with "Geometry has no texture."; + -- return openGL.Texture.null_Object; + -- end Texture; - function Texture (Self : in Item; Which : in texture_Set.texture_ID) return openGL.Texture.Object + function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object is begin raise program_Error with "Geometry has no texture."; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads index 5123255..24894cc 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads @@ -54,14 +54,16 @@ is --- Texturing -- - procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_ID; Now : in texture_Set.fade_Level) is null; - function Fade (Self : in Item; Which : in texture_Set.texture_ID) return texture_Set.fade_Level; + procedure Fade_is (Self : in out Item; Now : in texture_Set.fade_Level; + Which : in texture_Set.texture_ID := 1) is null; + function Fade (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level; - procedure Texture_is (Self : in out Item; Which : in texture_Set.texture_ID; Now : in openGL.Texture.Object) is null; - function Texture (Self : in Item; Which : in texture_Set.texture_ID) return openGL.Texture.Object; + procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object; + Which : in texture_Set.texture_ID := 1) is null; + function Texture (Self : in Item; Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object; - procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) is null; - function Texture (Self : in Item) return openGL.Texture.Object; + -- procedure Texture_is (Self : in out Item; Now : in openGL.Texture.Object) is null; + -- function Texture (Self : in Item) return openGL.Texture.Object;