From 1beb8e1140f7fa0c25db1bf65d45b92e989dce0a Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Tue, 9 May 2023 18:04:18 +1000 Subject: [PATCH] opengl: Work on multi-texturing. --- .../launch_many_boxes_textured_x1_demo.adb | 3 + .../launch_render_two_textures.adb | 41 +++++++++- 3-mid/opengl/assets/shader/texturing.frag | 10 ++- .../opengl-geometry-lit_textured_x2.adb | 5 ++ .../geometry/opengl-geometry-texturing.adb | 4 + .../source/lean/geometry/opengl-geometry.adb | 9 +++ .../source/lean/geometry/opengl-geometry.ads | 12 ++- .../opengl-model-hexagon-lit_textured_x2.adb | 75 ++++++++++++++----- .../opengl-model-hexagon-lit_textured_x2.ads | 23 +++++- .../opengl/source/lean/model/opengl-model.adb | 40 ++++++++++ .../opengl/source/lean/model/opengl-model.ads | 15 +++- .../lean/renderer/opengl-renderer-lean.adb | 1 + 12 files changed, 212 insertions(+), 26 deletions(-) diff --git a/3-mid/opengl/applet/demo/culler/many_boxes_textured_x1/launch_many_boxes_textured_x1_demo.adb b/3-mid/opengl/applet/demo/culler/many_boxes_textured_x1/launch_many_boxes_textured_x1_demo.adb index de65159..1628b90 100644 --- a/3-mid/opengl/applet/demo/culler/many_boxes_textured_x1/launch_many_boxes_textured_x1_demo.adb +++ b/3-mid/opengl/applet/demo/culler/many_boxes_textured_x1/launch_many_boxes_textured_x1_demo.adb @@ -76,6 +76,9 @@ begin Demo.Renderer.set (the_Light); end; + -- openGL.Demo.Camera.allow_Impostors; + + -- Main loop. -- while not Demo.Done diff --git a/3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb b/3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb index e65e5f3..3f101aa 100644 --- a/3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb +++ b/3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb @@ -3,9 +3,12 @@ with openGL.Visual, openGL.Light, openGL.Palette, + openGL.Geometry.texturing, -- openGL.IO, openGL.Demo; +with Ada.Text_IO; use Ada.Text_IO; + procedure launch_render_two_Textures -- @@ -22,8 +25,9 @@ is -------------- -- The model. -- - the_1st_Texture : constant asset_Name := to_Asset ("assets/opengl/texture/blobber_floor.png"); - the_2nd_Texture : constant asset_Name := to_Asset ("assets/opengl/texture/crawl_blob-1.png"); + -- the_1st_Texture : constant asset_Name := to_Asset ("assets/opengl/texture/blobber_floor.png"); + the_1st_Texture : constant asset_Name := to_Asset ("assets/crawl-blob-1.png"); + the_2nd_Texture : constant asset_Name := to_Asset ("assets/crawl-blob-2.png"); the_textured_hexagon_Model : constant Model.hexagon.lit_textured_x2.view := Model.hexagon.lit_textured_x2.new_Hexagon (Radius => 0.5, @@ -45,6 +49,11 @@ is light_Site : constant openGL.Vector_3 := [0.0, 0.0, 15.0]; cone_Direction : constant openGL.Vector_3 := [0.0, 0.0, -1.0]; + use openGL.Geometry.texturing; + Fade : fade_Level := fade_Level'First; + increment_Fade : Boolean := True; + Epoch : Natural := 0; + begin Demo.print_Usage; Demo.define ("openGL 'render two Textures' Demo", @@ -82,6 +91,34 @@ begin Demo.Renderer.render; Demo.FPS_Counter.increment; -- Frames per second display. + + + if Epoch mod 20 = 0 + then + the_textured_hexagon_Model.Fade_1_is (Fade); + the_textured_hexagon_Model.Fade_2_is (1.0 - Fade); + -- the_textured_hexagon_Model.needs_Rebuild; + -- + -- the_textured_hexagon_Model.Fade_1_is (1.0); + -- the_textured_hexagon_Model.Fade_2_is (0.0); + + -- put_Line ("my Fade: " & Fade'Image); + + if increment_Fade + then + Fade := Fade + fade_Level'Small; + else + Fade := Fade - fade_Level'Small; + end if; + + if Fade = fade_Level'Last then increment_Fade := False; + elsif Fade = fade_Level'First then increment_Fade := True; + end if; + + end if; + + Epoch := Epoch + 1; end loop; + Demo.destroy; end launch_render_two_Textures; diff --git a/3-mid/opengl/assets/shader/texturing.frag b/3-mid/opengl/assets/shader/texturing.frag index 17f143d..a527409 100644 --- a/3-mid/opengl/assets/shader/texturing.frag +++ b/3-mid/opengl/assets/shader/texturing.frag @@ -13,8 +13,14 @@ apply_Texturing (vec2 Coords) * texture (Textures [i], Coords).a * (1.0 - Fade [i]); - Color.a = max (Color.a, texture (Textures [i], - Coords).a); +// Color.a += texture (Textures [i], Coords).a * (1.0 - Fade[1]); + + Color.a = max (Color.a, + texture (Textures [i],Coords).a * (1.0 - Fade[i])); + + +// Color.a = max (Color.a, +// texture (Textures [i],Coords).a); } return Color; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb index 3e89156..ff060ba 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-lit_textured_x2.adb @@ -5,6 +5,7 @@ with openGL.Attribute, openGL.Texture, openGL.Palette, + openGL.Model, openGL.Tasks, openGL.Errors, @@ -312,6 +313,10 @@ is is use openGL.Geometry.texturing; begin + Self.Textures.Textures (1).Fade := Self.Model.Fade_1; + Self.Textures.Textures (2).Fade := Self.Model.Fade_2; + + enable (Self.Textures, Self.Program); end enable_Texture; 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 365a1db..384aae1 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb @@ -6,6 +6,8 @@ with ada.Strings.fixed; +with ada.Text_IO; use ada.Text_IO; + package body openGL.Geometry.texturing is @@ -156,6 +158,8 @@ is uniform_Name : constant String := "Fade[" & Trim (Natural'Image (i - 1), Left) & "]"; Uniform : constant openGL.Variable.uniform.float := Program.uniform_Variable (uniform_Name); begin + -- put_Line ("Fade:" & the_Textures.Textures (texture_Id (i)).Fade'Image); + Uniform.Value_is (Real (the_Textures.Textures (texture_Id (i)).Fade)); end; end loop; diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb index 44cb41d..9e7fc98 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.adb +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.adb @@ -50,6 +50,15 @@ is -- Attributes -- + procedure Model_is (Self : in out Item; Now : in Model_view) + is + begin + Self.Model := Now; + end Model_is; + + + + function Label (Self : in Item'Class) return String is begin diff --git a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads index 0202921..f3ceaf8 100644 --- a/3-mid/opengl/source/lean/geometry/opengl-geometry.ads +++ b/3-mid/opengl/source/lean/geometry/opengl-geometry.ads @@ -4,6 +4,9 @@ with openGL.Program, openGL.Texture; +limited +with + openGL.Model; private with @@ -38,6 +41,11 @@ is -- Attributes -- + type Model_view is access all openGL.Model.item'Class; + + procedure Model_is (Self : in out Item; Now : in Model_view); + + procedure Label_is (Self : in out Item'Class; Now : in String); function Label (Self : in Item'Class) return String; @@ -90,16 +98,16 @@ is Sites : in openGL.Sites) return access Normals; + private use ada.Strings.unbounded; type Textures is array (texture_Id) of openGL.Texture.Object; - - type Item is abstract tagged limited record + Model : Model_view; Label : unbounded_String; Program : openGL.Program.view; Vertices : Buffer.view; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb index 1f729ab..ec76c1f 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.adb @@ -27,23 +27,6 @@ is --- Attributes -- - procedure Texture_1_is (Self : in out Item; Now : in openGL.asset_Name) - is - begin - Self.Face.Texture_1 := Now; - end Texture_1_is; - - - procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name) - is - begin - Self.Face.Texture_2 := Now; - end Texture_2_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 @@ -116,8 +99,66 @@ 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; + + + ------------ + -- Texturing + -- + + procedure Texture_1_is (Self : in out Item; Now : in openGL.asset_Name) + is + begin + Self.Face.Texture_1 := Now; + end Texture_1_is; + + + procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name) + is + begin + Self.Face.Texture_2 := Now; + end Texture_2_is; + + + + + overriding + procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level) + is + begin + Self.Face.Fade_1 := Now; + end Fade_1_is; + + + overriding + procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level) + is + begin + Self.Face.Fade_2 := Now; + end Fade_2_is; + + + + overriding + function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level + is + begin + return Self.Face.Fade_1; + end Fade_1; + + + overriding + function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level + is + begin + return Self.Face.Fade_2; + end Fade_2; + + + end openGL.Model.hexagon.lit_textured_x2; diff --git a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads index 6a64289..c69b4f9 100644 --- a/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads +++ b/3-mid/opengl/source/lean/model/opengl-model-hexagon-lit_textured_x2.ads @@ -32,13 +32,32 @@ is --- Attributes -- + 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; + + + ------------ + -- Texturing + -- + procedure Texture_1_is (Self : in out Item; Now : in openGL.asset_Name); procedure Texture_2_is (Self : in out Item; Now : in openGL.asset_Name); 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; + procedure Fade_1_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level); + + overriding + procedure Fade_2_is (Self : in out Item; Now : in openGL.Geometry.texturing.fade_Level); + + + overriding + function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level; + + overriding + function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level; + private diff --git a/3-mid/opengl/source/lean/model/opengl-model.adb b/3-mid/opengl/source/lean/model/opengl-model.adb index 01c61f6..4e9cd91 100644 --- a/3-mid/opengl/source/lean/model/opengl-model.adb +++ b/3-mid/opengl/source/lean/model/opengl-model.adb @@ -211,4 +211,44 @@ is Self.needs_Rebuild := True; end needs_Rebuild; + + + + ------------ + -- Texturing + -- + + procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level) + is + begin + raise program_Error with "Model does not support texturing."; + end Fade_1_is; + + + + procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level) + is + begin + raise program_Error with "Model does not support texturing."; + end Fade_2_is; + + + + function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level + is + begin + raise program_Error with "Model does not support texturing."; + return 0.0; + end Fade_1; + + + + function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level + is + begin + raise program_Error with "Model does not support texturing."; + return 0.0; + end Fade_2; + + end openGL.Model; diff --git a/3-mid/opengl/source/lean/model/opengl-model.ads b/3-mid/opengl/source/lean/model/opengl-model.ads index 3d03778..c88d4bd 100644 --- a/3-mid/opengl/source/lean/model/opengl-model.ads +++ b/3-mid/opengl/source/lean/model/opengl-model.ads @@ -2,7 +2,7 @@ with openGL.remote_Model, openGL.Font, openGL.Texture, - openGL.Geometry; + openGL.Geometry.texturing; package openGL.Model @@ -68,6 +68,19 @@ is Fonts : in Font.font_id_Map_of_font); + + ------------ + -- Texturing + -- + + procedure Fade_1_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); + procedure Fade_2_is (Self : in out Item; Now : in Geometry.Texturing.fade_Level); + + function Fade_1 (Self : in Item) return Geometry.Texturing.fade_Level; + function Fade_2 (Self : in Item) return Geometry.Texturing.fade_Level; + + + private type Item is abstract new remote_Model.item with diff --git a/3-mid/opengl/source/lean/renderer/opengl-renderer-lean.adb b/3-mid/opengl/source/lean/renderer/opengl-renderer-lean.adb index 19fcb1e..468cca6 100644 --- a/3-mid/opengl/source/lean/renderer/opengl-renderer-lean.adb +++ b/3-mid/opengl/source/lean/renderer/opengl-renderer-lean.adb @@ -549,6 +549,7 @@ is and the_Visual.Model. lucid_Geometries = null) then the_Visual.Model.create_GL_Geometries (Self.Textures'Access, Self.Fonts); + -- put_Line ("Rebuild"); elsif the_Visual.Model.is_Modified then