opengl: Work on multi-texturing.

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

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_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/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;

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],
+//        Color.a    += texture (Textures [i],  Coords).a * (1.0 - Fade[1]);
-                                            Coords).a);
+
+        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;

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;
 

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;

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

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;

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;

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;
+   procedure Fade_1_is (Self : in out Item;   Now : in openGL.Geometry.texturing.fade_Level);
-                                                    Fonts    : in     Font.font_id_Map_of_font) return Geometry.views;
+
+   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

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;

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

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