From 4861f5423275adce307046c94b13583e1424107c Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Wed, 31 May 2023 15:22:25 +1000 Subject: [PATCH] opengl.model: Add basic texturing subprograms. --- .../render_models/launch_render_models.adb | 1 + 3-mid/opengl/source/demo/opengl-demo.adb | 48 ++++++++------- .../source/lean/model/opengl-model-any.adb | 48 ++++++++++++++- .../source/lean/model/opengl-model-any.ads | 18 ++++++ .../model/opengl-model-billboard-textured.adb | 45 ++++++++++++++ .../model/opengl-model-billboard-textured.ads | 18 ++++++ .../model/opengl-model-box-lit_textured.adb | 60 +++++++++++++++++-- .../model/opengl-model-box-lit_textured.ads | 19 ++++++ .../lean/model/opengl-model-box-textured.adb | 50 +++++++++++++++- .../lean/model/opengl-model-box-textured.ads | 18 ++++++ .../opengl-model-capsule-lit_textured.adb | 45 ++++++++++++++ .../opengl-model-capsule-lit_textured.ads | 18 ++++++ .../opengl-model-hexagon-lit_textured.adb | 3 +- .../opengl-model-sphere-lit_textured.adb | 45 ++++++++++++++ .../opengl-model-sphere-lit_textured.ads | 20 ++++++- .../lean/model/opengl-model-terrain.adb | 43 +++++++++++++ .../lean/model/opengl-model-terrain.ads | 19 ++++++ .../model/opengl-model-text-lit_colored.adb | 43 +++++++++++++ .../model/opengl-model-text-lit_colored.ads | 18 ++++++ 19 files changed, 547 insertions(+), 32 deletions(-) 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 688109b..0501b72 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 @@ -80,6 +80,7 @@ begin the_Visuals (3).Site_is ([0.0, 0.0, -50.0]); + -- Main loop. -- while not Demo.Done diff --git a/3-mid/opengl/source/demo/opengl-demo.adb b/3-mid/opengl/source/demo/opengl-demo.adb index 9b70f42..8884617 100644 --- a/3-mid/opengl/source/demo/opengl-demo.adb +++ b/3-mid/opengl/source/demo/opengl-demo.adb @@ -118,6 +118,8 @@ is end destroy; + + function Models return openGL.Model.views is use Model, @@ -260,37 +262,39 @@ is the_segment_line_Model.add_Segment (end_Site => [2.0, 2.0, 0.0]); the_segment_line_Model.add_Segment (end_Site => [0.0, 2.0, 0.0]); - return [ the_ground_Model.all'Access, - the_polygon_Model.all'Access, - the_text_Model.all'Access, - the_arrow_Model.all'Access, - the_ball_1_Model.all'Access, - the_ball_2_Model.all'Access, - the_ball_3_Model.all'Access, + return [ the_ground_Model.all'Access, + the_polygon_Model.all'Access, + the_text_Model.all'Access, + the_arrow_Model.all'Access, + the_ball_1_Model.all'Access, + the_ball_2_Model.all'Access, + the_ball_3_Model.all'Access, - the_billboard_Model.all'Access, - the_colored_billboard_Model.all'Access, - the_box_1_Model.all'Access, - the_box_2_Model.all'Access, - the_box_3_Model.all'Access, + the_billboard_Model.all'Access, + the_colored_billboard_Model.all'Access, + the_box_1_Model.all'Access, + the_box_2_Model.all'Access, + the_box_3_Model.all'Access, - the_capsule_Model.all'Access, - the_grid_Model.all'Access, + the_capsule_Model.all'Access, + the_grid_Model.all'Access, - the_hexagon_Model.all'Access, - the_textured_hexagon_Model.all'Access, + the_hexagon_Model.all'Access, + the_textured_hexagon_Model.all'Access, - the_faceted_hexagon_column_Model.all'Access, - the_rounded_hexagon_column_Model.all'Access, + the_faceted_hexagon_column_Model.all'Access, + the_rounded_hexagon_column_Model.all'Access, - the_line_Model.all'Access, - the_collada_Model.all'Access, - the_wavefront_Model.all'Access, + the_line_Model.all'Access, + the_collada_Model.all'Access, + the_wavefront_Model.all'Access, - the_segment_line_Model.all'Access]; + the_segment_line_Model.all'Access]; end Models; + + procedure layout (the_Visuals : in Visual.views) is initial_X : constant openGL.Real := -6.0; 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 7cb6bd6..97d23ec 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-any.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-any.adb @@ -139,6 +139,7 @@ is + 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 @@ -146,11 +147,14 @@ is pragma unreferenced (Textures, Fonts); begin Self.build_GL_Geometries; + Self.Geometry.Model_is (Self.all'unchecked_Access); + return [1 => Self.Geometry]; end to_GL_Geometries; + procedure build_GL_Geometries (Self : in out Item) is use Geometry; @@ -486,10 +490,52 @@ is end if; Self.Geometry.is_Transparent (now => False); - Self.Geometry.Label_is (to_String (Self.Model) & "-" & to_String (Self.Texture)); + Self.Geometry.Label_is (to_String (Self.Model) & "-" & to_String (Self.Texture)); end; end build_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.any; diff --git a/3-mid/opengl/source/lean/model/opengl-model-any.ads b/3-mid/opengl/source/lean/model/opengl-model-any.ads index 4b846bd..6d6470b 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-any.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-any.ads @@ -39,6 +39,24 @@ is unsupported_model_Format : exception; + ------------ + -- 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 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 cf27a3f..190f108 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 @@ -110,6 +110,8 @@ is end if; end; + the_Face.Model_is (Self.all'unchecked_Access); + return [1 => the_Face.all'Access]; end to_GL_Geometries; @@ -195,4 +197,47 @@ 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 141cf74..d46805b 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 @@ -46,6 +46,24 @@ 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 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 71098b9..f41af8b 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 @@ -74,8 +74,9 @@ is if Self.Faces (Front).texture_Name /= null_Asset then - front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name)); + 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; @@ -93,8 +94,9 @@ is if Self.Faces (Rear).texture_Name /= null_Asset then - rear_Face.Texture_is (Textures.fetch (Self.Faces (Rear).texture_Name)); + 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; @@ -112,8 +114,9 @@ is if Self.Faces (Upper).texture_Name /= null_Asset then - upper_Face.Texture_is (Textures.fetch (Self.Faces (Upper).texture_Name)); + 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; @@ -133,6 +136,7 @@ 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; @@ -150,8 +154,9 @@ is if Self.Faces (Left).texture_Name /= null_Asset then - left_Face.Texture_is (Textures.fetch (Self.Faces (Left).texture_Name)); + 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; @@ -169,8 +174,9 @@ is if Self.Faces (Right).texture_Name /= null_Asset then - right_Face.Texture_is (Textures.fetch (Self.Faces (Right).texture_Name)); + 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; @@ -184,4 +190,48 @@ 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 1044ea7..8d5b1dc 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 @@ -39,6 +39,25 @@ 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 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 954c329..7e7c8aa 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 @@ -81,8 +81,9 @@ is if Self.Faces (Front).texture_Name /= null_Asset then - front_Face.Texture_is (Textures.fetch (Self.Faces (Front).texture_Name)); + 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; @@ -102,6 +103,7 @@ 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; @@ -121,6 +123,7 @@ 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; @@ -140,6 +143,7 @@ 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; @@ -159,6 +163,7 @@ 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; @@ -178,6 +183,7 @@ 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; @@ -191,4 +197,46 @@ 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 96ad5fa..42ec4b4 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 @@ -40,6 +40,24 @@ 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 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 987b6d0..4ab8514 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 @@ -190,6 +190,8 @@ is begin the_shaft_Geometry.add (Primitive.view (the_Primitive)); end; + + the_shaft_Geometry.Model_is (Self.all'unchecked_Access); end; @@ -386,6 +388,8 @@ is end; end; + cap_Geometry.Model_is (Self.all'unchecked_Access); + return cap_Geometry; end new_Cap; @@ -400,4 +404,45 @@ 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 5be6847..d67fbef 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 @@ -28,6 +28,24 @@ 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 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 ffb9d81..f2fc1cd 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 @@ -114,6 +114,7 @@ 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; @@ -138,8 +139,6 @@ is upper_Face := new_Face (Vertices => the_Vertices); end; - upper_Face.Model_is (Self.all'unchecked_Access); - return (1 => upper_Face.all'Access); end to_GL_Geometries; diff --git a/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.adb b/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.adb index b6699cb..7f45ff5 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 @@ -186,8 +186,53 @@ 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; + + + ------------ + -- 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 0ab9697..418a177 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 @@ -25,10 +25,28 @@ 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 Model.sphere.item with record Image : asset_Name := null_Asset; end record; 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 b90966e..83700b0 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-terrain.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-terrain.adb @@ -226,6 +226,8 @@ 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; @@ -282,4 +284,45 @@ is end set_Bounds; + + ------------ + -- 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.color_Map := Now; + end Texture_is; + + + + overriding + function texture_Count (Self : in Item) return Natural + is + begin + return 1; + end texture_Count; + + end openGL.Model.terrain; diff --git a/3-mid/opengl/source/lean/model/opengl-model-terrain.ads b/3-mid/opengl/source/lean/model/opengl-model-terrain.ads index b15dc8a..daf30ff 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-terrain.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-terrain.ads @@ -37,6 +37,25 @@ 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.item with 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 8e8acf4..ad3be74 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 @@ -279,6 +279,7 @@ is 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; return [1 => Geometry.view (the_Geometry)]; @@ -286,4 +287,46 @@ 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.Text.lit_colored; diff --git a/3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.ads b/3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.ads index 5510c5e..57f84e6 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-text-lit_colored.ads @@ -38,6 +38,24 @@ is function Font (Self : in Item) return openGL.Font.view; + ------------ + -- 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