From 833584970adc317f6e03e0b86bfb5ea1b99219ba Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Sat, 21 Oct 2023 13:41:32 +1100 Subject: [PATCH] opengl.model.sphere.lit_colored_textured: Update texturing. --- 3-mid/opengl/source/demo/opengl-demo.adb | 12 ++++ ...engl-model-sphere-lit_colored_textured.adb | 56 ++++++++++++++++--- ...engl-model-sphere-lit_colored_textured.ads | 18 ++++++ .../opengl-model-sphere-lit_textured.ads | 2 +- 4 files changed, 78 insertions(+), 10 deletions(-) diff --git a/3-mid/opengl/source/demo/opengl-demo.adb b/3-mid/opengl/source/demo/opengl-demo.adb index 8884617..21ea2ac 100644 --- a/3-mid/opengl/source/demo/opengl-demo.adb +++ b/3-mid/opengl/source/demo/opengl-demo.adb @@ -2,24 +2,32 @@ with openGL.Palette, openGL.Font, openGL.IO, + openGL.Model.arrow .colored, openGL.Model.billboard.textured, + openGL.Model.box .colored, openGL.Model.box .textured, openGL.Model.box .lit_textured, + openGL.Model.capsule .lit_textured, openGL.Model.grid, + openGL.Model.hexagon .lit_colored, openGL.Model.hexagon .lit_textured, openGL.Model.hexagon_Column.lit_colored_faceted, openGL.Model.hexagon_Column.lit_colored_rounded, + openGL.Model.line .colored, openGL.Model.any, openGL.Model.polygon .lit_colored, openGL.Model.segment_line, + openGL.Model.sphere .colored, openGL.Model.sphere .lit_colored, openGL.Model.sphere .lit_textured, + openGL.Model.sphere .lit_colored_textured, + openGL.Model.Text .lit_colored, openGL.Model.terrain, openGL.Light, @@ -141,6 +149,9 @@ is the_ball_3_Model : constant Model.sphere.lit_textured.view := Model.sphere.lit_textured.new_Sphere (Radius => 1.0, Image => the_Texture); + the_ball_4_Model : constant Model.sphere.lit_colored_textured.view + := Model.sphere.lit_colored_textured.new_Sphere (Radius => 1.0, Image => the_Texture); + the_billboard_Model : constant Model.billboard.textured.view := Model.billboard.textured.forge.new_Billboard (Size => (1.0, 1.0), Plane => Billboard.xy, @@ -269,6 +280,7 @@ is the_ball_1_Model.all'Access, the_ball_2_Model.all'Access, the_ball_3_Model.all'Access, + the_ball_4_Model.all'Access, the_billboard_Model.all'Access, the_colored_billboard_Model.all'Access, 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 6b93045..a827ec4 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 @@ -186,16 +186,10 @@ is end set_Indices; - if Self.Image /= null_Asset -- TODO: Use 'Textures' (ie name_Map_of_texture) here and in other models. + if Self.Image /= null_Asset then - set_Texture: - declare - use Texture; - the_Image : constant Image := IO.to_Image (Self.Image); - the_Texture : constant Texture.object := Forge.to_Texture ( the_Image); - begin - the_Geometry.Texture_is (the_Texture); - end set_Texture; + the_Geometry.Texture_is (Textures.fetch (Self.Image)); + the_Geometry.is_Transparent (now => the_Geometry.Texture.is_Transparent); end if; the_Geometry.is_Transparent (False); @@ -209,8 +203,52 @@ 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_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 542afd5..49d6359 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 @@ -23,6 +23,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-sphere-lit_textured.ads b/3-mid/opengl/source/lean/model/opengl-model-sphere-lit_textured.ads index 418a177..bdae042 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 @@ -48,7 +48,7 @@ private type Item is new Model.sphere.item with record - Image : asset_Name := null_Asset; + Image : asset_Name := null_Asset; -- Usually a mercator projection to be mapped onto the sphere. end record; end openGL.Model.sphere.lit_textured;