opengl: Add tiling for multi-textures.

3-mid/opengl/applet/demo/renderer/render_models/launch_render_models.adb

@@ -38,28 +38,6 @@ begin
    end;
 
 
-   -- Set the lights initial position to far behind and far to the left.
-   --
---     declare
---        use openGL.Palette;
---
---        initial_Site   : constant openGL.Vector_3 := (0.0, 0.0, 15.0);
---        cone_Direction : constant openGL.Vector_3 := (0.0, 0.0, -1.0);
---
---        Light : openGL.Light.diffuse.item := Demo.Renderer.Light (Id => 1);
---     begin
---        Light.Color_is (Ambient  => (Grey,  Opaque),
---                        Diffuse  => (White, Opaque));
---        --  Specular => (White, Opaque));
---
---        Light.Position_is       (initial_Site);
---        Light.cone_Direction_is (cone_Direction);
---
---        Demo.Renderer.Light_is (Id => 1, Now => Light);
---     end;
-
-
-
    declare
       --  The models.
       --
@@ -78,10 +56,9 @@ begin
          the_Visuals (i) := new_Visual (the_Models (i));
       end loop;
 
-      the_Visuals (4).Site_is ([0.0, 0.0, -50.0]);
-
       the_Visuals (1).Scale_is ([0.2, 0.2, 1.0]);     -- Text visual.
 
+
       --  Main loop.
       --
       while not Demo.Done

3-mid/opengl/applet/demo/textures/tiling/launch_tiling_demo.adb

@@ -0,0 +1,84 @@
+with
+     openGL.Model.polygon.lit_textured,
+     openGL.texture_Set,
+     openGL.Visual,
+     openGL.Light,
+     openGL.Palette,
+     openGL.Demo;
+
+
+procedure launch_tiling_Demo
+--
+--  Exercise the renderer with an example of all the models.
+--
+is
+   use openGL,
+       openGL.Math,
+       openGL.linear_Algebra_3D,
+       openGL.Palette;
+
+begin
+   Demo.print_Usage ("Use space ' ' to cycle through models.");
+   Demo.define ("openGL 'Render Models' Demo");
+   Demo.Camera.Position_is ([0.0, 0.0, 2.0],
+                            y_Rotation_from (to_Radians (0.0)));
+
+   declare
+      use openGL.Light;
+      the_Light : openGL.Light.item := Demo.Renderer.new_Light;
+   begin
+      the_Light.Site_is ([0.0, 0.0, 5.0]);
+      the_Light.Color_is (White);
+
+      Demo.Renderer.set (the_Light);
+   end;
+
+
+   declare
+      the_Texture : constant asset_Name                 := to_Asset ("assets/opengl/texture/Face1.bmp");
+      Details     :          openGL.texture_Set.Details := openGL.texture_Set.to_Details ([1 => the_Texture]);
+
+      the_Model   : Model.polygon.lit_textured.view;
+        --  := Model.polygon.lit_textured.new_Polygon (vertex_Sites    => [[-1.0, -1.0], [1.0, -1.0], [1.0, 1.0], [-1.0, 1.0]],
+        --                                             texture_Details => openGL.texture_Set.to_Details ([1 => the_Texture]));
+
+
+      --  The visuals.
+      --
+      use openGL.Visual.Forge;
+
+      the_Visual : openGL.Visual.view;
+
+   begin
+      Details.texture_Tilings (1) := (S => 5.0, T => 4.0);
+
+      the_Model  := Model.polygon.lit_textured.new_Polygon (vertex_Sites    => [[-1.0, -1.0], [1.0, -1.0], [1.0, 1.0], [-1.0, 1.0]],
+                                                            texture_Details => Details);
+      the_Visual := new_Visual (the_Model.all'Access);
+
+      --  Main loop.
+      --
+      while not Demo.Done
+      loop
+         Demo.Dolly.evolve;
+         Demo.Done := Demo.Dolly.quit_Requested;
+
+
+         --  Render all visuals.
+         --
+         Demo.Camera.render ([1 => the_Visual]);
+
+         while not Demo.Camera.cull_Completed
+         loop
+            delay Duration'Small;
+         end loop;
+
+         Demo.Renderer.render;
+         Demo.FPS_Counter.increment;    -- Frames per second display.
+
+         delay 1.0 / 60.0;
+      end loop;
+   end;
+
+   Demo.destroy;
+end launch_tiling_Demo;

3-mid/opengl/applet/demo/textures/tiling/tiling_demo.gpr

@@ -0,0 +1,17 @@
+with
+     "opengl_demo",
+     "lace_shared"; 
+
+
+project tiling_Demo
+is
+   for Object_Dir use "build";
+   for Exec_Dir   use ".";
+   for Main       use ("launch_tiling_demo.adb");
+
+   package Ide      renames Lace_shared.Ide;
+   package Builder  renames Lace_shared.Builder;
+   package Compiler renames Lace_shared.Compiler;
+   package Binder   renames Lace_shared.Binder;
+
+end tiling_Demo;

3-mid/opengl/assets/shader/lit_colored_text.frag

@@ -5,9 +5,10 @@
 // Texturing snippet.
 //
 uniform int         texture_Count;
-uniform sampler2D   Textures [16];
+uniform sampler2D   Textures        [16];
-uniform float       Fade     [16];
+uniform float       Fade            [16];
 uniform bool        texture_Applies [16];
+uniform vec2        Tiling          [16];
 
 vec4
 apply_Texturing (vec2   Coords)
@@ -18,12 +19,17 @@ apply_Texturing (vec2   Coords)
     {
       if (texture_Applies [i])
       {
-        Color.rgb +=   texture (Textures [i], Coords).rgb
+           vec2    tiled_Coords;
-                     * texture (Textures [i], Coords).a
+            
+           tiled_Coords.s = Coords.s * Tiling [i].s;
+           tiled_Coords.t = Coords.t * Tiling [i].t;
+        
+        Color.rgb +=   texture (Textures [i], tiled_Coords).rgb
+                     * texture (Textures [i], tiled_Coords).a
                      * (1.0 - Fade [i]);
                                       
         Color.a    = max (Color.a, texture (Textures [i],
-                                            Coords).a);
+                                            tiled_Coords).a);
       }
     }
     

3-mid/opengl/assets/shader/texturing-frag.snippet

@@ -2,6 +2,7 @@ uniform int         texture_Count;
 uniform sampler2D   Textures        [16];
 uniform float       Fade            [16];
 uniform bool        texture_Applies [16];
+uniform vec2        Tiling          [16];
 
 
 vec4
@@ -14,17 +15,17 @@ apply_Texturing (vec2   Coords)
     {
         if (texture_Applies [i])
         {
-            Color.rgb +=   texture (Textures [i], Coords).rgb
+            vec2    tiled_Coords;
-                         * texture (Textures [i], Coords).a
+            
+            tiled_Coords.s = Coords.s * Tiling [i].s;
+            tiled_Coords.t = Coords.t * Tiling [i].t;
+            
+            Color.rgb +=   texture (Textures [i], tiled_Coords).rgb
+                         * texture (Textures [i], tiled_Coords).a
                          * (1.0 - Fade [i]);
                                       
-//            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]));
+                              texture (Textures [i], tiled_Coords).a * (1.0 - Fade [i]));
-
-//            Color.a    = max (Color.a,
-//                              texture (Textures [i],Coords).a);
         }
     }
     

3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.adb

@@ -62,8 +62,10 @@ is
       then
          for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count)
          loop
-            Uniforms.Textures (i).fade_Uniform           .Value_is (Real (for_Model.Fade      (Which => i)));
+            Uniforms.Textures (i).tiling_Uniform         .Value_is (Vector_2' ((for_Model.Tiling  (Which => i).S,
-            Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (Which => i));
+                                                                                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);
@@ -92,10 +94,12 @@ is
             texture_uniform_Name         : constant String   := "Textures["        & trim (Natural'Image (i - 1), Left) & "]";
             fade_uniform_Name            : constant String   := "Fade["            & trim (Natural'Image (i - 1), Left) & "]";
             texture_applies_uniform_Name : constant String   := "texture_Applies[" & trim (Natural'Image (i - 1), Left) & "]";
+            tiling_uniform_Name          : constant String   := "Tiling["          & trim (Natural'Image (i - 1), Left) & "]";
          begin
             Uniforms.Textures (Id).        texture_Uniform := for_Program.uniform_Variable (Named =>         texture_uniform_Name);
             Uniforms.Textures (Id).           fade_Uniform := for_Program.uniform_Variable (Named =>            fade_uniform_Name);
             Uniforms.Textures (Id).texture_applied_Uniform := for_Program.uniform_Variable (Named => texture_applies_uniform_Name);
+            Uniforms.Textures (Id).tiling_Uniform          := for_Program.uniform_Variable (Named =>          tiling_uniform_Name);
          end;
       end loop;
 
@@ -139,7 +143,7 @@ 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;
       end Fade;
 
 
@@ -180,11 +184,34 @@ 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;
       end texture_Applied;
 
 
 
+      overriding
+      procedure Tiling_is (Self : in out Item;   Now   : in texture_Set.Tiling;
+                                                 Which : in texture_Set.texture_ID := 1)
+      is
+      begin
+         Self.texture_Set.Textures (Which).Tiling := Now;
+      end Tiling_is;
+
+
+
+      overriding
+      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;
+      end Tiling;
+
+
+
+
+
+
+
       overriding
       procedure enable_Textures (Self : in out Item)
       is

3-mid/opengl/source/lean/geometry/opengl-geometry-texturing.ads

@@ -22,6 +22,7 @@ is
          texture_Uniform         : openGL.Variable.uniform.sampler2D;
          fade_Uniform            : openGL.Variable.uniform.float;
          texture_applied_Uniform : openGL.Variable.uniform.bool;
+         tiling_Uniform          : openGL.Variable.uniform.vec2;
       end record;
 
 
@@ -50,7 +51,6 @@ is
 
 
 
-
    -------------
    --- Mixin ---
    -------------
@@ -64,7 +64,6 @@ is
       procedure create_Uniforms (for_Program : in     openGL.Program.view);
 
 
-
       overriding
       procedure Fade_is      (Self : in out Item;   Now   : in texture_Set.fade_Level;
                                                     Which : in texture_Set.texture_ID := 1);
@@ -85,6 +84,11 @@ is
       overriding
       function  texture_Applied    (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return Boolean;
 
+      overriding
+      procedure Tiling_is          (Self : in out Item;   Now   : in texture_Set.Tiling;
+                                                          Which : in texture_Set.texture_ID := 1);
+      overriding
+      function  Tiling             (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling;
 
 
       overriding

3-mid/opengl/source/lean/geometry/opengl-geometry.adb

@@ -136,6 +136,17 @@ is
 
 
 
+   function Tiling (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling
+   is
+   begin
+      raise program_Error with "Geometry has no texture.";
+      return (S => 0.0,
+              T => 0.0);
+   end Tiling;
+
+
+
+
    procedure Program_is  (Self : in out Item;   Now : in openGL.Program.view)
    is
    begin

3-mid/opengl/source/lean/geometry/opengl-geometry.ads

@@ -66,6 +66,10 @@ is
                                                        Which : in texture_Set.texture_ID := 1) is null;
    function  texture_Applied    (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return Boolean;
 
+   procedure Tiling_is          (Self : in out Item;   Now   : in texture_Set.Tiling;
+                                                       Which : in texture_Set.texture_ID := 1) is null;
+   function  Tiling             (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling;
+
 
 
    procedure Bounds_are      (Self : in out Item'Class;   Now : in Bounds);

3-mid/opengl/source/lean/model/opengl-model-polygon-lit_textured.adb

@@ -107,15 +107,15 @@ is
          loop
             the_Vertices (Index_t (i)) := (Site   => Vector_3 (the_Sites (i) & 0.0),
                                            Normal => Normal,
-                                           Coords => (Coords_and_Centroid.Coords (Index_t (i)).S * Self.texture_Details.texture_Tiling.S,
+                                           Coords => (Coords_and_Centroid.Coords (Index_t (i)).S,
-                                                      Coords_and_Centroid.Coords (Index_t (i)).T * Self.texture_Details.texture_Tiling.T),
+                                                      Coords_and_Centroid.Coords (Index_t (i)).T),
                                            Shine  => default_Shine);
          end loop;
 
          the_Vertices (the_Vertices'Last) := (Site   => Vector_3 (Coords_and_Centroid.Centroid & 0.0),
                                               Normal => Normal,
-                                              Coords => (S => 0.5 * Self.texture_Details.texture_Tiling.S,
+                                              Coords => (S => 0.5,
-                                                         T => 0.5 * Self.texture_Details.texture_Tiling.T),
+                                                         T => 0.5),
                                               Shine  => default_Shine);
 
          face_Geometry := new_Geometry (Vertices => the_Vertices);

3-mid/opengl/source/lean/model/opengl-model-texturing.adb

@@ -7,12 +7,13 @@ is
 
    package body Mixin
    is
+
       overriding
       procedure Fade_is (Self : in out textured_Item;   Which : in texture_Set.texture_Id;
                                                         Now   : in texture_Set.fade_Level)
       is
       begin
-         Self.texture_Details.Fades (which) := Now;
+         Self.texture_Details.Fades (Which) := Now;
       end Fade_is;
 
 
@@ -21,16 +22,36 @@ is
       function Fade (Self : in textured_Item;   Which : in texture_Set.texture_Id) return texture_Set.fade_Level
       is
       begin
-         return Self.texture_Details.Fades (which);
+         return Self.texture_Details.Fades (Which);
       end Fade;
 
 
 
+      overriding
+      procedure Tiling_is (Self : in out textured_Item;   Which : in texture_Set.texture_Id;
+                                                          Now   : in texture_Set.Tiling)
+      is
+      begin
+         Self.texture_Details.texture_Tilings (Which) := Now;
+      end Tiling_is;
+
+
+
+      overriding
+      function Tiling (Self : in textured_Item;   Which : in texture_Set.texture_Id) return texture_Set.Tiling
+      is
+      begin
+         return Self.texture_Details.texture_Tilings (Which);
+      end Tiling;
+
+
+
+
       procedure Texture_is (Self : in out textured_Item;   Which : in texture_Set.texture_Id;
                                                            Now   : in openGL.asset_Name)
       is
       begin
-         Self.texture_Details.Textures (Positive (which)) := Now;
+         Self.texture_Details.Textures (Positive (Which)) := Now;
       end Texture_is;
 
 

3-mid/opengl/source/lean/model/opengl-model-texturing.ads

@@ -26,6 +26,13 @@ is
       procedure Fade_is            (Self : in out textured_Item;   Which : in texture_Set.texture_Id;
                                                                    Now   : in texture_Set.fade_Level);
 
+      overriding
+      function  Tiling             (Self : in     textured_Item;   Which : in texture_Set.texture_Id) return texture_Set.Tiling;
+
+      overriding
+      procedure Tiling_is          (Self : in out textured_Item;   Which : in texture_Set.texture_Id;
+                                                                   Now   : in texture_Set.Tiling);
+
       procedure Texture_is         (Self : in out textured_Item;   Which : in texture_Set.texture_Id;
                                                                    Now   : in asset_Name);
 

3-mid/opengl/source/lean/model/opengl-model.adb

@@ -240,6 +240,25 @@ is
 
 
 
+   procedure Tiling_is (Self : in out Item;   Which : in texture_Set.texture_Id;
+                                              Now   : in texture_Set.Tiling)
+   is
+   begin
+      raise program_Error with External_Tag (Model.item'Class (Self)'Tag) & " Model does not support texturing.";
+   end Tiling_is;
+
+
+
+   function Tiling (Self : in Item;   Which : in texture_Set.texture_Id) return texture_Set.Tiling
+   is
+   begin
+      raise program_Error with External_Tag (Model.item'Class (Self)'Tag) & " Model does not support texturing.";
+      return (S => 0.0,
+              T => 0.0);
+   end Tiling;
+
+
+
    function texture_Count (Self : in Item) return Natural
    is
    begin

3-mid/opengl/source/lean/model/opengl-model.ads

@@ -78,6 +78,10 @@ is
    procedure Fade_is            (Self : in out Item;   Which : in texture_Set.texture_Id;
                                                        Now   : in texture_Set.fade_Level);
 
+   function  Tiling             (Self : in     Item;   Which : in texture_Set.texture_Id) return texture_Set.Tiling;
+   procedure Tiling_is          (Self : in out Item;   Which : in texture_Set.texture_Id;
+                                                       Now   : in texture_Set.Tiling);
+
    function  texture_Count      (Self : in Item) return Natural;
 
    function  texture_Applied    (Self : in     Item;   Which : in texture_Set.texture_Id) return Boolean;

3-mid/opengl/source/lean/opengl-texture_set.adb

@@ -24,15 +24,14 @@ is
    is
       use ada.Calendar;
 
-      Now           : constant ada.Calendar.Time := Clock;
+      Now : constant ada.Calendar.Time := Clock;
 
    begin
       if Now >= the_Animation.next_frame_Time
       then
          declare
-
             next_frame_Id : constant frame_Id := (if the_Animation.Current < the_Animation.frame_Count then the_Animation.Current + 1
-                                                                                                          else 1);
+                                                                                                       else 1);
             old_Frame     :          Frame renames the_Animation.Frames (the_Animation.Current);
             new_Frame     :          Frame renames the_Animation.Frames (next_frame_Id);
          begin

3-mid/opengl/source/lean/opengl-texture_set.ads

@@ -25,6 +25,14 @@ is
    type texture_Ids is array (Positive range <>) of texture_Id;
 
 
+   type Tiling is     -- The number of times the texture should be wrapped.
+      record
+         S : Real;
+         T : Real;
+      end record;
+
+   type Tilings is array (texture_Id) of Tiling;
+
 
    --------
    --- Fade
@@ -44,6 +52,7 @@ is
          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);
       end record;
 
    type fadeable_Textures is array (texture_Id range 1 .. max_Textures) of fadeable_Texture;
@@ -89,19 +98,13 @@ is
    --- Details
    --
 
-   type Tiling is     -- The number of times the texture should be wrapped.
-      record
-         S : Real;
-         T : Real;
-      end record;
-
    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_Tiling   : Tiling                                        := (S => 1.0,
+         texture_Tilings  : Tilings                                       := [others => (S => 1.0,
-                                                                              T => 1.0);
+                                                                                         T => 1.0)];
          texture_Applies  : texture_Apply_array                           := [1 => True, others => False];
          Animation        : Animation_view;
       end record;

3-mid/opengl/source/lean/shader/opengl-program.adb

@@ -226,6 +226,16 @@ is
 
 
 
+   function uniform_Variable (Self : access Item'Class;   Named : in String) return Variable.uniform.vec2
+   is
+      the_Variable : Variable.uniform.vec2;
+   begin
+      the_Variable.define (Self, Named);
+      return the_Variable;
+   end uniform_Variable;
+
+
+
    function uniform_Variable (Self : access Item'Class;   Named : in String) return Variable.uniform.vec3
    is
       the_Variable : Variable.uniform.vec3;

3-mid/opengl/source/lean/shader/opengl-program.ads

@@ -61,6 +61,7 @@ is
    function uniform_Variable   (Self : access Item'Class;   Named : in String) return Variable.uniform.bool;
    function uniform_Variable   (Self : access Item'Class;   Named : in String) return Variable.uniform.int;
    function uniform_Variable   (Self : access Item'Class;   Named : in String) return Variable.uniform.float;
+   function uniform_Variable   (Self : access Item'Class;   Named : in String) return Variable.uniform.vec2;
    function uniform_Variable   (Self : access Item'Class;   Named : in String) return Variable.uniform.vec3;
    function uniform_Variable   (Self : access Item'Class;   Named : in String) return Variable.uniform.vec4;
    function uniform_Variable   (Self : access Item'Class;   Named : in String) return Variable.uniform.mat3;

3-mid/opengl/source/lean/shader/opengl-variable-uniform.adb

@@ -97,6 +97,20 @@ is
 
 
 
+   --  vec2
+   --
+   procedure Value_is (Self : in vec2;   Now : in Vector_2)
+   is
+   begin
+      Tasks.check;
+      glUniform2fv (Self.gl_Variable,
+                    1,
+                    Now (1)'Address);
+      Errors.log;
+   end Value_is;
+
+
+
    --  vec3
    --
    procedure Value_is (Self : in vec3;   Now : in Vector_3)

3-mid/opengl/source/lean/shader/opengl-variable-uniform.ads

@@ -15,7 +15,7 @@ is
    --  Forge
    --
 
-   procedure define  (Self : in out Item;   Program : access openGL.Program.item'class;
+   procedure define  (Self : in out Item;   Program : access openGL.Program.item'Class;
                                             Name    : in     String);
    overriding
    procedure destroy (Self : in out Item);
@@ -33,6 +33,7 @@ is
    type bool      is new Variable.uniform.item with private;
    type int       is new Variable.uniform.item with private;
    type float     is new Variable.uniform.item with private;
+   type vec2      is new Variable.uniform.item with private;
    type vec3      is new Variable.uniform.item with private;
    type vec4      is new Variable.uniform.item with private;
    type mat3      is new Variable.uniform.item with private;
@@ -43,6 +44,7 @@ is
    procedure Value_is (Self : in bool;    Now : in Boolean);
    procedure Value_is (Self : in int;     Now : in Integer);
    procedure Value_is (Self : in float;   Now : in Real);
+   procedure Value_is (Self : in vec2;    Now : in Vector_2);
    procedure Value_is (Self : in vec3;    Now : in Vector_3);
    procedure Value_is (Self : in vec4;    Now : in Vector_4);
    procedure Value_is (Self : in mat3;    Now : in Matrix_3x3);
@@ -58,6 +60,7 @@ private
    type int       is new Variable.uniform.item with null record;
    type float     is new Variable.uniform.item with null record;
 
+   type vec2      is new Variable.uniform.item with null record;
    type vec3      is new Variable.uniform.item with null record;
    type vec4      is new Variable.uniform.item with null record;