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 2cb4372..7f55243 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb @@ -48,9 +48,42 @@ is + -- procedure enable (for_Model : in openGL.Model.view; + -- Uniforms : in texturing.Uniforms; + -- texture_Set : in openGL.texture_Set.Item) + -- is + -- use GL.Binding, + -- GL.lean; + -- + -- use type GLint; + -- + -- begin + -- if for_Model.texture_Count > 0 + -- then + -- for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count) + -- loop + -- Uniforms.Textures (i).tiling_Uniform .Value_is (Vector_2' ((for_Model.Tiling (Which => i).S, + -- for_Model.Tiling (Which => i).T))); + -- Uniforms.Textures (i).fade_Uniform .Value_is (Real (for_Model.Fade (Which => i))); + -- Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (Which => i)); + -- + -- glUniform1i (Uniforms.Textures (i).texture_Uniform.gl_Variable, + -- GLint (i) - 1); + -- glActiveTexture (all_texture_Units (i)); + -- glBindTexture (GL_TEXTURE_2D, + -- texture_Set.Textures (i).Object.Name); + -- end loop; + -- end if; + -- + -- Uniforms.Count.Value_is (for_Model.texture_Count); + -- end enable; + + + + procedure enable (for_Model : in openGL.Model.view; - Uniforms : in texturing.Uniforms; - texture_Set : in openGL.texture_Set.Item) + Uniforms : in texturing.Uniforms) + -- texture_Set : in openGL.texture_Set.Item) is use GL.Binding, GL.lean; @@ -71,7 +104,7 @@ is GLint (i) - 1); glActiveTexture (all_texture_Units (i)); glBindTexture (GL_TEXTURE_2D, - texture_Set.Textures (i).Object.Name); + for_Model.texture_Object (i).Name); end loop; end if; @@ -134,7 +167,9 @@ is Which : in texture_Set.texture_ID := 1) is begin - Self.texture_Set.Textures (Which).Fade := Now; + -- Self.texture_Set.Textures (Which).Fade := Now; + Self.Model.Fade_is (Which => Which, + Now => Now); end Fade_is; @@ -143,7 +178,8 @@ is 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; + -- return Self.texture_Set.Textures (Which).Fade; + return Self.Model.Fade (Which => Which); end Fade; @@ -153,9 +189,11 @@ is Which : in texture_Set.texture_ID := 1) is begin - Texture_is (in_Set => Self.texture_Set, - Which => Which, - Now => Now); + -- Texture_is (in_Set => Self.texture_Set, + -- Which => Which, + -- Now => Now); + Self.Model.texture_Object_is (Which => Which, + Now => Now); end Texture_is; @@ -164,8 +202,9 @@ is 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, - Which => Which); + -- return openGL.texture_Set.Texture (in_Set => Self.texture_Set, + -- Which => Which); + return Self.Model.texture_Object (Which); end Texture; @@ -175,7 +214,8 @@ is Which : in texture_Set.texture_ID := 1) is begin - Self.texture_Set.Textures (Which).Applied := Now; + -- Self.texture_Set.Textures (Which).Applied := Now; + Self.Model.texture_Applied_is (Which, Now); end texture_Applied_is; @@ -184,7 +224,8 @@ is function texture_Applied (Self : in Item; Which : in texture_Set.texture_ID := 1) return Boolean is begin - return Self.texture_Set.Textures (Which).Applied; + -- return Self.texture_Set.Textures (Which).Applied; + return Self.Model.texture_Applied (Which); end texture_Applied; @@ -194,7 +235,9 @@ is Which : in texture_Set.texture_ID := 1) is begin - Self.texture_Set.Textures (Which).Tiling := Now; + -- Self.texture_Set.Textures (Which).Tiling := Now; + Self.Model.Tiling_is (Which => Which, + Now => Now); end Tiling_is; @@ -203,7 +246,8 @@ is function Tiling (Self : in Item; Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling is begin - return Self.texture_Set.Textures (Which).Tiling; + -- return Self.texture_Set.Textures (Which).Tiling; + return Self.Model.Tiling (Which); end Tiling; @@ -216,9 +260,11 @@ is 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); texturing.enable (for_Model => Self.Model.all'Access, - Uniforms => texture_Uniforms, - texture_Set => Self.texture_Set); + Uniforms => texture_Uniforms); end enable_Textures; 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 9c3f800..183fcaa 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads @@ -40,9 +40,12 @@ is --- Operations -- + -- procedure enable (for_Model : in openGL.Model.view; + -- Uniforms : in texturing.Uniforms; + -- texture_Set : in openGL.texture_Set.Item); + procedure enable (for_Model : in openGL.Model.view; - Uniforms : in texturing.Uniforms; - texture_Set : in openGL.texture_Set.Item); + Uniforms : in texturing.Uniforms); @@ -99,7 +102,7 @@ is type Item is new Geometry.item with record - texture_Set : openGL.texture_Set.item; + null; --texture_Set : openGL.texture_Set.item; end record; end Mixin; diff --git a/3-mid/opengl/source/lean/model/opengl-model-any.adb b/3-mid/opengl/source/lean/model/opengl-model-any.adb index 92b8014..ea219b4 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-any.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-any.adb @@ -420,6 +420,9 @@ is deallocate (the_Vertices); destroy (the_Model); + Self.Geometry.Model_is (Self'unchecked_Access); + + -- Set the geometry texture. -- if Self.Texture /= null_Asset 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 3a83044..31fa1fd 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 @@ -44,7 +44,7 @@ is -- overriding - function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; + function to_GL_Geometries (Self : access Item; Textures : access openGL.Texture.name_Map_of_texture'Class; Fonts : in Font.font_id_Map_of_font) return Geometry.views is pragma unreferenced (Textures, Fonts); diff --git a/3-mid/opengl/source/lean/model/opengl-model-arrow-colored.ads b/3-mid/opengl/source/lean/model/opengl-model-arrow-colored.ads index 1d3a0e2..4fa742d 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-arrow-colored.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-arrow-colored.ads @@ -27,7 +27,7 @@ is -- overriding - function to_GL_Geometries (Self : access Item; Textures : access Texture.name_Map_of_texture'Class; + function to_GL_Geometries (Self : access Item; Textures : access openGL.Texture.name_Map_of_texture'Class; Fonts : in Font.font_id_Map_of_font) return Geometry.views; procedure end_Site_is (Self : in out Item; Now : in Vector_3; diff --git a/3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.adb index bd33c55..0464488 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-billboard-colored_textured.adb @@ -57,16 +57,16 @@ is the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices).all'Access; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices.all); the_Geometry.add (the_Primitive); the_Geometry.is_Transparent; - the_Geometry.Model_is (Self.all'unchecked_Access); return the_Geometry; end new_Face; - Color : constant rgba_Color := +Self.Color; - the_Face : Geometry_view; + Color : constant rgba_Color := +Self.Color; + the_Face : Geometry_view; begin declare 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 8067797..fa48ff8 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 @@ -60,6 +60,7 @@ is the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices).all'Access; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices); the_Geometry.add (the_Primitive); the_Geometry.is_Transparent; @@ -113,8 +114,6 @@ is end if; end; - the_Face.Model_is (Self.all'unchecked_Access); - return [1 => the_Face.all'Access]; end to_GL_Geometries; 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 c7fbac4..6c99412 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 @@ -51,9 +51,9 @@ is (triangle_Fan, the_Indices).all'Access; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices.all); the_Geometry.add (the_Primitive); - the_Geometry.Model_is (Self.all'unchecked_Access); return the_Geometry; end new_Face; 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 ab0fc9c..130e5be 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 @@ -48,8 +48,9 @@ is the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry; the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan, - the_Indices).all'Access; + the_Indices).all'unchecked_Access; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices); the_Geometry.add (the_Primitive); @@ -80,7 +81,6 @@ is then front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name)); front_Face.is_Transparent (now => front_Face.Texture.is_Transparent); - front_Face.Model_is (Self.all'unchecked_Access); end if; end; @@ -100,7 +100,6 @@ is then rear_Face.Texture_is (Textures.fetch (Self.Faces (Rear).texture_Name)); rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent); - rear_Face.Model_is (Self.all'unchecked_Access); end if; end; @@ -120,7 +119,6 @@ is then upper_Face.Texture_is (Textures.fetch (Self.Faces (Upper).texture_Name)); upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent); - upper_Face.Model_is (Self.all'unchecked_Access); end if; end; @@ -140,7 +138,6 @@ is then lower_Face.Texture_is (Textures.fetch (Self.Faces (Lower).texture_Name)); lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent); - lower_Face.Model_is (Self.all'unchecked_Access); end if; end; @@ -160,7 +157,6 @@ is then left_Face.Texture_is (Textures.fetch (Self.Faces (Left).texture_Name)); left_Face.is_Transparent (now => left_Face.Texture.is_Transparent); - left_Face.Model_is (Self.all'unchecked_Access); end if; end; @@ -180,7 +176,6 @@ is then right_Face.Texture_is (Textures.fetch (Self.Faces (Right).texture_Name)); right_Face.is_Transparent (now => right_Face.Texture.is_Transparent); - right_Face.Model_is (Self.all'unchecked_Access); end if; end; 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 36103d7..ebb3a32 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 @@ -51,6 +51,7 @@ is the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices).all'Access; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices); the_Geometry.add (the_Primitive); @@ -86,7 +87,6 @@ is then front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name)); front_Face.is_Transparent (now => front_Face.Texture.is_Transparent); - front_Face.Model_is (Self.all'unchecked_Access); end if; end; @@ -106,7 +106,6 @@ is then rear_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name)); rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent); - rear_Face.Model_is (Self.all'unchecked_Access); end if; end; @@ -126,7 +125,6 @@ is then upper_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name)); upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent); - upper_Face.Model_is (Self.all'unchecked_Access); end if; end; @@ -146,7 +144,6 @@ is then lower_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name)); lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent); - lower_Face.Model_is (Self.all'unchecked_Access); end if; end; @@ -166,7 +163,6 @@ is then left_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name)); left_Face.is_Transparent (now => left_Face.Texture.is_Transparent); - left_Face.Model_is (Self.all'unchecked_Access); end if; end; @@ -186,7 +182,6 @@ is then right_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name)); right_Face.is_Transparent (now => right_Face.Texture.is_Transparent); - right_Face.Model_is (Self.all'unchecked_Access); end if; end; diff --git a/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored_textured.adb index 475f4aa..8c62e3e 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-capsule-lit_colored_textured.adb @@ -80,6 +80,8 @@ is begin -- Define capsule shaft, -- + the_shaft_Geometry.Model_is (Self.all'unchecked_Access); + declare vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge. indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle. @@ -197,8 +199,6 @@ is begin the_shaft_Geometry.add (Primitive.view (the_Primitive)); end; - - the_shaft_Geometry.Model_is (Self.all'unchecked_Access); end; @@ -234,7 +234,10 @@ is longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count); a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords. + begin + cap_Geometry.Model_is (Self.all'unchecked_Access); + if not is_Fore then a := Degrees_360; @@ -397,8 +400,6 @@ is end; end; - cap_Geometry.Model_is (Self.all'unchecked_Access); - return cap_Geometry; end new_Cap; 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 6b48e2b..5a3b1af 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 @@ -77,6 +77,8 @@ is begin -- Define capsule shaft, -- + the_shaft_Geometry.Model_is (Self.all'unchecked_Access); + declare vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge. indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle. @@ -190,8 +192,6 @@ is begin the_shaft_Geometry.add (Primitive.view (the_Primitive)); end; - - the_shaft_Geometry.Model_is (Self.all'unchecked_Access); end; @@ -228,6 +228,8 @@ is a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords. begin + cap_Geometry.Model_is (Self.all'unchecked_Access); + if not is_Fore then a := Degrees_360; @@ -388,8 +390,6 @@ is end; end; - cap_Geometry.Model_is (Self.all'unchecked_Access); - return cap_Geometry; end new_Cap; diff --git a/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.adb b/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.adb index 6b5b718..e42e934 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-capsule-textured.adb @@ -38,8 +38,7 @@ is is pragma unreferenced (Textures, Fonts); - use --Geometry, - Geometry.textured, + use Geometry.textured, real_Functions; Length : constant Real := Self.Height; @@ -77,6 +76,8 @@ is begin -- Define capsule shaft, -- + the_shaft_Geometry.Model_is (Self.all'unchecked_Access); + declare vertex_Count : constant Index_t := Index_t (sides_Count * 2 + 2); -- 2 triangles per side plus 2 since we cannot share the first and last edge. indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3); -- 2 triangles per side with 3 vertices per triangle. @@ -209,7 +210,10 @@ is longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count); a, b : Real := 0.0; -- Angular 'cursors' used to track lat/long for texture coords. + begin + cap_Geometry.Model_is (Self.all'unchecked_Access); + if not is_Fore then a := Degrees_360; @@ -371,9 +375,6 @@ is cap_2_Geometry := new_Cap (is_Fore => False); end; - the_shaft_Geometry.Model_is (Self.all'unchecked_Access); - cap_1_Geometry .Model_is (Self.all'unchecked_Access); - cap_2_Geometry .Model_is (Self.all'unchecked_Access); return [1 => the_shaft_Geometry.all'Access, 2 => cap_1_Geometry.all'Access, diff --git a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb index 92f4c4c..880ccc8 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-circle-lit_textured.adb @@ -80,6 +80,7 @@ is Id : texture_Set.texture_Id; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices); the_Geometry.add (Primitive.view (the_Primitive)); @@ -90,8 +91,8 @@ is 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))); @@ -99,7 +100,6 @@ is end loop; the_Geometry.is_Transparent (True); -- TODO: Do transparency properly. - the_Geometry.Model_is (Self.all'unchecked_Access); return the_Geometry; end new_Geometry; 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 069bdfb..e2c6d97 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 @@ -52,6 +52,7 @@ is the_Primitive : constant Primitive.indexed.view := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices); begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices); the_Geometry.add (Primitive.view (the_Primitive)); 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 c10a4e8..410cd30 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 @@ -58,7 +58,9 @@ is := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices); Id : texture_Set.texture_Id; + begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices); the_Geometry.add (Primitive.view (the_Primitive)); @@ -66,8 +68,8 @@ 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))); @@ -75,7 +77,6 @@ is end loop; the_Geometry.is_Transparent (True); -- TODO: Do transparency properly. - the_Geometry.Model_is (Self.all'unchecked_Access); return the_Geometry; end new_Face; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_faceted.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_faceted.adb index e504139..820686c 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_faceted.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_faceted.adb @@ -70,8 +70,9 @@ is := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices); begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices.all); - the_Geometry.add (Primitive.view (the_Primitive)); + the_Geometry.add (Primitive.view (the_Primitive)); return the_Geometry; end new_hexagon_Face; @@ -90,6 +91,7 @@ is the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices.all); the_Geometry.add (the_Primitive); diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.adb index 146b799..6652289 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_faceted.adb @@ -75,8 +75,9 @@ is := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices); begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices.all); - the_Geometry.add (Primitive.view (the_Primitive)); + the_Geometry.add (Primitive.view (the_Primitive)); return the_Geometry; end new_hexagon_Face; @@ -95,6 +96,7 @@ is the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices.all); the_Geometry.add (the_Primitive); diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_rounded.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_rounded.adb index acb0f4e..92c1275 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_rounded.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_colored_textured_rounded.adb @@ -77,6 +77,7 @@ is the_Indices).all'Access; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices); the_Geometry.add (the_Primitive); @@ -99,6 +100,7 @@ is := Primitive.indexed.new_Primitive (triangle_Strip, the_Indices); begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices); the_Geometry.add (Primitive.view (the_Primitive)); diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_faceted.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_faceted.adb index 1072855..d4c79c9 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_faceted.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_faceted.adb @@ -71,8 +71,9 @@ is := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices); begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices.all); - the_Geometry.add (Primitive.view (the_Primitive)); + the_Geometry.add (Primitive.view (the_Primitive)); return the_Geometry; end new_hexagon_Face; @@ -91,6 +92,7 @@ is the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices.all); the_Geometry.add (the_Primitive); diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_rounded.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_rounded.adb index 3ee884b..a1d1e52 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_rounded.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon_column-lit_textured_rounded.adb @@ -73,6 +73,7 @@ is the_Indices).all'Access; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices); the_Geometry.add (the_Primitive); @@ -95,6 +96,7 @@ is := Primitive.indexed.new_Primitive (triangle_Strip, the_Indices); begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices); the_Geometry.add (Primitive.view (the_Primitive)); 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 6966d56..20a6204 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 @@ -70,6 +70,7 @@ is Id : texture_Set.texture_Id; begin + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.Vertices_are (Vertices); the_Geometry.add (Primitive.view (the_Primitive)); @@ -77,8 +78,8 @@ 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))); @@ -86,7 +87,6 @@ is end loop; the_Geometry.is_Transparent (True); -- TODO: Do transparency properly. - the_Geometry.Model_is (Self.all'unchecked_Access); return the_Geometry; end new_Geometry; 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 2a57c07..850321a 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 @@ -73,6 +73,8 @@ is the_Geometry : constant Geometry_view := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => False); begin + the_Geometry.Model_is (Self.all'unchecked_Access); + set_Sites: declare use linear_Algebra, @@ -201,7 +203,6 @@ is the_Geometry.add (Primitive.view (the_Primitive)); end; - the_Geometry.Model_is (Self.all'unchecked_Access); return [1 => Geometry.view (the_Geometry)]; end to_GL_Geometries; 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 1d8b06a..c5c4db1 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 @@ -65,6 +65,8 @@ is the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry; begin + the_Geometry.Model_is (Self.all'unchecked_Access); + set_Sites: declare use linear_Algebra, @@ -188,7 +190,6 @@ is the_Geometry.add (Primitive.view (the_Primitive)); end; - the_Geometry.Model_is (Self.all'unchecked_Access); return [1 => Geometry.view (the_Geometry)]; end to_GL_Geometries; diff --git a/3-mid/opengl/source/lean/model/opengl-model-sphere-textured.adb b/3-mid/opengl/source/lean/model/opengl-model-sphere-textured.adb index f7f2845..5cf4854 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-sphere-textured.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-sphere-textured.adb @@ -70,6 +70,8 @@ is the_Geometry : constant Geometry.textured.view := Geometry.textured.new_Geometry; begin + the_Geometry.Model_is (Self.all'unchecked_Access); + set_Sites: declare use linear_Algebra_3d; @@ -199,7 +201,6 @@ is the_Geometry.add (Primitive.view (the_Primitive)); end; - the_Geometry.Model_is (Self.all'unchecked_Access); return [1 => Geometry.view (the_Geometry)]; end to_GL_Geometries; diff --git a/3-mid/opengl/source/lean/model/opengl-model-terrain.adb b/3-mid/opengl/source/lean/model/opengl-model-terrain.adb index 388f89b..0db9530 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-terrain.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-terrain.adb @@ -81,6 +81,8 @@ is the_Geometry : constant Geometry.lit_textured.view := Geometry.lit_textured.new_Geometry; begin + the_Geometry.Model_is (Self.all'unchecked_Access); + set_Sites: declare vert_Id : Index_t := 0; @@ -228,8 +230,6 @@ is the_Geometry.add (Primitive.view (the_Primitive)); end; - the_Geometry.Model_is (Self.all'unchecked_Access); - return [1 => Geometry.view (the_Geometry)]; end to_GL_Geometries; diff --git a/3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.adb b/3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.adb index 28afe43..28854ef 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.adb @@ -284,59 +284,16 @@ is the_Primitive := Primitive.indexed .new_Primitive (Triangles, the_Indices); the_Geometry := Geometry.lit_colored_textured.new_Geometry (texture_is_Alpha => True); + the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.add (Primitive.view (the_Primitive)); the_Geometry.Vertices_are (the_Vertices); the_Geometry.Texture_is (Texture.Forge.to_Texture (Self.Font.gl_Texture)); - the_Geometry.Model_is (Self.all'unchecked_Access); the_Geometry.is_Transparent; - -- the_Geometry.texture_Details_is (openGL.texture_Set.to_Details ([1 => to_Asset ("assets/textures/Face1.bmp")])); return [1 => Geometry.view (the_Geometry)]; end; 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.Text.lit_colored; 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 4ebcf8b..9886fa5 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-texturing.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-texturing.adb @@ -8,6 +8,26 @@ is package body Mixin is + overriding + procedure texture_Object_is (Self : in out textured_Item; Which : in texture_Set.texture_Id; + Now : in openGL.texture.Object) + is + begin + Self.texture_Details.Objects (Integer (Which)) := Now; + end texture_Object_is; + + + + overriding + function texture_Object (Self : in textured_Item; Which : in texture_Set.texture_Id) return openGL.texture.Object + is + begin + return Self.texture_Details.Objects (Integer (Which)); + end texture_Object; + + + + overriding procedure Fade_is (Self : in out textured_Item; Which : in texture_Set.texture_Id; Now : in texture_Set.fade_Level) diff --git a/3-mid/opengl/source/lean/model/opengl-model-texturing.ads b/3-mid/opengl/source/lean/model/opengl-model-texturing.ads index 1e62846..73aa282 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-texturing.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-texturing.ads @@ -18,6 +18,13 @@ is is type textured_Item is abstract new Item with private; + overriding + procedure texture_Object_is (Self : in out textured_Item; Which : in texture_Set.texture_Id; + Now : in openGL.texture.Object); + + overriding + function texture_Object (Self : in textured_Item; Which : in texture_Set.texture_Id) return openGL.texture.Object; + overriding function Fade (Self : in textured_Item; Which : in texture_Set.texture_Id) return texture_Set.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 5965013..5b206d2 100644 --- a/3-mid/opengl/source/lean/model/opengl-model.adb +++ b/3-mid/opengl/source/lean/model/opengl-model.adb @@ -104,7 +104,7 @@ is - procedure create_GL_Geometries (Self : in out Item'Class; Textures : access Texture.name_Map_of_texture'Class; + procedure create_GL_Geometries (Self : in out Item'Class; Textures : access openGL.Texture.name_Map_of_texture'Class; Fonts : in Font.font_id_Map_of_font) is all_Geometries : constant Geometry.views := Self.to_GL_Geometries (Textures, Fonts); @@ -222,6 +222,24 @@ is use ada.Tags; + function texture_Object (Self : in Item; Which : in texture_Set.texture_Id) return openGL.texture.Object + is + begin + raise program_Error with External_Tag (Model.item'Class (Self)'Tag) & " Model does not support texturing."; + return openGL.Texture.null_Object; + end texture_Object; + + + + procedure texture_Object_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in openGL.texture.Object) + is + begin + raise program_Error with External_Tag (Model.item'Class (Self)'Tag) & " Model does not support texturing."; + end texture_Object_is; + + + procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; Now : in texture_Set.fade_Level) is diff --git a/3-mid/opengl/source/lean/model/opengl-model.ads b/3-mid/opengl/source/lean/model/opengl-model.ads index e1d08bf..4c046df 100644 --- a/3-mid/opengl/source/lean/model/opengl-model.ads +++ b/3-mid/opengl/source/lean/model/opengl-model.ads @@ -74,6 +74,10 @@ is -- Texturing -- + function texture_Object (Self : in Item; Which : in texture_Set.texture_Id) return texture.Object; + procedure texture_Object_is (Self : in out Item; Which : in texture_Set.texture_Id; + Now : in texture.Object); + function Fade (Self : in Item; Which : in texture_Set.texture_Id) return texture_Set.fade_Level; procedure Fade_is (Self : in out Item; Which : in texture_Set.texture_Id; Now : in texture_Set.fade_Level); diff --git a/3-mid/opengl/source/lean/opengl-texture_set.ads b/3-mid/opengl/source/lean/opengl-texture_set.ads index 12f0ece..3b8b6a4 100644 --- a/3-mid/opengl/source/lean/opengl-texture_set.ads +++ b/3-mid/opengl/source/lean/opengl-texture_set.ads @@ -49,10 +49,10 @@ is type fadeable_Texture is record - Fade : fade_Level := 0.0; + -- Fade : fade_Level := 0.0; Object : openGL.Texture.Object := openGL.Texture.null_Object; - Applied : Boolean := True; -- Whether this texture is painted on or not. - Tiling : texture_Set.Tiling := (1.0, 1.0); + -- Applied : Boolean := True; -- Whether this texture is painted on or not. + -- Tiling : texture_Set.Tiling := (1.0, 1.0); end record; type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture; @@ -100,12 +100,13 @@ is type Details is record - Fades : fade_Levels (texture_Id) := [others => 0.0]; - Textures : asset_Names (1 .. Positive (texture_Id'Last)) := [others => null_Asset]; -- The textures to be applied to the visual. - texture_Count : Natural := 0; - texture_Tilings : Tilings := [others => (S => 1.0, - T => 1.0)]; - texture_Applies : texture_Apply_array := [1 => True, others => False]; + Fades : fade_Levels (texture_Id) := [others => 0.0]; + Textures : asset_Names (1 .. Positive (texture_Id'Last)) := [others => null_Asset]; + Objects : texture.Objects (1 .. Positive (texture_Id'Last)) := [others => texture.null_Object]; + texture_Count : Natural := 0; + texture_Tilings : Tilings := [others => (S => 1.0, + T => 1.0)]; + texture_Applies : texture_Apply_array := [1 => True, others => False]; -- The textures to be applied to the visual. Animation : Animation_view; end record; @@ -126,12 +127,12 @@ is Textures : fadeable_Textures; Count : Natural := 0; is_Transparent : Boolean := False; -- Any of the textures contains lucid colors. - initialised : Boolean := False; + -- initialised : Boolean := False; end record; - procedure Texture_is (in_Set : in out Item; Which : texture_ID := 1; Now : in openGL.Texture.Object); - function Texture (in_Set : in Item; Which : texture_ID := 1) return openGL.Texture.Object; + -- procedure Texture_is (in_Set : in out Item; Which : texture_ID := 1; Now : in openGL.Texture.Object); + -- function Texture (in_Set : in Item; Which : texture_ID := 1) return openGL.Texture.Object;