opengl.geometry: Add multi-texture support to more geometries.

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

@@ -1,5 +1,34 @@
 #version 140
 
+
+
+// Texturing snippet.
+//
+uniform int         texture_Count;
+uniform sampler2D   Textures [32];
+uniform float       Fade     [32];
+
+vec4
+apply_Texturing (vec2   Coords)
+{
+    vec4   Color = vec4 (0);
+    
+    for (int i = 0;   i < texture_Count;   ++i)
+    {
+        Color.rgb +=   texture (Textures [i], Coords).rgb
+                     * texture (Textures [i], Coords).a
+                     * (1.0 - Fade [i]);
+                                      
+        Color.a    = max (Color.a, texture (Textures [i],
+                                            Coords).a);
+    }
+    
+    return Color;
+}
+
+
+
+
 struct light
 {
    vec4    Site;
@@ -15,7 +44,7 @@ uniform mat4        model_Transform;
 uniform mat3        inverse_model_Rotation;
 uniform vec3        camera_Site;
 uniform vec3        specular_Color;    // The materials specular color.
-uniform sampler2D   Texture;
+//uniform sampler2D   Texture;
 uniform int         light_Count;
 uniform light       Lights [10];
 
@@ -95,7 +124,7 @@ apply_Light (light   Light,
 void
 main()
 {
-    vec4   texture_Color = texture (Texture, frag_Coords);
+    vec4   texture_Color = apply_Texturing (frag_Coords);   // texture (Texture, frag_Coords);
    
     vec4   surface_Color = vec4 (mix (texture_Color.rgb,
                                       frag_Color   .rgb,

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

@@ -1,5 +1,32 @@
 #version 140
 
+
+// Texturing snippet.
+//
+uniform int         texture_Count;
+uniform sampler2D   Textures [32];
+uniform float       Fade     [32];
+
+vec4
+apply_Texturing (vec2   Coords)
+{
+    vec4   Color = vec4 (0);
+    
+    for (int i = 0;   i < texture_Count;   ++i)
+    {
+        Color.rgb +=   texture (Textures [i], Coords).rgb
+                     * texture (Textures [i], Coords).a
+                     * (1.0 - Fade [i]);
+                                      
+        Color.a    = max (Color.a, texture (Textures [i],
+                                            Coords).a);
+    }
+    
+    return Color;
+}
+
+
+
 struct light
 {
    vec4    Site;
@@ -15,7 +42,7 @@ uniform mat4        model_Transform;
 uniform mat3        inverse_model_Rotation;
 uniform vec3        camera_Site;
 uniform vec3        specular_Color;    // The materials specular color.
-uniform sampler2D   Texture;
+//uniform sampler2D   Texture;
 uniform int         light_Count;
 uniform light       Lights [10];
 
@@ -29,6 +56,8 @@ in  float  frag_Shine;
 out vec4   final_Color;
 
 
+
+
 vec3
 apply_Light (light   Light, 
              vec3    surface_Color, 
@@ -92,16 +121,15 @@ apply_Light (light   Light,
 
 
 
+
 void
 main()
 {
     vec3   surface_Site      = vec3 (  model_Transform
                                      * vec4 (frag_Site, 1));
-                                   
+    vec4   surface_Color     = mix (apply_Texturing (frag_Coords),
-    vec4   surface_Color     = mix (texture (Texture, frag_Coords),
                                     frag_Color,
                                     0.5);
-
     vec3   Surface_to_Camera = normalize (camera_Site - surface_Site);
     vec3   Normal            = normalize (frag_Normal * inverse_model_Rotation);
 
@@ -119,7 +147,6 @@ main()
     }
     
     vec3  Gamma = vec3 (1.0 / 2.2);
-
     final_Color = vec4 (pow (linear_Color,     // Final color (after gamma correction).
                              Gamma),
                         surface_Color.a);

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

@@ -1,4 +1,6 @@
-#version 140
+// Include 'version.header'.
+// Include 'texturing.frag'.
+
 
 struct light
 {
@@ -15,7 +17,7 @@ uniform mat4        model_Transform;
 uniform mat3        inverse_model_Rotation;
 uniform vec3        camera_Site;
 uniform vec3        specular_Color;    // The materials specular color.
-uniform sampler2D   Texture;
+
 uniform int         light_Count;
 uniform light       Lights [10];
 
@@ -28,6 +30,8 @@ in  float  frag_Shine;
 out vec4   final_Color;
 
 
+
+
 vec3
 apply_Light (light   Light, 
              vec3    surface_Color, 
@@ -91,18 +95,16 @@ apply_Light (light   Light,
 
 
 
+
 void
 main()
 {
     vec3   surface_Site      = vec3 (  model_Transform
                                      * vec4 (frag_Site, 1));
-                                   
+    vec4   surface_Color     = apply_Texturing (frag_Coords);
-    vec4   surface_Color     = texture (Texture, frag_Coords);
-
     vec3   Surface_to_Camera = normalize (camera_Site - surface_Site);
     vec3   Normal            = normalize (  frag_Normal
                                           * inverse_model_Rotation);
-
     // Combine color from all the lights.
     //
     vec3   linear_Color = vec3 (0);
@@ -117,7 +119,6 @@ main()
     }
     
     vec3  Gamma = vec3 (1.0 / 2.2);
-
     final_Color = vec4 (pow (linear_Color,     // Final color (after gamma correction).
                              Gamma),
                         surface_Color.a);

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

@@ -1,12 +1,11 @@
-#version 140
+// Include 'version.header'.
+// Include 'texturing.frag'.
 
-uniform sampler2D   sTexture; 
+in  vec2   frag_Coords;
-
+out vec4   final_Color;
-varying vec4        vColor;
-varying vec2        vCoords;
 
 
 void main()
 {
-   gl_FragColor = texture2D (sTexture, vCoords)  *  vColor;   // Modulate light color with texture.
+   final_Color = apply_Texturing (frag_Coords);
 }

3-mid/opengl/assets/shader/textured.vert

@@ -3,23 +3,14 @@
 uniform mat4   mvp_Transform;
 uniform vec3   Scale;
 
+in vec3        Site;
+in vec2        Coords;
 
-attribute vec3   Site;
+out vec2       frag_Coords;
-attribute vec2   Coords;
-
-
-varying   vec4   vColor;
-varying   vec2   vCoords;
-
-
-const float      c_zero = 0.0;
-const float      c_one  = 1.0;
 
 
 void main()
 {
+   frag_Coords = Coords;
    gl_Position = mvp_Transform * vec4 (Site * Scale, 1.0);
-   
-   vColor  = vec4 (1.0, 1.0, 1.0, 1.0);
-   vCoords = Coords;
 }

3-mid/opengl/library/opengl.gpr

@@ -23,7 +23,7 @@ is
       when "lean" =>
          for Source_Dirs use ("../source/lean", 
                               "../source/lean/buffer",
-                              "../source/lean/geometry/**",
+                              "../source/lean/geometry",
                               "../source/lean/light",
                               "../source/lean/model",
                               "../source/lean/renderer",
@@ -35,7 +35,7 @@ is
       when "desk" =>
          for Source_Dirs use ("../source/lean", 
                               "../source/lean/buffer",
-                              "../source/lean/geometry/**",
+                              "../source/lean/geometry",
                               "../source/lean/light",
                               "../source/lean/model",
                               "../source/lean/renderer",

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

@@ -15,6 +15,7 @@ with
      Interfaces.C.Strings,
      System.storage_Elements;
 
+
 package body openGL.Geometry.lit_colored_textured
 is
    use GL.lean,
@@ -273,23 +274,96 @@ is
    end Indices_are;
 
 
+
+
+
+   --- Texturing
+   --
+
+   procedure Fade_is (Self : in out Item;   Which : texture_ID;   Now : in Geometry.texturing.fade_Level)
+   is
+   begin
+      Self.Textures.Textures (Which).Fade := Now;
+   end Fade_is;
+
+
+   function Fade (Self : in Item;   Which : texture_ID) return Geometry.texturing.fade_Level
+   is
+   begin
+      return Self.Textures.Textures (Which).Fade;
+   end Fade;
+
+
+
+
+
+   procedure Texture_is (Self : in out Item;   Which : texture_ID;   Now : in openGL.Texture.Object)
+   is
+      use openGL.Geometry.texturing;
+   begin
+      Texture_is (in_Set => Self.Textures,
+                  Which  => Which,
+                  Now    => Now);
+   end Texture_is;
+
+
+
+   function Texture (Self : in Item;   Which : texture_ID) return openGL.Texture.Object
+   is
+   begin
+      return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
+                                                Which  => Which);
+   end Texture;
+
+
+
+   overriding
+   procedure Texture_is (Self : in out Item;   Now : in openGL.Texture.Object)
+   is
+      use openGL.Geometry.texturing;
+   begin
+      Texture_is (in_Set => Self.Textures,
+                  Now    => Now);
+   end Texture_is;
+
+
+   overriding
+   function Texture (Self : in Item) return openGL.Texture.Object
+   is
+   begin
+      return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
+                                                Which  => 1);
+   end Texture;
+
+
+
    overriding
    procedure enable_Texture (Self : in out Item)
    is
-      use GL,
+      use openGL.Geometry.texturing;
-          GL.Binding,
-          openGL.Texture;
    begin
-      Tasks.check;
+      enable (Self.Textures, Self.Program);
-
-      glActiveTexture (gl.GL_TEXTURE0);
-      Errors.log;
-
-      if Self.Texture = openGL.Texture.null_Object
-      then   enable (white_Texture);
-      else   enable (Self.Texture);
-      end if;
    end enable_Texture;
 
 
+
+   --  overriding
+   --  procedure enable_Texture (Self : in out Item)
+   --  is
+   --     use GL,
+   --         GL.Binding,
+   --         openGL.Texture;
+   --  begin
+   --     Tasks.check;
+   --
+   --     glActiveTexture (gl.GL_TEXTURE0);
+   --     Errors.log;
+   --
+   --     if Self.Texture = openGL.Texture.null_Object
+   --     then   enable (white_Texture);
+   --     else   enable (Self.Texture);
+   --     end if;
+   --  end enable_Texture;
+
+
 end openGL.Geometry.lit_colored_textured;

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

@@ -1,3 +1,7 @@
+with
+     openGL.Geometry.texturing;
+
+
 package openGL.Geometry.lit_colored_textured
 --
 --  Supports per-vertex site color, texture and lighting.
@@ -35,11 +39,31 @@ is
    procedure Indices_are    (Self : in out Item;   Now       : in Indices;
                                                    for_Facia : in Positive);
 
+   --- Texturing.
+   --
+
+   procedure Fade_is      (Self : in out Item;   Which : texture_ID;   Now : in Geometry.texturing.fade_Level);
+   function  Fade         (Self : in     Item;   Which : texture_ID)     return Geometry.texturing.fade_Level;
+
+
+   procedure Texture_is   (Self : in out Item;   Which : texture_ID;   Now : in openGL.Texture.Object);
+   function  Texture      (Self : in     Item;   Which : texture_ID)     return openGL.Texture.Object;
+
+   overriding
+   procedure Texture_is   (Self : in out Item;   Now : in openGL.Texture.Object);
+
+   overriding
+   function  Texture      (Self : in     Item)     return openGL.Texture.Object;
+
 
 
 private
 
-   type Item is new Geometry.item with null record;
+   type Item is new Geometry.item with
+      record
+         Textures : Geometry.texturing.texture_Set;
+      end record;
+
 
    overriding
    procedure enable_Texture (Self : in out Item);

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

@@ -8,13 +8,14 @@ with
      openGL.Tasks,
      openGL.Errors,
 
-     GL.Binding,
      GL.lean,
      GL.Pointers,
 
      Interfaces.C.Strings,
      System.storage_Elements;
 
+--  with ada.Text_IO; use ada.Text_IO;
+
 
 package body openGL.Geometry.lit_textured
 is
@@ -82,8 +83,10 @@ is
             white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
 
             vertex_Shader  .define (Shader.Vertex,   "assets/opengl/shader/lit_textured.vert");
-            fragment_Shader.define (Shader.Fragment, "assets/opengl/shader/lit_textured.frag");
 
+            fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
+                                                                    2 => to_Asset ("assets/opengl/shader/texturing.frag"),
+                                                                    3 => to_Asset ("assets/opengl/shader/lit_textured.frag"))));
             the_Program := new openGL.Program.lit.item;
             the_Program.define (  vertex_Shader'Access,
                                 fragment_Shader'Access);
@@ -152,6 +155,7 @@ is
       end if;
 
       Self.Program_is (the_Program.all'Access);
+
       return Self;
    end new_Geometry;
 
@@ -245,25 +249,73 @@ is
    end Indices_are;
 
 
+
+
+
+   --- Texturing
+   --
+
+   procedure Fade_is (Self : in out Item;   Which : texture_ID;   Now : in Geometry.texturing.fade_Level)
+   is
+   begin
+      Self.Textures.Textures (Which).Fade := Now;
+   end Fade_is;
+
+
+   function Fade (Self : in Item;   Which : texture_ID) return Geometry.texturing.fade_Level
+   is
+   begin
+      return Self.Textures.Textures (Which).Fade;
+   end Fade;
+
+
+
+   procedure Texture_is (Self : in out Item;   Which : texture_ID;   Now : in openGL.Texture.Object)
+   is
+      use openGL.Geometry.texturing;
+   begin
+      Texture_is (in_Set => Self.Textures,
+                  Which  => Which,
+                  Now    => Now);
+   end Texture_is;
+
+
+
+   function Texture (Self : in Item;   Which : texture_ID) return openGL.Texture.Object
+   is
+   begin
+      return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
+                                                Which  => Which);
+   end Texture;
+
+
+
+   overriding
+   procedure Texture_is (Self : in out Item;   Now : in openGL.Texture.Object)
+   is
+      use openGL.Geometry.texturing;
+   begin
+      Texture_is (in_Set => Self.Textures,
+                  Now    => Now);
+   end Texture_is;
+
+
+   overriding
+   function Texture (Self : in Item) return openGL.Texture.Object
+   is
+   begin
+      return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
+                                                Which  => 1);
+   end Texture;
+
+
+
    overriding
    procedure enable_Texture (Self : in out Item)
    is
-      use GL,
+      use openGL.Geometry.texturing;
-          GL.Binding,
-          openGL.Texture;
-
-      check_is_OK : constant Boolean := openGL.Tasks.Check;     pragma Unreferenced (check_is_OK);
-
    begin
-      Tasks.check;
+      enable (Self.Textures, Self.Program);
-
-      glActiveTexture (gl.GL_TEXTURE0);
-      Errors.log;
-
-      if Self.Texture = openGL.Texture.null_Object
-      then   enable (white_Texture);
-      else   enable (Self.Texture);
-      end if;
    end enable_Texture;
 
 

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

@@ -1,3 +1,7 @@
+with
+     openGL.Geometry.texturing;
+
+
 package openGL.Geometry.lit_textured
 --
 --  Supports per-vertex site texture and lighting.
@@ -38,9 +42,31 @@ is
                                                  for_Facia : in Positive);
 
 
+   --- Texturing.
+   --
+
+   procedure Fade_is      (Self : in out Item;   Which : texture_ID;   Now : in Geometry.texturing.fade_Level);
+   function  Fade         (Self : in     Item;   Which : texture_ID)     return Geometry.texturing.fade_Level;
+
+
+   procedure Texture_is   (Self : in out Item;   Which : texture_ID;   Now : in openGL.Texture.Object);
+   function  Texture      (Self : in     Item;   Which : texture_ID)     return openGL.Texture.Object;
+
+   overriding
+   procedure Texture_is   (Self : in out Item;   Now : in openGL.Texture.Object);
+
+   overriding
+   function  Texture      (Self : in     Item)     return openGL.Texture.Object;
+
+
+
 private
 
-   type Item is new Geometry.item with null record;
+   type Item is new Geometry.item with
+      record
+         Textures : Geometry.texturing.texture_Set;
+      end record;
+
 
    overriding
    procedure enable_Texture (Self : in out Item);

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

@@ -6,9 +6,6 @@ with
      openGL.Attribute,
      openGL.Texture,
      openGL.Tasks,
-     openGL.Errors,
-
-     GL.Binding,
      GL.lean,
      GL.Pointers,
 
@@ -75,9 +72,10 @@ is
          begin
             white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
 
-            vertex_Shader  .define (openGL.Shader.vertex,   "assets/opengl/shader/textured.vert");
+            vertex_Shader  .define (Shader.vertex,   "assets/opengl/shader/textured.vert");
-            fragment_Shader.define (openGL.Shader.fragment, "assets/opengl/shader/textured.frag");
+            fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
-
+                                                                    2 => to_Asset ("assets/opengl/shader/texturing.frag"),
+                                                                    3 => to_Asset ("assets/opengl/shader/textured.frag"))));
             the_Program := new openGL.Program.item;
 
             the_Program.define (  vertex_Shader'Access,
@@ -118,6 +116,8 @@ is
    end new_Geometry;
 
 
+
+
    --------------
    --  Attributes
    --
@@ -163,23 +163,94 @@ is
    end Indices_are;
 
 
+
+   --- Texturing
+   --
+
+   procedure Fade_is (Self : in out Item;   Which : texture_ID;   Now : in Geometry.texturing.fade_Level)
+   is
+   begin
+      Self.Textures.Textures (Which).Fade := Now;
+   end Fade_is;
+
+
+
+   function Fade (Self : in Item;   Which : texture_ID) return Geometry.texturing.fade_Level
+   is
+   begin
+      return Self.Textures.Textures (Which).Fade;
+   end Fade;
+
+
+
+   procedure Texture_is (Self : in out Item;   Which : texture_ID;   Now : in openGL.Texture.Object)
+   is
+      use openGL.Geometry.texturing;
+   begin
+      Texture_is (in_Set => Self.Textures,
+                  Which  => Which,
+                  Now    => Now);
+   end Texture_is;
+
+
+
+   function Texture (Self : in Item;   Which : texture_ID) return openGL.Texture.Object
+   is
+   begin
+      return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
+                                                Which  => Which);
+   end Texture;
+
+
+
+   overriding
+   procedure Texture_is (Self : in out Item;   Now : in openGL.Texture.Object)
+   is
+      use openGL.Geometry.texturing;
+   begin
+      Texture_is (in_Set => Self.Textures,
+                  Now    => Now);
+   end Texture_is;
+
+
+
+   overriding
+   function Texture (Self : in Item) return openGL.Texture.Object
+   is
+   begin
+      return openGL.Geometry.texturing.Texture (in_Set => Self.Textures,
+                                                Which  => 1);
+   end Texture;
+
+
+
    overriding
    procedure enable_Texture (Self : in out Item)
    is
-      use GL,
+      use openGL.Geometry.texturing;
-          GL.Binding,
-          openGL.Texture;
    begin
-      Tasks.check;
+      enable (Self.Textures, Self.Program);
-
-      glActiveTexture (gl.GL_TEXTURE0);
-      Errors.log;
-
-      if Self.Texture = openGL.Texture.null_Object
-      then   white_Texture.enable;
-      else   Self.Texture .enable;
-      end if;
    end enable_Texture;
 
 
+
+   --  overriding
+   --  procedure enable_Texture (Self : in out Item)
+   --  is
+   --     use GL,
+   --         GL.Binding,
+   --         openGL.Texture;
+   --  begin
+   --     Tasks.check;
+   --
+   --     glActiveTexture (gl.GL_TEXTURE0);
+   --     Errors.log;
+   --
+   --     if Self.Texture = openGL.Texture.null_Object
+   --     then   white_Texture.enable;
+   --     else   Self.Texture .enable;
+   --     end if;
+   --  end enable_Texture;
+
+
 end openGL.Geometry.textured;

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

@@ -1,3 +1,7 @@
+with
+     openGL.Geometry.texturing;
+
+
 package openGL.Geometry.textured
 --
 --  Supports per-vertex site and texture.
@@ -35,9 +39,31 @@ is
                                                    for_Facia : in Positive);
 
 
+   --- Texturing.
+   --
+
+   procedure Fade_is    (Self : in out Item;   Which : texture_ID;   Now : in Geometry.texturing.fade_Level);
+   function  Fade       (Self : in     Item;   Which : texture_ID)     return Geometry.texturing.fade_Level;
+
+
+   procedure Texture_is (Self : in out Item;   Which : texture_ID;   Now : in openGL.Texture.Object);
+   function  Texture    (Self : in     Item;   Which : texture_ID)     return openGL.Texture.Object;
+
+   overriding
+   procedure Texture_is (Self : in out Item;   Now : in openGL.Texture.Object);
+
+   overriding
+   function  Texture    (Self : in     Item)     return openGL.Texture.Object;
+
+
+
 private
 
-   type Item is new Geometry.item with null record;
+   type Item is new Geometry.item with
+      record
+         Textures : Geometry.texturing.texture_Set;
+      end record;
+
 
    overriding
    procedure enable_Texture (Self : in out Item);

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

@@ -74,6 +74,7 @@ is
    is
       use GL.Pointers,
           C.Strings;
+      use ada.Text_IO;
 
       use type interfaces.C.char_array;
 
@@ -84,10 +85,12 @@ is
    begin
       Tasks.check;
 
-      --  for i in the_Source'Range
+
-      --  loop
+      new_Line (20);
-      --     put (Character (the_Source (i)));
+      for i in the_Source'Range
-      --  end loop;
+      loop
+         put (Character (the_Source (i)));
+      end loop;
 
 
       Self.Kind := Kind;