gel.world.rid: Complete rid sprite procedure.

1-base/lace/source/events/mixin/lace-event-make_subject.adb

@@ -4,8 +4,6 @@ with
      system.RPC,
      ada.unchecked_Deallocation;
 
-with ada.Text_IO; use ada.Text_IO;
-
 
 package body lace.event.make_Subject
 is

1-base/lace/source/events/mixin/private/lace-event_emitter.adb

@@ -1,8 +1,9 @@
 with
      lace.Observer,
-     lace.Event.Containers,
      lace.Event.utility,
+     lace.event.Containers,
 
+     ada.Containers.indefinite_Holders,
      ada.Text_IO,
      ada.Exceptions,
      ada.unchecked_Deallocation,

1-base/lace/source/events/mixin/private/lace-event_emitter.ads

@@ -5,8 +5,6 @@ with
 private
 with
      lace.Subject,
-     lace.event.Containers,
-     ada.Containers.indefinite_Holders,
      ada.Containers.indefinite_Vectors;
 
 

1-base/lace/source/events/mixin/xgc/lace-event-make_observer-deferred.adb

@@ -3,8 +3,6 @@ with
      lace.Event.utility,
      ada.unchecked_Deallocation;
 
-with ada.Text_IO; use ada.Text_IO;
-
 
 package body lace.event.make_Observer.deferred
 is

1-base/lace/source/text/lace-text-forge.adb

@@ -2,8 +2,7 @@ with
      ada.Characters.latin_1,
      ada.Directories,
      ada.Direct_IO,
-     ada.Streams.Stream_IO,
+     ada.Streams.Stream_IO;
-     ada.Text_IO;
 
 
 package body lace.Text.forge

3-mid/opengl/applet/demo/lights/diffuse_light/launch_diffuse_light.adb

@@ -1,7 +1,9 @@
+with openGL.Model.texturing;
 with
      openGL.Light,
      openGL.Visual,
      openGL.Model.Box.lit_textured,
+     openGL.texture_Set,
      openGL.Palette,
      openGL.Demo;
 
@@ -38,7 +40,8 @@ begin
                                                             Upper => (texture_Name => the_Texture),
                                                             Lower => (texture_Name => the_Texture),
                                                             Left  => (texture_Name => the_Texture),
-                                                            Right => (texture_Name => the_Texture)));
+                                                            Right => (texture_Name => the_Texture)),
+                                                  texture_Details => openGL.texture_Set.to_Details ([1 => the_Texture]));
       --  The Visual.
       --
       the_Visuals : constant openGL.Visual.views := (1 => new_Visual (the_Box.all'Access));

3-mid/opengl/applet/demo/lights/render_lighting/launch_render_lighting.adb

@@ -3,6 +3,7 @@ with
      openGL.Visual,
      openGL.Model.Sphere.lit_colored_textured,
      openGL.Model.Sphere.lit_colored,
+     openGL.texture_Set,
      openGL.Palette,
      openGL.Demo;
 
@@ -29,8 +30,9 @@ begin
       --  The Models.
       --
       the_Ball_1_Model : constant Model.Sphere.lit_colored_textured.view
-        := openGL.Model.Sphere.lit_colored_textured.new_Sphere (Radius => 1.0,
+        := openGL.Model.Sphere.lit_colored_textured.new_Sphere (Radius          => 1.0,
-                                                                Image  => the_Texture);
+                                                                texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture]),
+                                                                Image           => the_Texture);
       the_Ball_2_Model : constant Model.Sphere.lit_colored.view
         := openGL.Model.Sphere.lit_colored.new_Sphere (Radius => 1.0,
                                                        Color  => (light_Apricot, Opaque));

3-mid/opengl/applet/demo/models/render_asteroids/launch_render_asteroids.adb

@@ -1,7 +1,8 @@
 with
      openGL.Model.any,
      openGL.Visual,
-     openGL.Light.directional,
+     openGL.Light,
+     openGL.texture_Set,
      openGL.Demo;
 
 procedure launch_render_Asteroids
@@ -16,24 +17,30 @@ is
 begin
    Demo.define      ("openGL 'Render Asteroids' Demo");
    Demo.print_Usage ("Use space ' ' to cycle through models.");
-   Demo.Camera.Position_is ((0.0, 0.0, 200.0),
+   Demo.Camera.Position_is ([0.0, 0.0, 200.0],
                             y_Rotation_from (to_Radians (0.0)));
 
    declare
-      the_Light : openGL.Light.directional.item := Demo.Renderer.Light (1);
+      the_Light : openGL.Light.item := Demo.Renderer.new_Light;
    begin
-      the_Light.Site_is ((5_000.0, 2_000.0, 5_000.0));
+      the_Light.Site_is ([5_000.0, 2_000.0, 5_000.0]);
-      Demo.Renderer.Light_is (1, the_Light);
+      the_Light.ambient_Coefficient_is (0.05);
+      Demo.Renderer.set (the_Light);
    end;
 
    declare
       --  The models.
       --
 
+      --  gaspra_Model : constant openGL.Model.any.view := openGL.Model.any.new_Model (Model            => to_Asset ("assets/gaspra.tab"),
+      --                                                                               Texture          => null_Asset,
+      --                                                                               texture_Details  => openGL.texture_Set.no_Details,
+      --                                                                               Texture_is_lucid => False);
       gaspra_Model : constant openGL.Model.any.view := openGL.Model.any.new_Model (Model            => to_Asset ("assets/gaspra.tab"),
-                                                                                   Texture          => null_Asset,
+                                                                                   Texture          => to_Asset ("./assets/opengl/texture/Face1.bmp"),
+                                                                                   texture_Details  => openGL.texture_Set.to_Details ([1 => to_Asset ("./assets/opengl/texture/Face1.bmp")]),
                                                                                    Texture_is_lucid => False);
-      the_Models   : constant openGL.Model.views    := (1 => gaspra_Model.all'unchecked_Access);
+      the_Models   : constant openGL.Model.views    := [1 => gaspra_Model.all'unchecked_Access];
 
       --  The visuals.
       --
@@ -79,7 +86,7 @@ begin
 
          --  Render all visuals.
          --
-         Demo.Camera.render ((1 => the_Visuals (Current)));
+         Demo.Camera.render ([1 => the_Visuals (Current)]);
 
          while not Demo.Camera.cull_Completed
          loop

3-mid/opengl/applet/demo/models/render_billboards/launch_render_billboards.adb

@@ -2,6 +2,7 @@ with
      openGL.Visual,
      openGL.Model.Billboard.        textured,
      openGL.Model.Billboard.colored_textured,
+     openGL.texture_Set,
      openGL.Palette,
      openGL.Demo;
 
@@ -27,21 +28,23 @@ begin
       the_Billboard_Model : constant Model.Billboard.textured.view
         := Model.Billboard.textured.forge.new_Billboard (--Scale   => (1.0, 1.0, 1.0),
                                                          Plane   => Billboard.xy,
-                                                         Texture => the_Texture);
+                                                         Texture => the_Texture,
+                                                         texture_Details  => openGL.texture_Set.to_Set ([1 => the_Texture]));
 
       the_colored_Billboard_Model : constant Model.Billboard.colored_textured.view
         := Model.Billboard.colored_textured.new_Billboard (--Scale   => (1.0, 1.0, 1.0),
                                                            Plane   => Billboard.xy,
                                                            Color   => (Palette.Green, Opaque),
-                                                           Texture => the_Texture);
+                                                           Texture => the_Texture,
+                                                           texture_Details  => openGL.texture_Set.to_Set ([1 => the_Texture]));
       --  The Sprites.
       --
       use openGL.Visual.Forge;
 
-      the_Sprites : constant openGL.Visual.views := [new_Visual (        the_Billboard_Model.all'Access),
+      the_Visuals : constant openGL.Visual.views := [new_Visual (        the_Billboard_Model.all'Access),
                                                      new_Visual (the_colored_Billboard_Model.all'Access)];
    begin
-      the_Sprites (2).Site_is ([3.0, 0.0, 0.0]);
+      the_Visuals (2).Site_is ([3.0, 0.0, 0.0]);
 
       --  Main loop.
       --
@@ -54,7 +57,7 @@ begin
 
          --  Render the sprites.
          --
-         Demo.Camera.render (the_Sprites);
+         Demo.Camera.render (the_Visuals);
 
          while not Demo.Camera.cull_Completed
          loop

3-mid/opengl/applet/demo/models/render_boxes/launch_render_boxes.adb

@@ -1,3 +1,4 @@
+with openGL.texture_Set;
 with
      openGL.Visual,
 
@@ -8,6 +9,7 @@ with
      openGL.Palette,
      openGL.Demo;
 
+
 procedure launch_render_Boxes
 --
 --  Exercise the rendering of box models.
@@ -58,7 +60,8 @@ begin
                         Upper => (texture_Name => the_Texture),
                         Lower => (texture_Name => the_Texture),
                         Left  => (texture_Name => the_Texture),
-                        Right => (texture_Name => the_Texture)]);
+                        Right => (texture_Name => the_Texture)],
+              texture_Details => texture_Set.to_Set ([1 => the_Texture]));
 
       --  The Visuals.
       --

3-mid/opengl/applet/demo/models/render_capsules/launch_render_capsules.adb

@@ -33,7 +33,7 @@ begin
       the_Capsule_Model : constant Model.Capsule.lit_colored_textured.view
         := Model.Capsule.lit_colored_textured.new_Capsule (Radius => 0.5,
                                                            Height => 2.0,
-                                                           Color  => (White, Opaque),
+                                                           Color  => (Green, Opaque),
                                                            Image  => the_Texture);
       --  The Visuals.
       --
@@ -42,6 +42,7 @@ begin
       the_Visuals : constant openGL.Visual.views := [1 => new_Visual (the_Capsule_Model.all'Access)];
    begin
       the_Light.Site_is ([0.0, 5.0, 10.0]);
+      the_Light.ambient_Coefficient_is (0.05);
       Demo.Renderer.set (the_Light);
 
       --  Main loop.

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

@@ -3,9 +3,7 @@ with
      openGL.Visual,
      openGL.Light,
      openGL.Palette,
-     openGL.Demo,
+     openGL.Demo;
-
-     ada.Text_IO;
 
 
 procedure launch_render_Models
@@ -16,8 +14,7 @@ is
    use openGL,
        openGL.Math,
        openGL.linear_Algebra_3D,
-       openGL.Palette,
+       openGL.Palette;
-       ada.Text_IO;
 
 begin
    Demo.print_Usage ("Use space ' ' to cycle through models.");
@@ -41,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.
       --
@@ -81,7 +56,7 @@ 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.

3-mid/opengl/applet/demo/renderer/render_screenshot/launch_render_screenshot.adb

@@ -45,6 +45,9 @@ begin
          the_Visuals (i) := new_Visual (the_Models (i));
       end loop;
 
+      the_Visuals (1).Scale_is ([0.2, 0.2, 1.0]);     -- Text visual.
+
+
       --  Main loop.
       --
       while not Demo.Done

3-mid/opengl/applet/demo/renderer/render_text/launch_render_text.adb

@@ -3,8 +3,10 @@ with
      openGL.Palette,
      openGL.Font,
      openGL.Model.Text.lit_colored,
+     openGL.texture_Set,
      openGL.Demo;
 
+
 procedure launch_render_Text
 --
 --  Render updated text.
@@ -35,16 +37,20 @@ begin
         := Model.Text.lit_colored.new_Text (Text     => "Howdy",
                                             Font     => the_font_Id,
                                             Color    => (Red, Opaque),
+                                            texture_Details => openGL.texture_Set.to_Set ([1 => openGL.to_Asset ("assets/texture/Face1.bmp")]),
                                             Centered => False);
 
       --  The sprites.
       --
       use openGL.Visual.Forge;
 
-      the_Sprites : constant openGL.Visual.views := [1 => new_Visual (the_Text_Model.all'Access)];
+      the_Visuals : constant openGL.Visual.views := [1 => new_Visual (the_Text_Model.all'Access)];
-      Current     : constant Integer             := the_Sprites'First;
+      Current     : constant Integer             := the_Visuals'First;
 
    begin
+      the_Visuals (1).Scale_is ([0.2, 0.2, 1.0]);
+
+
       --  Main loop.
       --
       while not Demo.Done
@@ -78,7 +84,7 @@ begin
 
          --  Render all sprites.
          --
-         Demo.Camera.render ([1 => the_Sprites (Current)]);
+         Demo.Camera.render ([1 => the_Visuals (Current)]);
 
          while not Demo.Camera.cull_Completed
          loop

3-mid/opengl/applet/demo/textures/render_two_textures/launch_render_two_textures.adb

@@ -1,127 +0,0 @@
-with
-     openGL.Model.hexagon.lit_textured_x2,
-     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
---
---  Renders a hexagon grid.
---
-is
-   use openGL,
-       openGL.Math,
-       openGL.linear_Algebra_3D,
-       openGL.Palette,
-       openGL.Light;
-
-
-   --------------
-   --  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/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,
-                                                   Face   => (Texture_1 => the_1st_Texture,
-                                                              Texture_2 => the_2nd_Texture,
-                                                              Fade_1    => 0.5,
-                                                              Fade_2    => 0.5));
-   ----------------
-   ---  The visual.
-   --
-   use openGL.Visual.Forge;
-
-   the_Hex : constant openGL.Visual.view := new_Visual (the_textured_hexagon_Model.all'Access);
-
-   --------------
-   --- The light.
-   --
-   the_Light      :          openGL.Light.item := Demo.Renderer.new_Light;
-   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",
-                Width => 1_000,
-                Height =>1_000);
-
-   Demo.Camera.Position_is ([0.0, 2.0, 0.0],
-                            x_Rotation_from (to_Radians (90.0)));
-
-   -- Set up the light.
-   --
-   the_Light.        Kind_is        (Diffuse);
-   the_Light.        Site_is        (light_Site);
-   the_Light.        Color_is       (White);
-   the_Light.ambient_Coefficient_is (0.8);
-   the_Light.   cone_Angle_is       (5.0);
-   the_Light.   cone_Direction_is   (cone_Direction);
-
-   Demo.Renderer.set (the_Light);
-
-
-   --  Main loop.
-   --
-   while not Demo.Done
-   loop
-      Demo.Dolly.evolve;
-      Demo.Done := Demo.Dolly.quit_Requested;
-
-      Demo.Camera.render ([1 => the_Hex]);
-
-      while not Demo.Camera.cull_Completed
-      loop
-         delay Duration'Small;
-      end loop;
-
-      Demo.Renderer.render;
-      Demo.FPS_Counter.increment;    -- Frames per second display.
-
-
-      if Epoch mod 20 = 0
-      then
-         --  the_textured_hexagon_Model.Fade_is (which => 1, now => Fade);
-         --  the_textured_hexagon_Model.Fade_is (which => 2, now => 1.0 - Fade);
-
-         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/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

@@ -2,15 +2,16 @@ with
      "opengl_demo",
      "lace_shared"; 
 
-project render_two_Textures
+
+project tiling_Demo
 is
    for Object_Dir use "build";
    for Exec_Dir   use ".";
-   for Main       use ("launch_render_two_textures.adb");
+   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 render_two_Textures;
+end tiling_Demo;

3-mid/opengl/applet/demo/two_cameras/launch_two_cameras_demo.adb

@@ -1,3 +1,4 @@
+with openGL.texture_Set;
 with
      openGL.Camera,
      openGL.Palette,
@@ -54,7 +55,8 @@ begin
                         right => (colors => [others => (Red,      Opaque)],  texture_name => the_Face)]);
 
       the_ball_Model : constant Model.Sphere.lit_colored_textured.view
-        := Model.Sphere.lit_colored_textured.new_Sphere (radius => 0.5);
+        := Model.Sphere.lit_colored_textured.new_Sphere (radius => 0.5,
+                                                         texture_Details => texture_Set.to_Set ([1 => the_Face]));
 
       --  The Sprites.
       --

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

@@ -1,15 +1,24 @@
-#version 140
+// Include 'version.header'.
+// Include 'texturing-frag.snippet'.
 
-uniform sampler2D   sTexture; 
+in  vec3       frag_Site;
+in  vec4       frag_Color;
+in  vec2       frag_Coords;
 
-varying vec4        vColor;
+out vec4       final_Color;
-varying vec2        vCoords;
 
 
-void main()
+void
+main()
 {
-   gl_FragColor =   mix (texture2D (sTexture, vCoords),
+    vec4   surface_Color = mix (apply_Texturing (frag_Coords),
-                         vColor,
+                                frag_Color,
-                         0.5);
+                                0.5);
-}
 
+    vec3  Gamma = vec3 (1.0 / 2.2);
+    final_Color = vec4 
+    (pow
+     (surface_Color.rgb,     // Final color (after gamma correction).
+                             Gamma),
+                        surface_Color.a);
+}

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

@@ -3,17 +3,17 @@
 uniform   mat4   mvp_Transform;
 uniform   vec3   Scale;
 
-attribute vec3   Site;
+in  vec3   Site;
-attribute vec4   Color;
+in  vec4   Color;
-attribute vec2   Coords;
+in  vec2   Coords;
 
-varying   vec4   vColor;
+out vec4   frag_Color;
-varying   vec2   vCoords;
+out vec2   frag_Coords;
 
 
 void main()
 {
    gl_Position = mvp_Transform * vec4 (Site * Scale, 1.0);
-   vColor      = Color;
+   frag_Color  = Color;
-   vCoords     = Coords;
+   frag_Coords = Coords;
 }

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

@@ -5,8 +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)
@@ -15,12 +17,20 @@ apply_Texturing (vec2   Coords)
     
     for (int i = 0;   i < texture_Count;   ++i)
     {
-        Color.rgb +=   texture (Textures [i], Coords).rgb
+      if (texture_Applies [i])
-                     * texture (Textures [i], Coords).a
+      {
+           vec2    tiled_Coords;
+            
+           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);
+      }
     }
     
     return Color;
@@ -154,6 +164,9 @@ main()
                                      Surface_to_Camera);
     }
     
+    // linear_Color.g = 1.0;
+    linear_Color += surface_Color.rgb;
+    
     vec3   Gamma = vec3 (1.0 / 2.2);
 
     final_Color = vec4 (pow (linear_Color,     // Final color (after gamma correction).

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/private/freetype/source/freetype-face.adb

@@ -6,7 +6,6 @@ with
 
      interfaces.C.Strings,
 
-     ada.unchecked_Conversion,
      ada.unchecked_Deallocation,
      ada.Finalization;
 
@@ -23,7 +22,6 @@ is
    --- Utility
    --
 
-   function  to_Flag    is new ada.unchecked_Conversion   (FT_Kerning_Mode, C.unsigned);
    procedure deallocate is new ada.Unchecked_Deallocation (float_Array,     float_Array_view);
 
 
@@ -248,7 +246,7 @@ is
       Self.Err := FT_Get_Kerning (Self.ftFace,
                                   C.unsigned (index1),
                                   C.unsigned (index2),
-                                  to_Flag    (ft_Kerning_unfitted),
+                                  ft_Kerning_unfitted'enum_Rep,
                                   kernAdvance'unchecked_Access);
       if Self.Err /= 0
       then
@@ -323,7 +321,7 @@ is
          loop
             Self.Err := FT_Get_Kerning (Self.ftFace,
                                         i, j,
-                                        to_Flag (ft_Kerning_unfitted),
+                                        ft_Kerning_unfitted'enum_Rep,
                                         kernAdvance'unchecked_Access);
             if Self.Err /= 0
             then

3-mid/opengl/source/demo/opengl-demo.adb

@@ -1,4 +1,5 @@
 with
+     openGL.texture_Set,
      openGL.Palette,
      openGL.Font,
      openGL.IO,
@@ -150,20 +151,27 @@ is
         := Model.sphere.lit_colored.new_Sphere (Radius => 1.0, Color => (Green, Opaque));
 
       the_ball_3_Model : constant Model.sphere.lit_textured.view
-        := Model.sphere.lit_textured.new_Sphere (Radius => 1.0, Image => the_Texture);
+        := Model.sphere.lit_textured.new_Sphere (Radius => 1.0,
+                                                 texture_Details => texture_Set.to_Set ([1 => the_Texture]),
+                                                 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);
+        := Model.sphere.lit_colored_textured.new_Sphere (Radius => 1.0,
+                                                         Color  => (Green, Opaque),
+                                                         texture_Details => texture_Set.to_Set ([1 => the_Texture]),
+                                                         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,
+                                                         texture_Details => texture_Set.to_Set ([1 => the_Texture]),
                                                          Texture => the_Texture);
 
       the_colored_billboard_Model : constant Model.billboard.textured.view               -- TODO: Add color.
         := Model.billboard.textured.forge.new_Billboard (Size    => (1.0, 1.0),
                                                          Plane   => Billboard.xy,
-                                                         Texture => the_Texture);
+                                                         Texture => the_Texture,
+                                                         texture_Details => texture_Set.to_Set ([1 => the_Texture]));
       use Model.box;
 
       the_box_1_Model : constant Model.box.colored.view
@@ -179,23 +187,25 @@ is
       the_box_2_Model : constant Model.box.lit_textured.view
         := Model.box.lit_textured.new_Box
              (Size  => [1.0, 2.0, 1.0],
-              Faces => [others => (texture_Name => the_Texture)]);
+              Faces => [others => (texture_Name => the_Texture)],
+              texture_Details => texture_Set.to_Set ([1 => the_Texture]));
 
       the_box_3_Model : constant Model.box.textured.view
         := Model.box.textured.new_Box
              (Size  => [1.0, 2.0, 3.0],
-              Faces => [others => (texture_Name => the_Texture)]);
+              Faces => [others => (texture_Name => the_Texture)],
+              texture_Details => texture_Set.to_Set ([1 => the_Texture]));
+
 
       the_capsule_Model : constant Model.capsule.lit_textured.view
         := Model.capsule.lit_textured.new_Capsule (Radius => 0.5,
                                                    Height => 2.0,
+                                                   texture_Details => texture_Set.to_Set ([1 => the_Texture]),
                                                    Image  => the_Texture);
 
       the_lit_textured_circle_Model : constant Model.circle.lit_textured.view
         := Model.circle.lit_textured.new_Circle (Radius => 1.5,
-                                                 Face   => (Fades         => (1 => 0.0,         others => <>),
+                                                 Texture_Details => (openGL.texture_Set.to_Set ([1 => the_Texture])),
-                                                            Textures      => (1 => the_Texture, others => <>),
-                                                            texture_Count => 1),
                                                  Sides  => 24);
 
       the_grid_Model    : constant Model.grid.view
@@ -210,9 +220,7 @@ is
 
       the_textured_hexagon_Model : constant Model.hexagon.lit_textured.view
         := Model.hexagon.lit_textured.new_Hexagon (Radius => 0.5,
-                                                   Face   => (Fades         => (1 => 0.0,         others => <>),
+                                                   texture_Details => texture_Set.to_Set ([1 => the_Texture]));
-                                                              Textures      => (1 => the_Texture, others => <>),
-                                                              texture_Count => 1));
 
       the_faceted_hexagon_column_Model : constant Model.hexagon_Column.lit_colored_faceted.view
         := Model.hexagon_Column.lit_colored_faceted.new_hexagon_Column
@@ -247,6 +255,7 @@ is
         := Model.any.new_Model (--Scale            => (1.0, 1.0, 1.0),
                                 Model            => to_Asset ("assets/opengl/model/human.obj"),
                                 Texture          => the_Texture,
+                                texture_Details  => openGL.texture_Set.to_Set ([1 => the_Texture]),
                                 Texture_is_lucid => False);
 
       the_lit_colored_polygon_Model : constant Model.polygon.lit_colored.view
@@ -255,15 +264,13 @@ is
 
       the_lit_textured_polygon_Model : constant Model.polygon.lit_textured.view
         := Model.polygon.lit_textured.new_Polygon (vertex_Sites => [Origin_2D, [1.0, 0.0], [1.0, 1.0], [-1.0, 0.5]],
-                                                   Face         => (Fades          => (1 => 0.0,         others => <>),
+                                                   texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture]));
-                                                                    Textures       => (1 => the_Texture, others => <>),
-                                                                    texture_Tiling => <>,
-                                                                    texture_Count  => 1));
 
       the_text_Model : constant Model.Text.lit_colored.view
         := Model.Text.lit_colored.new_Text (Text     => "Once upon a midnight dreary ...",
                                             Font     => the_font_Id,
                                             Color    => (Green, Opaque),
+                                            texture_Details => openGL.texture_Set.to_Set ([1 => the_Texture]),
                                             Centered => True);
 
       the_segment_line_Model : constant Model.segment_line.view
@@ -279,12 +286,13 @@ is
       Tiling       : constant texture_Transform_2d := (S => (0.0, 1.0),
                                                        T => (0.0, 1.0));
       the_ground_Model : constant Model.terrain.view
-        := Model.Terrain.new_Terrain (heights_Asset => heights_File,
+        := Model.Terrain.new_Terrain (heights_Asset   => heights_File,
-                                      Row           => 1,
+                                      Row             => 1,
-                                      Col           => 1,
+                                      Col             => 1,
-                                      Heights       => the_Region.all'Access,
+                                      Heights         => the_Region.all'Access,
-                                      Color_Map     => texture_File,
+                                      Color_Map       => texture_File,
-                                      Tiling        => Tiling);
+                                      texture_Details => openGL.texture_Set.to_Set ([1 => texture_File]),
+                                      Tiling          => Tiling);
    begin
       Demo.Renderer.add_Font (the_font_Id);
 
@@ -294,10 +302,10 @@ is
       the_segment_line_Model.add_Segment     (end_Site   => [2.0, 2.0, 0.0]);
       the_segment_line_Model.add_Segment     (end_Site   => [0.0, 2.0, 0.0]);
 
-      return [                the_ground_Model.all'Access,
+      return [                  the_text_Model.all'Access,
+                              the_ground_Model.all'Access,
                 the_lit_textured_polygon_Model.all'Access,
                  the_lit_colored_polygon_Model.all'Access,
-                                the_text_Model.all'Access,
                                the_arrow_Model.all'Access,
                               the_ball_1_Model.all'Access,
                               the_ball_2_Model.all'Access,

3-mid/opengl/source/lean/buffer/opengl-buffer-general.adb

@@ -4,6 +4,7 @@ with
 
      GL.Pointers;
 
+
 package body openGL.Buffer.general
 is
    --------------------------
@@ -53,6 +54,7 @@ is
                           From'Size / 8,
                          +From (From'First)'Address,
                           to_GL_Enum (Usage));
+            Errors.log;
          end return;
       end to_Buffer;
 
@@ -78,6 +80,7 @@ is
                           Offset =>  GLintptr ((Position - 1) * Vertex_Size_in_bits / 8),
                           Size   =>  new_Vertices'Size / 8,
                           Data   => +new_Vertices (new_Vertices'First)'Address);
+         Errors.log;
       else
          Self.destroy;
 
@@ -89,9 +92,8 @@ is
                        To'Size / 8,
                       +To (To'First)'Address,
                        to_GL_Enum (Self.Usage));
+         Errors.log;
       end if;
-
-      Errors.log;
    end set;
 
 

3-mid/opengl/source/lean/buffer/opengl-buffer-general.ads

@@ -5,6 +5,7 @@ generic
    type Element       is private;
    type Element_Array is array (Index range <>) of Element;
 
+
 package openGL.Buffer.general
 --
 --  A generic for producing various types of openGL vertex buffer objects.

3-mid/opengl/source/lean/buffer/opengl-buffer-indices.ads

@@ -1,6 +1,7 @@
 with
      openGL.Buffer.general;
 
+
 package openGL.Buffer.indices is new openGL.Buffer.general (base_Object   => Buffer.element_array_Object,
                                                             Index         => long_Index_t,
                                                             Element       => Index_t,

3-mid/opengl/source/lean/buffer/opengl-buffer-long_indices.ads

@@ -1,6 +1,7 @@
 with
      openGL.Buffer.general;
 
+
 package openGL.Buffer.long_indices is new openGL.Buffer.general (base_Object   => Buffer.element_array_Object,
                                                                  Index         => long_Index_t,
                                                                  Element       => long_Index_t,

3-mid/opengl/source/lean/buffer/opengl-buffer-normals.ads

@@ -1,6 +1,7 @@
 with
      openGL.Buffer.general;
 
+
 package openGL.Buffer.normals is new openGL.Buffer.general (base_Object   => Buffer.array_Object,
                                                             Index         => Index_t,
                                                             Element       => Normal,

3-mid/opengl/source/lean/buffer/opengl-buffer-short_indices.ads

@@ -1,6 +1,7 @@
 with
      openGL.Buffer.general;
 
+
 package openGL.Buffer.short_indices is new openGL.Buffer.general (base_Object   => Buffer.element_array_Object,
                                                                   Index         => long_Index_t,
                                                                   Element       => short_Index_t,

3-mid/opengl/source/lean/buffer/opengl-buffer-texture_coords.ads

@@ -1,6 +1,7 @@
 with
      openGL.Buffer.general;
 
+
 package openGL.Buffer.texture_coords is new openGL.Buffer.general (base_Object   => Buffer.array_Object,
                                                                    Index         => Index_t,
                                                                    Element       => Coordinate_2D,

3-mid/opengl/source/lean/buffer/opengl-buffer-vertex.ads

@@ -1,6 +1,7 @@
 with
      openGL.Buffer.general;
 
+
 package openGL.Buffer.vertex is new openGL.Buffer.general (base_Object   => Buffer.array_Object,
                                                            Index         => Index_t,
                                                            Element       => Site,

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

@@ -3,6 +3,7 @@ with
      openGL.Tasks,
      ada.unchecked_Deallocation;
 
+
 package body openGL.Buffer
 is
    use type a_Name;
@@ -17,7 +18,7 @@ is
       Name : aliased a_Name;
    begin
       Tasks.check;
-      glGenBuffers (1, Name'unchecked_Access);
+      glGenBuffers (1, Name'unchecked_Access);      Errors.log;
       return Name;
    end new_vbo_Name;
 
@@ -28,8 +29,9 @@ is
       Name : aliased a_Name := vbo_Name;
    begin
       Tasks.check;
-      glDeleteBuffers (1, Name'unchecked_Access);
+      glDeleteBuffers (1, Name'unchecked_Access);      Errors.log;
    end free;
+
    pragma Unreferenced (free);
 
 

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

@@ -3,6 +3,7 @@ with
      GL.lean,
      ada.unchecked_Conversion;
 
+
 package openGL.Buffer
 --
 --  Models a buffer object.
@@ -11,7 +12,7 @@ is
    --------------
    --- Core Types
    --
-   subtype a_Name is GL.GLuint;                                    -- An openGL vertex buffer 'Name', which is a natural integer.
+   subtype a_Name is GL.GLuint;                                    -- An openGL vertex buffer 'Name'.
    type    a_Kind is (array_Buffer, element_array_Buffer);
    type     Usage is (stream_Draw, static_Draw, dynamic_Draw);
 
@@ -121,4 +122,5 @@ private
    --
    procedure verify_Name (Self : in out Object'Class);
 
+
 end openGL.Buffer;

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

@@ -12,6 +12,7 @@ with
      Interfaces.C.Strings,
      System.storage_Elements;
 
+
 package body openGL.Geometry.colored
 is
    use GL.lean, GL.Pointers;

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

@@ -35,9 +35,7 @@ is
 
 private
 
-   type Item is new Geometry.item with
+   type Item is new Geometry.item with null record;
-      record
+
-         null;
-      end record;
 
 end openGL.Geometry.colored;

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

@@ -3,12 +3,9 @@ with
      openGL.Buffer.general,
      openGL.Program,
      openGL.Attribute,
-     openGL.Texture,
-     openGL.Palette,
      openGL.Tasks,
      openGL.Errors,
 
-     GL.Binding,
      GL.lean,
      GL.Pointers,
 
@@ -16,6 +13,7 @@ with
      Interfaces.C.Strings,
      System.storage_Elements;
 
+
 package body openGL.Geometry.colored_textured
 is
    use GL.lean,
@@ -29,7 +27,6 @@ is
    vertex_Shader        : aliased Shader.item;
    fragment_Shader      : aliased Shader.item;
    the_Program          :         openGL.Program.view;
-   white_Texture        :         openGL.Texture.Object;
 
    Name_1 : constant String := "Site";
    Name_2 : constant String := "Color";
@@ -64,8 +61,7 @@ is
       if the_Program = null
       then   -- Define the shaders and program.
          declare
-            use Palette,
+            use Attribute.Forge;
-                Attribute.Forge;
 
             Sample : Vertex;
 
@@ -73,12 +69,11 @@ is
             Attribute_2 : Attribute.view;
             Attribute_3 : Attribute.view;
 
-            white_Image : constant Image := [1 .. 2 => [1 .. 2 => +White]];
          begin
-            white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
-
             vertex_Shader  .define (Shader.Vertex,   "assets/opengl/shader/colored_textured.vert");
-            fragment_Shader.define (Shader.Fragment, "assets/opengl/shader/colored_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.snippet"),
+                                                                    3 => to_Asset ("assets/opengl/shader/colored_textured.frag"))));
 
             the_Program := new openGL.Program.item;
             the_Program.define (vertex_Shader  'Access,
@@ -194,23 +189,4 @@ is
    end Indices_are;
 
 
-   --  overriding
-   --  procedure enable_Textures (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_Textures;
-
-
 end openGL.Geometry.colored_textured;

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

@@ -1,7 +1,3 @@
-with
-     openGL.texture_Set;
-
-
 private
 with
      openGL.Geometry.texturing;
@@ -47,20 +43,7 @@ private
 
    package textured_Geometry is new texturing.Mixin;
 
+   type Item is new textured_Geometry.item with null record;
 
-   type Item is new textured_Geometry.item with
-      record
-         null;
-      end record;
-
-
-   --  type Item is new Geometry.item with
-   --     record
-   --        null;
-   --     end record;
-   --
-   --
-   --  overriding
-   --  procedure enable_Textures (Self : in out Item);
 
 end openGL.Geometry.colored_textured;

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

@@ -37,4 +37,5 @@ private
 
    type Item is new Geometry.item with null record;
 
+
 end openGL.Geometry.lit_colored;

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

@@ -2,7 +2,6 @@ with
      openGL.Shader,
      openGL.Attribute,
      openGL.Buffer.general,
-     openGL.Texture,
      openGL.Tasks,
      openGL.Errors,
 
@@ -209,6 +208,7 @@ is
    end define_Program;
 
 
+
    --------------
    --  Attributes
    --

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

@@ -1,9 +1,10 @@
 with
      openGL.Program.lit.colored_skinned;
 
+
 package openGL.Geometry.lit_colored_skinned
 --
---  Supports per-vertex site color, texture, lighting and skinning.
+--  Supports per-vertex site color, lighting and skinning.
 --
 is
    type Item is new openGL.Geometry.item with private;
@@ -28,8 +29,10 @@ is
          bone_Ids     : Vector_4;
          bone_Weights : Vector_4;
       end record;
+
    pragma Convention (C, Vertex);
 
+
    type Vertex_array is array (long_Index_t range <>) of aliased Vertex;
 
 
@@ -55,4 +58,5 @@ private
    overriding
    procedure enable_Textures (Self : in out Item);
 
+
 end openGL.Geometry.lit_colored_skinned;

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

@@ -1,14 +1,11 @@
 with
      openGL.Program.lit,
-     openGL.Palette,
      openGL.Shader,
      openGL.Buffer.general,
      openGL.Attribute,
-     openGL.Texture,
      openGL.Tasks,
      openGL.Errors,
 
-     GL.Binding,
      GL.lean,
      GL.Pointers,
 
@@ -18,8 +15,7 @@ with
 
 package body openGL.Geometry.lit_colored_textured
 is
-   use openGL.texture_Set,
+   use GL.lean,
-       GL.lean,
        GL.Pointers,
        Interfaces,
        System;
@@ -64,7 +60,6 @@ is
    Attribute_4_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_4_Name'Access);
    Attribute_5_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_5_Name'Access);
 
-   white_Texture : openGL.Texture.Object;
 
 
    ---------
@@ -73,6 +68,7 @@ is
 
    type Geometry_view is access all Geometry.lit_colored_textured.item'Class;
 
+
    function new_Geometry (texture_is_Alpha : in Boolean) return access Geometry.lit_colored_textured.item'Class
    is
       use type openGL.Program.lit.view;
@@ -81,8 +77,7 @@ is
       procedure define (the_Program         : access Program;
                         use_fragment_Shader : in     String)
       is
-         use openGL.Palette,
+         use Attribute.Forge,
-             Attribute.Forge,
              system.Storage_Elements;
 
          Sample : Vertex;
@@ -93,10 +88,7 @@ is
          Attribute_4 : openGL.Attribute.view;
          Attribute_5 : openGL.Attribute.view;
 
-         white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
-
       begin
-         white_Texture       := openGL.Texture.Forge.to_Texture (white_Image);
          the_Program.Program := new openGL.Program.lit.item;
 
          the_Program.vertex_Shader.define (Shader.Vertex, "assets/opengl/shader/lit_colored_textured.vert");
@@ -204,6 +196,7 @@ is
          textured_Geometry.create_Uniforms (for_Program => the_Program.Program.all'Access);
       end define;
 
+
       Self : constant Geometry_view := new Geometry.lit_colored_textured.item;
 
    begin
@@ -234,6 +227,7 @@ is
    end new_Geometry;
 
 
+
    ----------
    --  Vertex
    --
@@ -250,6 +244,7 @@ is
    end is_Transparent;
 
 
+
    --------------
    --  Attributes
    --
@@ -266,7 +261,7 @@ is
    begin
       if Self.Vertices = null
       then
-         self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (Forge.to_Buffer (Now,
+         Self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (Forge.to_Buffer (Now,
                                                                                            usage => Buffer.static_Draw));
       else
          set (openGL_Buffer_of_geometry_Vertices.Object (Self.Vertices.all),
@@ -288,6 +283,7 @@ is
    end Vertices_are;
 
 
+
    overriding
    procedure Indices_are  (Self : in out Item;   Now       : in Indices;
                                                  for_Facia : in Positive)
@@ -297,93 +293,4 @@ is
    end Indices_are;
 
 
-
-
-
-   --- Texturing
-   --
-
-   --  procedure Fade_is (Self : in out Item;   Which : texture_Set.texture_ID;   Now : in texture_Set.fade_Level)
-   --  is
-   --  begin
-   --     Self.Textures.Textures (Which).Fade := Now;
-   --  end Fade_is;
-   --
-   --
-   --  function Fade (Self : in     Item;   Which : texture_Set.texture_ID)     return texture_Set.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
-   --  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.texture_Set.Texture (in_Set => Self.Textures,
-   --                                      which  => Which);
-   --  end Texture;
-   --
-   --
-   --
-   --  overriding
-   --  procedure Texture_is (Self : in out Item;   Now : in openGL.Texture.Object)
-   --  is
-   --  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.texture_Set.Texture (in_Set => Self.Textures,
-   --                                      which  => 1);
-   --  end Texture;
-   --
-   --
-   --
-   --  overriding
-   --  procedure enable_Textures (Self : in out Item)
-   --  is
-   --  begin
-   --     enable (Self.Textures, Self.Program);
-   --  end enable_Textures;
-   --
-
-
-   --  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,7 +1,3 @@
-with
-     openGL.texture_Set;
-
-private
 with
      openGL.Geometry.texturing;
 
@@ -11,7 +7,10 @@ package openGL.Geometry.lit_colored_textured
 --  Supports 'per-vertex' site, color, texture and lighting.
 --
 is
-   type Item is new openGL.Geometry.item with private;
+   package textured_Geometry is new texturing.Mixin;
+
+
+   type Item is new textured_Geometry.item with private;
    type View is access all Item'Class;
 
    function new_Geometry (texture_is_Alpha : in Boolean) return access Geometry.lit_colored_textured.item'Class;
@@ -43,44 +42,10 @@ is
    procedure Indices_are    (Self : in out Item;   Now       : in Indices;
                                                    for_Facia : in Positive);
 
-   --- Texturing.
-   --
-
-   --  procedure Fade_is      (Self : in out Item;   Now   : in texture_Set.fade_Level;
-   --                                                Which : in texture_Set.texture_ID := 1);
-   --  function  Fade         (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level;
-   --
-   --
-   --  procedure Texture_is   (Self : in out Item;   Now   : in openGL.Texture.Object;
-   --                                                Which : in texture_Set.texture_ID);
-   --  function  Texture      (Self : in     Item;   Which : in texture_Set.texture_ID := 1) 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
 
-   package textured_Geometry is new texturing.Mixin;
+   type Item is new textured_Geometry.item with null record;
 
 
-   type Item is new textured_Geometry.item with
-      record
-         null;
-      end record;
-
-
-   --  type Item is new Geometry.item with
-   --     record
-   --        Textures : texture_Set.Item;
-   --     end record;
-
-
-   --  overriding
-   --  procedure enable_Textures (Self : in out Item);
-
 end openGL.Geometry.lit_colored_textured;

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

@@ -2,12 +2,9 @@ with
      openGL.Shader,
      openGL.Attribute,
      openGL.Buffer.general,
-     openGL.Texture,
-     openGL.Palette,
      openGL.Tasks,
      openGL.Errors,
 
-     GL.Binding,
      GL.lean,
      GL.Pointers,
 
@@ -51,7 +48,6 @@ is
    Attribute_6_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_6_Name'Access);
    Attribute_7_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_7_Name'Access);
 
-   white_Texture   : openGL.Texture.Object;
 
 
    ----------
@@ -74,6 +70,7 @@ is
    end is_Transparent;
 
 
+
    ---------
    --  Forge
    --
@@ -93,8 +90,7 @@ is
 
    procedure define_Program
    is
-      use Palette,
+      use Attribute.Forge,
-          Attribute.Forge,
           GL.lean,
           GL.Pointers,
           System.storage_Elements;
@@ -109,8 +105,6 @@ is
       Attribute_6 : openGL.Attribute.view;
       Attribute_7 : openGL.Attribute.view;
 
-      white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
-
    begin
       Tasks.check;
 
@@ -123,8 +117,6 @@ is
 
       -- Define the shaders and program.
       --
-      white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
-
       vertex_Shader  .define (Shader.Vertex,   "assets/opengl/shader/lit_colored_textured_skinned.vert");
       fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
                                                               2 => to_Asset ("assets/opengl/shader/lighting-frag.snippet"),
@@ -242,6 +234,7 @@ is
    end define_Program;
 
 
+
    --------------
    --  Attributes
    --
@@ -290,36 +283,4 @@ is
    end Vertices_are;
 
 
-
-   --  overriding
-   --  procedure enable_Textures (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
-   --        if not white_Texture.is_Defined
-   --        then
-   --           declare
-   --              use Palette;
-   --              white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
-   --           begin
-   --              white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
-   --           end;
-   --        end if;
-   --
-   --        white_Texture.enable;
-   --     else
-   --        Self.Texture.enable;
-   --     end if;
-   --  end enable_Textures;
-
-
 end openGL.Geometry.lit_colored_textured_skinned;

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

@@ -1,6 +1,5 @@
 with
-     openGL.Program.lit.colored_textured_skinned,
+     openGL.Program.lit.colored_textured_skinned;
-     openGL.texture_Set;
 
 
 private
@@ -8,7 +7,6 @@ with
      openGL.Geometry.texturing;
 
 
-
 package openGL.Geometry.lit_colored_textured_skinned
 --
 --  Supports 'per-vertex' site, color, texture, lighting and skinning.
@@ -39,6 +37,7 @@ is
 
    pragma Convention (C, Vertex);
 
+
    type Vertex_array is array (long_Index_t range <>) of aliased Vertex;
 
 
@@ -60,16 +59,7 @@ private
 
    package textured_Geometry is new texturing.Mixin;
 
+   type Item is new textured_Geometry.item with null record;
 
-   type Item is new textured_Geometry.item with
-      record
-         null;
-      end record;
-
-
-   --  type Item is new Geometry.item with null record;
-   --
-   --  overriding
-   --  procedure enable_Textures (Self : in out Item);
 
 end openGL.Geometry.lit_colored_textured_skinned;

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

@@ -1,30 +1,22 @@
 with
-     openGL.Geometry.texturing,
      openGL.Buffer.general,
-     openGL.Model,
      openGL.Shader,
      openGL.Program.lit,
      openGL.Attribute,
-     openGL.Texture,
-     openGL.Palette,
      openGL.Tasks,
      openGL.Errors,
 
      GL.lean,
      GL.Pointers,
 
-     ada.Strings.fixed,
      Interfaces.C.Strings,
      System.storage_Elements;
 
---  with ada.Text_IO; use ada.Text_IO;
-
 
 package body openGL.Geometry.lit_textured
 is
    use GL.lean,
        GL.Pointers,
-       openGL.texture_Set,
        Interfaces;
 
    -----------
@@ -34,8 +26,7 @@ is
    vertex_Shader        : aliased Shader.item;
    fragment_Shader      : aliased Shader.item;
 
-   the_Program          : openGL.Program.lit.view;
+   the_Program          :          openGL.Program.lit.view;
-   white_Texture        : openGL.Texture.Object;
 
    Name_1               : constant String := "Site";
    Name_2               : constant String := "Normal";
@@ -52,8 +43,6 @@ is
    Attribute_3_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_3_Name'Access);
    Attribute_4_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_4_Name'Access);
 
-   --  texture_Uniforms     : texturing.Uniforms;
-
 
 
    ---------
@@ -62,8 +51,7 @@ is
 
    procedure create_Program
    is
-      use Palette,
+      use Attribute.Forge,
-          Attribute.Forge,
           System.storage_Elements;
 
       use type system.Address;
@@ -75,11 +63,7 @@ is
       Attribute_3 : Attribute.view;
       Attribute_4 : Attribute.view;
 
-      white_Image : constant Image := [1 .. 2 => [1 .. 2 => +White]];
-
    begin
-      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, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
                                                               2 => to_Asset ("assets/opengl/shader/texturing-frag.snippet"),
@@ -87,7 +71,7 @@ is
                                                               4 => to_Asset ("assets/opengl/shader/lit_textured.frag"))));
       the_Program := new openGL.Program.lit.item;
       the_Program.define (  vertex_Shader'Access,
-                            fragment_Shader'Access);
+                          fragment_Shader'Access);
       the_Program.enable;
 
       Attribute_1 := new_Attribute (Name        => Name_1,
@@ -150,27 +134,6 @@ is
                             name    => +Attribute_4_Name_ptr);
       Errors.log;
 
-
-      --- Set up the texturing uniforms.
-      --
-
-      --  for Id in texture_Id'Range
-      --  loop
-      --     declare
-      --        use ada.Strings,
-      --            ada.Strings.fixed;
-      --
-      --        i                    : constant Positive := Positive (Id);
-      --        texture_uniform_Name : constant String   := "Textures[" & trim (Natural'Image (i - 1), Left) & "]";
-      --        fade_uniform_Name    : constant String   := "Fade["     & trim (Natural'Image (i - 1), Left) & "]";
-      --     begin
-      --        texture_Uniforms.Textures (Id).texture_Uniform := the_Program.uniform_Variable (named => texture_uniform_Name);
-      --        texture_Uniforms.Textures (Id).   fade_Uniform := the_Program.uniform_Variable (named =>    fade_uniform_Name);
-      --     end;
-      --  end loop;
-      --
-      --  texture_Uniforms.Count := the_Program.uniform_Variable ("texture_Count");
-
       textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access);
    end create_Program;
 
@@ -197,7 +160,6 @@ is
 
 
 
-
    ----------
    --  Vertex
    --
@@ -220,7 +182,6 @@ is
 
 
 
-
    --------------
    --  Attributes
    --
@@ -291,75 +252,4 @@ is
    end Indices_are;
 
 
-
-
-
-   --- Texturing
-   --
-
-   --  procedure Fade_is (Self : in out Item;   Which : texture_ID;   Now : in texture_Set.fade_Level)
-   --  is
-   --  begin
-   --     Self.texture_Set.Textures (which).Fade := Now;
-   --  end Fade_is;
-   --
-   --
-   --
-   --  function Fade (Self : in     Item;   Which : texture_Set.texture_ID)     return texture_Set.fade_Level
-   --  is
-   --  begin
-   --     return Self.texture_Set.Textures (which).Fade;
-   --  end Fade;
-   --
-   --
-   --
-   --  procedure Texture_is (Self : in out Item;   Which : texture_ID;   Now : in openGL.Texture.Object)
-   --  is
-   --  begin
-   --     Texture_is (in_Set => Self.texture_Set,
-   --                 Which  => Which,
-   --                 Now    => Now);
-   --  end Texture_is;
-   --
-   --
-   --
-   --  function Texture (Self : in Item;   Which : texture_ID) return openGL.Texture.Object
-   --  is
-   --  begin
-   --     return openGL.texture_Set.Texture (in_Set => Self.texture_Set,
-   --                                        Which  => Which);
-   --  end Texture;
-   --
-   --
-   --
-   --  overriding
-   --  procedure Texture_is (Self : in out Item;   Now : in openGL.Texture.Object)
-   --  is
-   --  begin
-   --     Texture_is (in_Set => Self.texture_Set,
-   --                 Now    => Now);
-   --  end Texture_is;
-   --
-   --
-   --
-   --  overriding
-   --  function Texture (Self : in Item) return openGL.Texture.Object
-   --  is
-   --  begin
-   --     return texture_Set.Texture (in_Set => Self.texture_Set,
-   --                                 Which  => 1);
-   --  end Texture;
-
-
-
-   --  overriding
-   --  procedure enable_Textures (Self : in out Item)
-   --  is
-   --  begin
-   --     texturing.enable (for_Model   => Self.Model.all'Access,
-   --                       Uniforms    => texture_Uniforms,
-   --                       texture_Set => Self.texture_Set);
-   --  end enable_Textures;
-
-
 end openGL.Geometry.lit_textured;

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

@@ -1,6 +1,3 @@
-with
-     openGL.texture_Set;
-
 private
 with
      openGL.Geometry.texturing;
@@ -46,36 +43,11 @@ is
                                                  for_Facia : in Positive);
 
 
-   --- Texturing.
-   --
-
-   --  procedure Fade_is      (Self : in out Item;   Which : texture_Set.texture_ID;   Now : in texture_Set.fade_Level);
-   --  function  Fade         (Self : in     Item;   Which : texture_Set.texture_ID)     return texture_Set.fade_Level;
-   --
-   --
-   --  procedure Texture_is   (Self : in out Item;   Which : texture_Set.texture_ID;   Now : in openGL.Texture.Object);
-   --  function  Texture      (Self : in     Item;   Which : texture_Set.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
 
    package textured_Geometry is new texturing.Mixin;
 
+   type Item is new textured_Geometry.item with null record;
 
-   type Item is new textured_Geometry.item with
-      record
-         null;
-      end record;
-
-
-   --  overriding
-   --  procedure enable_Textures (Self : in out Item);
 
 end openGL.Geometry.lit_textured;

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

@@ -2,12 +2,9 @@ with
      openGL.Shader,
      openGL.Attribute,
      openGL.Buffer.general,
-     openGL.Texture,
-     openGL.Palette,
      openGL.Tasks,
      openGL.Errors,
 
-     GL.Binding,
      GL.lean,
      GL.Pointers,
 
@@ -49,7 +46,6 @@ is
    Attribute_5_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_5_Name'Access);
    Attribute_6_Name_ptr : aliased constant C.strings.chars_ptr := C.strings.to_chars_ptr (Attribute_6_Name'Access);
 
-   white_Texture   : openGL.Texture.Object;
 
 
    ----------
@@ -83,8 +79,7 @@ is
 
    procedure define_Program
    is
-      use Palette,
+      use Attribute.Forge,
-          Attribute.Forge,
           GL.lean,
           GL.Pointers,
           System.storage_Elements;
@@ -98,8 +93,6 @@ is
       Attribute_5 : openGL.Attribute.view;
       Attribute_6 : openGL.Attribute.view;
 
-      white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
-
    begin
       Tasks.check;
 
@@ -112,10 +105,7 @@ is
 
       -- Define the shaders and program.
       --
-      white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
-
       vertex_Shader  .define (Shader.Vertex,   "assets/opengl/shader/lit_textured_skinned.vert");
-      --  fragment_Shader.define (Shader.Fragment, "assets/opengl/shader/lit_textured_skinned.frag");
       fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
                                                               2 => to_Asset ("assets/opengl/shader/lighting-frag.snippet"),
                                                               3 => to_Asset ("assets/opengl/shader/texturing-frag.snippet"),
@@ -263,36 +253,4 @@ is
    end Vertices_are;
 
 
-
-   --  overriding
-   --  procedure enable_Textures (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
-   --        if not white_Texture.is_Defined
-   --        then
-   --           declare
-   --              use Palette;
-   --              white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
-   --           begin
-   --              white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
-   --           end;
-   --        end if;
-   --
-   --        white_Texture.enable;
-   --     else
-   --        Self.Texture.enable;
-   --     end if;
-   --  end enable_Textures;
-
-
 end openGL.Geometry.lit_textured_skinned;

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

@@ -1,6 +1,5 @@
 with
-     openGL.Program.lit.textured_skinned,
+     openGL.Program.lit.textured_skinned;
-     openGL.texture_Set;
 
 private
 with
@@ -58,16 +57,7 @@ private
 
    package textured_Geometry is new texturing.Mixin;
 
+   type Item is new textured_Geometry.item with null record;
 
-   type Item is new textured_Geometry.item with
-      record
-         null;
-      end record;
-
-
-   --  type Item is new Geometry.item with null record;
-   --
-   --  overriding
-   --  procedure enable_Textures (Self : in out Item);
 
 end openGL.Geometry.lit_textured_skinned;

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

@@ -2,14 +2,12 @@ with
      openGL.Buffer.general,
      openGL.Shader,
      openGL.Program,
-     openGL.Palette,
      openGL.Attribute,
-     openGL.Texture,
+     openGL.Errors,
      openGL.Tasks,
      GL.lean,
      GL.Pointers,
 
-     System,
      Interfaces.C.Strings,
      System.storage_Elements;
 
@@ -19,8 +17,6 @@ is
    use GL.lean,
        GL.Pointers,
 
-       openGL.texture_Set,
-
        Interfaces,
        System;
 
@@ -33,7 +29,6 @@ is
    fragment_Shader : aliased Shader.item;
 
    the_Program     : openGL.Program.view;
-   white_Texture   : openGL.Texture.Object;
 
    Name_1 : constant String := "Site";
    Name_2 : constant String := "Coords";
@@ -61,8 +56,7 @@ is
       if the_Program = null
       then   -- Define the shaders and program.
          declare
-            use Palette,
+            use Attribute.Forge,
-                Attribute.Forge,
                 system.Storage_Elements;
 
             Sample : Vertex;
@@ -70,11 +64,7 @@ is
             Attribute_1 : Attribute.view;
             Attribute_2 : Attribute.view;
 
-            white_Image : constant openGL.Image := [1 .. 2 => [1 .. 2 => +White]];
-
          begin
-            white_Texture := openGL.Texture.Forge.to_Texture (white_Image);
-
             vertex_Shader  .define (Shader.vertex,   "assets/opengl/shader/textured.vert");
             fragment_Shader.define (Shader.Fragment, (asset_Names' (1 => to_Asset ("assets/opengl/shader/version.header"),
                                                                     2 => to_Asset ("assets/opengl/shader/texturing-frag.snippet"),
@@ -107,10 +97,12 @@ is
             glBindAttribLocation (program => the_Program.gl_Program,
                                   index   => the_Program.Attribute (named => Name_1).gl_Location,
                                   name    => +Attribute_1_Name_ptr);
+            Errors.log;
 
             glBindAttribLocation (program => the_Program.gl_Program,
                                   index   => the_Program.Attribute (named => Name_2).gl_Location,
                                   name    => +Attribute_2_Name_ptr);
+            Errors.log;
 
             textured_Geometry.create_Uniforms (for_Program => the_Program.all'Access);
          end;
@@ -122,7 +114,6 @@ is
 
 
 
-
    --------------
    --  Attributes
    --
@@ -140,13 +131,12 @@ is
                                                                      Element       => Vertex,
                                                                      Element_Array => Vertex_array);
 
-
    procedure Vertices_are (Self : in out Item;   Now : in Vertex_array)
    is
       use openGL_Buffer_of_geometry_Vertices.Forge;
    begin
       Self.Vertices := new openGL_Buffer_of_geometry_Vertices.Object' (to_Buffer (Now,
-                                                                                  usage => Buffer.static_Draw));
+                                                                                  Usage => Buffer.static_Draw));
       -- Set the bounds.
       --
       declare
@@ -170,91 +160,4 @@ is
    end Indices_are;
 
 
-
-   --- Texturing
-   --
-
-   --  procedure Fade_is (Self : in out Item;   Which : texture_Set.texture_ID;   Now : in texture_Set.fade_Level)
-   --  is
-   --  begin
-   --     Self.Textures.Textures (Which).Fade := Now;
-   --  end Fade_is;
-   --
-   --
-   --
-   --  function Fade (Self : in     Item;   Which : texture_Set.texture_ID)     return texture_Set.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
-   --  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.texture_Set.Texture (in_Set => Self.Textures,
-   --                                      Which  => Which);
-   --  end Texture;
-   --
-   --
-   --
-   --  overriding
-   --  procedure Texture_is (Self : in out Item;   Now : in openGL.Texture.Object)
-   --  is
-   --  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.texture_Set.Texture (in_Set => Self.Textures,
-   --                                      which  => 1);
-   --  end Texture;
-   --
-   --
-   --
-   --  overriding
-   --  procedure enable_Textures (Self : in out Item)
-   --  is
-   --  begin
-   --     enable (Self.Textures, Self.Program);
-   --  end enable_Textures;
-
-
-
-   --  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,7 +1,3 @@
-with
-     openGL.texture_Set;
-
-
 private
 with
      openGL.Geometry.texturing;
@@ -45,42 +41,11 @@ is
                                                    for_Facia : in Positive);
 
 
-   --- Texturing.
-   --
-
-   --  procedure Fade_is    (Self : in out Item;   Which : texture_Set.texture_ID;   Now : in texture_Set.fade_Level);
-   --  function  Fade       (Self : in     Item;   Which : texture_Set.texture_ID)     return texture_Set.fade_Level;
-   --
-   --
-   --  procedure Texture_is (Self : in out Item;   Which : texture_Set.texture_ID;   Now : in openGL.Texture.Object);
-   --  function  Texture    (Self : in     Item;   Which : texture_Set.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
 
    package textured_Geometry is new texturing.Mixin;
 
+   type Item is new textured_Geometry.item with null record;
 
-   type Item is new textured_Geometry.item with
-      record
-         null;
-      end record;
-
-
-   --  type Item is new Geometry.item with
-   --     record
-   --        Textures : texture_Set.Item;
-   --     end record;
-   --
-   --
-   --  overriding
-   --  procedure enable_Textures (Self : in out Item);
 
 end openGL.Geometry.textured;

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

@@ -1,11 +1,10 @@
 with
      openGL.Model,
+     openGL.Errors,
      GL.lean,
      GL.Binding,
      ada.Strings.fixed;
 
-with ada.Text_IO;
-
 
 package body openGL.Geometry.texturing
 is
@@ -14,7 +13,7 @@ is
 
    type texture_Units is array (texture_Set.texture_Id) of GLenum;
 
-   all_texture_Units : constant texture_Units := (GL_TEXTURE0,
+   all_texture_Units : constant texture_Units := [GL_TEXTURE0,
                                                   GL_TEXTURE1,
                                                   GL_TEXTURE2,
                                                   GL_TEXTURE3,
@@ -29,7 +28,7 @@ is
                                                   GL_TEXTURE12,
                                                   GL_TEXTURE13,
                                                   GL_TEXTURE14,
-                                                  GL_TEXTURE15);
+                                                  GL_TEXTURE15];
                                                   --  GL_TEXTURE16,
                                                   --  GL_TEXTURE17,
                                                   --  GL_TEXTURE18,
@@ -49,10 +48,9 @@ is
 
 
 
-
    procedure enable (for_Model   : in openGL.Model.view;
-                     Uniforms    : in texturing.Uniforms;
+                     Uniforms    : in texturing.Uniforms)
-                     texture_Set : in openGL.texture_Set.Item)
+                     --  texture_Set : in openGL.texture_Set.Item)
    is
       use GL.Binding,
           GL.lean;
@@ -60,17 +58,22 @@ is
       use type GLint;
 
    begin
-      for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count)
+      if for_Model.texture_Count > 0
-      loop
+      then
-         Uniforms.Textures (i).fade_Uniform           .Value_is (Real (for_Model.Fade      (i)));
+         for i in 1 .. openGL.texture_Set.texture_Id (for_Model.texture_Count)
-         Uniforms.Textures (i).texture_applied_Uniform.Value_is (for_Model.texture_Applied (i));
+         loop
+            Uniforms.Textures (i).tiling_Uniform         .Value_is (Vector_2' ((for_Model.Tiling  (Which => i).S,
+                                                                                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,
+            glUniform1i     (Uniforms.Textures (i).texture_Uniform.gl_Variable,
-                          GLint (i) - 1);
+                             GLint (i) - 1);                                                 Errors.log;
-         glActiveTexture (all_texture_Units (i));
+            glActiveTexture (all_texture_Units (i));                                         Errors.log;
-         glBindTexture   (GL_TEXTURE_2D,
+            glBindTexture   (GL_TEXTURE_2D,
-                          texture_Set.Textures (i).Object.Name);
+                             for_Model.texture_Object (i).Name);                             Errors.log;
-      end loop;
+         end loop;
+      end if;
 
       Uniforms.Count.Value_is (for_Model.texture_Count);
    end enable;
@@ -91,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;
 
@@ -111,11 +116,9 @@ is
 
    package body Mixin
    is
-      use openGL.texture_Set;
-
-
       texture_Uniforms : texturing.Uniforms;
 
+
       procedure create_Uniforms (for_Program : in openGL.Program.view)
       is
       begin
@@ -129,7 +132,8 @@ is
                                                Which : in texture_Set.texture_ID := 1)
       is
       begin
-         Self.texture_Set.Textures (Which).Fade := Now;
+         Self.Model.Fade_is (Which => Which,
+                             Now   => Now);
       end Fade_is;
 
 
@@ -138,7 +142,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.Model.Fade (Which => Which);
       end Fade;
 
 
@@ -148,9 +152,8 @@ is
                                                   Which : in texture_Set.texture_ID := 1)
       is
       begin
-         Texture_is (in_Set => Self.texture_Set,
+         Self.Model.texture_Object_is (Which => Which,
-                     Which  => Which,
+                                       Now   => Now);
-                     Now    => Now);
       end Texture_is;
 
 
@@ -159,8 +162,7 @@ is
       function Texture (Self : in Item;   Which : texture_Set.texture_ID := 1) return openGL.Texture.Object
       is
       begin
-         return openGL.texture_Set.Texture (in_Set => Self.texture_Set,
+         return Self.Model.texture_Object (Which);
-                                            Which  => Which);
       end Texture;
 
 
@@ -170,34 +172,50 @@ is
                                                           Which : in texture_Set.texture_ID := 1)
       is
       begin
-         Self.texture_Set.Textures (Which).Applied := Now;
+         Self.Model.texture_Applied_is (Which, Now);
       end texture_Applied_is;
 
 
 
       overriding
-      function  texture_Applied    (Self : in Item;   Which : in texture_Set.texture_ID := 1) return Boolean
+      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.Model.texture_Applied (Which);
       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.Model.Tiling_is (Which => Which,
+                               Now   => 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.Model.Tiling (Which);
+      end Tiling;
+
+
+
       overriding
       procedure enable_Textures (Self : in out Item)
       is
       begin
-         --  ada.Text_IO.put_Line (Self.Model'Image);
-
          texturing.enable (for_Model   => Self.Model.all'Access,
-                           Uniforms    => texture_Uniforms,
+                           Uniforms    => texture_Uniforms);
-                           texture_Set => Self.texture_Set);
       end enable_Textures;
 
 
    end Mixin;
 
 
-
 end openGL.Geometry.texturing;

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

@@ -8,7 +8,6 @@ with
      openGL.Model;
 
 
-private
 package openGL.Geometry.texturing
 --
 -- Provides texturing support for geometries.
@@ -23,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;
 
 
@@ -41,17 +41,13 @@ is
    --
 
    procedure enable (for_Model   : in     openGL.Model.view;
-                     Uniforms    : in     texturing.Uniforms;
+                     Uniforms    : in     texturing.Uniforms);
-                     texture_Set : in     openGL.texture_Set.Item);
-
-
 
    procedure create (Uniforms    :    out texturing.Uniforms;
                      for_Program : in     openGL.Program.view);
 
 
 
-
    -------------
    --- Mixin ---
    -------------
@@ -65,19 +61,18 @@ is
       procedure create_Uniforms (for_Program : in     openGL.Program.view);
 
 
-
       overriding
-      procedure Fade_is      (Self : in out Item;   Now   : in texture_Set.fade_Level;
+      procedure Fade_is           (Self : in out Item;   Now   : in texture_Set.fade_Level;
-                                                    Which : in texture_Set.texture_ID := 1);
+                                                         Which : in texture_Set.texture_ID := 1);
       overriding
-      function  Fade         (Self : in     Item;   Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level;
+      function  Fade              (Self : in     Item;   Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level;
 
 
       overriding
-      procedure Texture_is   (Self : in out Item;   Now   : in openGL.Texture.Object;
+      procedure Texture_is         (Self : in out Item;   Now   : in openGL.Texture.Object;
-                                                    Which : in texture_Set.texture_ID := 1);
+                                                          Which : in texture_Set.texture_ID := 1);
       overriding
-      function  Texture      (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object;
+      function  Texture            (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object;
 
 
       overriding
@@ -86,6 +81,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
@@ -94,13 +94,9 @@ is
 
    private
 
-      type Item is new Geometry.item with
+      type Item is new Geometry.item with null record;
-         record
-            texture_Set : openGL.texture_Set.item;
-         end record;
 
    end Mixin;
 
 
-
 end openGL.Geometry.texturing;

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

@@ -45,7 +45,6 @@ is
 
 
 
-
    --------------
    --  Attributes
    --
@@ -112,7 +111,7 @@ is
    function Fade (Self : in Item;   Which : texture_Set.texture_ID := 1) return texture_Set.fade_Level
    is
    begin
-      raise program_Error with "Geometry has no texture.";
+      raise Error with "Geometry has no texture.";
       return texture_Set.fade_Level'Last;
    end Fade;
 
@@ -121,7 +120,7 @@ is
    function Texture (Self : in Item;   Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object
    is
    begin
-      raise program_Error with "Geometry has no texture.";
+      raise Error with "Geometry has no texture.";
       return openGL.Texture.null_Object;
    end Texture;
 
@@ -130,12 +129,23 @@ is
    function texture_Applied (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return Boolean
    is
    begin
-      raise program_Error with "Geometry has no texture.";
+      raise Error with "Geometry has no texture.";
       return False;
    end texture_Applied;
 
 
 
+   function Tiling (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return texture_Set.Tiling
+   is
+   begin
+      raise 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
@@ -151,7 +161,7 @@ is
 
 
 
-   function Bounds (self : in Item'Class) return openGL.Bounds
+   function Bounds (Self : in Item'Class) return openGL.Bounds
    is
    begin
       return Self.Bounds;
@@ -186,7 +196,6 @@ is
 
 
 
-
    --------------
    --  Operations
    --
@@ -221,7 +230,6 @@ is
 
 
 
-
    -----------
    --  Normals
    --
@@ -298,6 +306,7 @@ is
    pragma Unreferenced (facet_Count_in);
 
 
+
    ----------
    --  Facets
    --
@@ -318,6 +327,7 @@ is
    --  'Facets_of' returns all non-redundant facets.
 
 
+
    function any_Facets_of (face_Kind : in primitive.facet_Kind;
                            Indices   : in any_Indices) return access Facets
    is
@@ -350,9 +360,11 @@ is
                is
                   when Triangles
                      | triangle_Fan =>
+
                      the_Facets (Count) := [P1, P2, P3];
 
                   when triangle_Strip =>
+
                      if Each mod 2 = 0
                      then   -- Is an even facet.
                         the_Facets (Count) := [P1, P3, P2];
@@ -377,6 +389,7 @@ is
    end any_Facets_of;
 
 
+
    function Facets_of is new any_Facets_of (Index_t,
                                             Indices);
    pragma Unreferenced (Facets_of);
@@ -469,7 +482,7 @@ is
       free (the_Facets);
       free (the_facet_Normals);
 
-      return the_Normals.all'Unchecked_Access;
+      return the_Normals.all'unchecked_Access;
    end any_Normals_of;
 
 
@@ -526,7 +539,6 @@ is
 
 
 
-
    ---------------
    -- Transparency
    --

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

@@ -47,25 +47,29 @@ is
    procedure Model_is (Self : in out Item;   Now : in Model_view);
    function  Model    (Self : in     Item)     return Model_view;
 
-   procedure Label_is        (Self : in out Item'Class;   Now : in String);
+   procedure Label_is (Self : in out Item'Class;   Now : in String);
-   function  Label           (Self : in     Item'Class)     return String;
+   function  Label    (Self : in     Item'Class)     return String;
 
 
    --- Texturing
    --
 
-   procedure Fade_is         (Self : in out Item;   Now   : in texture_Set.fade_Level;
+   procedure Fade_is            (Self : in out Item;   Now   : in texture_Set.fade_Level;
-                                                    Which : in texture_Set.texture_ID := 1) is null;
+                                                       Which : in texture_Set.texture_ID := 1) is null;
-   function  Fade            (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level;
+   function  Fade               (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return texture_Set.fade_Level;
 
-   procedure Texture_is      (Self : in out Item;   Now   : in openGL.Texture.Object;
+   procedure Texture_is         (Self : in out Item;   Now   : in openGL.Texture.Object;
-                                                    Which : in texture_Set.texture_ID := 1) is null;
+                                                       Which : in texture_Set.texture_ID := 1) is null;
-   function  Texture         (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object;
+   function  Texture            (Self : in     Item;   Which : in texture_Set.texture_ID := 1) return openGL.Texture.Object;
 
    procedure texture_Applied_is (Self : in out Item;   Now   : in Boolean;
                                                        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);
@@ -131,11 +135,15 @@ private
    generic
       type any_Index_t is range <>;
       with function get_Site (Index : in any_Index_t) return Vector_3;
+
    function get_Bounds (Count : in Natural) return openGL.Bounds;
 
+
    generic
       type any_Index_t is range <>;
       with function get_Color (Index : in any_Index_t) return rgba_Color;
+
    function get_Transparency (Count : in Natural) return Boolean;
 
+
 end openGL.Geometry;

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

@@ -6,6 +6,7 @@ with
      GL.Binding,
      GL.lean;
 
+
 package body openGL.Primitive.indexed
 is
    ---------
@@ -48,7 +49,7 @@ is
 
       Self.facet_Kind := Kind;
       Self.Indices    := new openGL.Buffer.indices.Object' (to_Buffer (buffer_Indices'Access,
-                                                                       usage => Buffer.static_Draw));
+                                                                       Usage => Buffer.static_Draw));
       Self.line_Width := line_Width;
    end define;
 
@@ -88,6 +89,7 @@ is
    end destroy;
 
 
+
    --------------
    --  Attributes
    --

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

@@ -2,6 +2,7 @@ private
 with
      openGL.Buffer.indices;
 
+
 package openGL.Primitive.indexed
 --
 --  Provides a class for indexed openGL primitives.
@@ -37,6 +38,7 @@ is
    procedure destroy (Self : in out Item);
 
 
+
    --------------
    --  Attributes
    --
@@ -45,6 +47,7 @@ is
    procedure Indices_are (Self : in out Item;   Now : in long_Indices);
 
 
+
    --------------
    --  Operations
    --

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

@@ -6,6 +6,7 @@ with
 
      ada.unchecked_Deallocation;
 
+
 package body openGL.Primitive.long_indexed
 is
    ---------
@@ -25,7 +26,7 @@ is
 
       Self.facet_Kind := Kind;
       Self.Indices    := new Buffer.long_indices.Object' (to_Buffer (buffer_Indices'Access,
-                                                                     usage => Buffer.static_Draw));
+                                                                     Usage => Buffer.static_Draw));
    end define;
 
 
@@ -52,6 +53,7 @@ is
    end destroy;
 
 
+
    --------------
    --  Attributes
    --
@@ -70,6 +72,7 @@ is
    end Indices_are;
 
 
+
    --------------
    --  Operations
    --

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

@@ -2,6 +2,7 @@ private
 with
      openGL.Buffer.long_indices;
 
+
 package openGL.Primitive.long_indexed
 --
 --  Provides a class for long indexed openGL primitives.
@@ -27,6 +28,7 @@ is
    procedure destroy (Self : in out Item);
 
 
+
    --------------
    --  Attributes
    --
@@ -34,6 +36,7 @@ is
    procedure Indices_are (Self : in out Item;   Now : in long_Indices);
 
 
+
    --------------
    --  Operations
    --
@@ -50,4 +53,5 @@ private
          Indices : Buffer.long_indices.view;
       end record;
 
+
 end openGL.Primitive.long_indexed;

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

@@ -3,6 +3,7 @@ with
      openGL.Tasks,
      GL.Binding;
 
+
 package body openGL.Primitive.non_indexed
 is
    ---------
@@ -29,6 +30,7 @@ is
    end new_Primitive;
 
 
+
    overriding
    procedure destroy (Self : in out Item) is null;
 

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

@@ -10,6 +10,7 @@ is
    type    Views is array (Index_t range <>) of View;
 
 
+
    ---------
    --  Forge
    --
@@ -23,6 +24,7 @@ is
    function  new_Primitive (Kind         : in facet_Kind;
                             vertex_Count : in Natural) return Primitive.non_indexed.view;
 
+
    --------------
    --  Operations
    --
@@ -39,4 +41,5 @@ private
          vertex_Count : Natural := 0;
       end record;
 
+
 end openGL.Primitive.non_indexed;

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

@@ -6,6 +6,7 @@ with
 
      ada.unchecked_Deallocation;
 
+
 package body openGL.Primitive.short_indexed
 is
    ---------
@@ -25,7 +26,7 @@ is
 
       Self.facet_Kind := Kind;
       Self.Indices    := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access,
-                                                                      usage => Buffer.static_Draw));
+                                                                      Usage => Buffer.static_Draw));
    end define;
 
 
@@ -43,7 +44,7 @@ is
 
       Self.facet_Kind := Kind;
       Self.Indices    := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access,
-                                                                      usage => Buffer.static_Draw));
+                                                                      Usage => Buffer.static_Draw));
    end define;
 
 
@@ -61,7 +62,7 @@ is
 
       Self.facet_Kind := Kind;
       Self.Indices    := new Buffer.short_indices.Object' (to_Buffer (buffer_Indices'Access,
-                                                                      usage => Buffer.static_Draw));
+                                                                      Usage => Buffer.static_Draw));
    end define;
 
 
@@ -110,6 +111,7 @@ is
    end destroy;
 
 
+
    --------------
    --  Attributes
    --
@@ -118,13 +120,14 @@ is
    is
       use Buffer.short_indices;
       buffer_Indices : aliased short_Indices := [Now'Range => <>];
+
    begin
       for Each in buffer_Indices'Range
       loop
          buffer_Indices (Each) := Now (Each) - 1;     -- Adjust indices to zero-based-indexing for GL.
       end loop;
 
-      Self.Indices.set (to => buffer_Indices);
+      Self.Indices.set (To => buffer_Indices);
    end Indices_are;
 
 
@@ -133,13 +136,14 @@ is
    is
       use Buffer.short_indices;
       buffer_Indices : aliased short_Indices := [Now'Range => <>];
+
    begin
       for Each in buffer_Indices'Range
       loop
          buffer_Indices (Each) := short_Index_t (Now (Each) - 1);     -- Adjust indices to zero-based-indexing for GL.
       end loop;
 
-      Self.Indices.set (to => buffer_Indices);
+      Self.Indices.set (To => buffer_Indices);
    end Indices_are;
 
 
@@ -148,13 +152,14 @@ is
    is
       use Buffer.short_indices;
       buffer_Indices : aliased short_Indices := [Now'Range => <>];
+
    begin
       for Each in buffer_Indices'Range
       loop
          buffer_Indices (Each) := short_Index_t (Now (Each) - 1);     -- Adjust indices to zero-based-indexing for GL.
       end loop;
 
-      Self.Indices.set (to => buffer_Indices);
+      Self.Indices.set (To => buffer_Indices);
    end Indices_are;
 
 

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

@@ -2,6 +2,7 @@ private
 with
      openGL.Buffer.short_indices;
 
+
 package openGL.Primitive.short_indexed
 --
 --  Provides a class for short indexed openGL primitives.
@@ -14,6 +15,7 @@ is
    type    Views is array (Index_t range <>) of View;
 
 
+
    ---------
    --  Forge
    --
@@ -37,6 +39,7 @@ is
    procedure destroy (Self : in out Item);
 
 
+
    --------------
    --  Attributes
    --
@@ -46,6 +49,7 @@ is
    procedure Indices_are (Self : in out Item;   Now : in  long_Indices);
 
 
+
    --------------
    --  Operations
    --
@@ -62,4 +66,5 @@ private
          Indices : Buffer.short_indices.view;
       end record;
 
+
 end openGL.Primitive.short_indexed;

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

@@ -1,8 +1,10 @@
 with
      openGL.Tasks,
+     openGL.Errors,
      GL.Binding,
      ada.unchecked_Deallocation;
 
+
 package body openGL.Primitive
 is
    ---------
@@ -16,6 +18,7 @@ is
    end define;
 
 
+
    procedure free (Self : in out View)
    is
       procedure deallocate is new ada.Unchecked_Deallocation (Primitive.item'Class,
@@ -88,6 +91,7 @@ is
       if Self.line_Width /= unused_line_Width
       then
          glLineWidth (glFloat (Self.line_Width));
+         Errors.log;
       end if;
    end render;
 

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

@@ -5,6 +5,7 @@ private
 with
      ada.unchecked_Conversion;
 
+
 package openGL.Primitive
 --
 --  Provides a base class for openGL primitives.
@@ -28,7 +29,7 @@ is
    --  Forge
    --
 
-   procedure define  (Self : in out Item;   Kind    : in facet_Kind);
+   procedure define  (Self : in out Item;   Kind : in facet_Kind);
    procedure destroy (Self : in out Item) is abstract;
    procedure free    (Self : in out View);
 
@@ -67,7 +68,7 @@ private
          Texture        : openGL.Texture.Object := openGL.Texture.null_Object;
          is_Transparent : Boolean;
          Bounds         : openGL.Bounds;
-         line_Width     : Real := unused_line_Width;
+         line_Width     : Real                  := unused_line_Width;
       end record;
 
 

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

@@ -31,29 +31,34 @@ is
 
    function to_Model (Model            : in asset_Name;
                       Texture          : in asset_Name;
+                      texture_Details  : in texture_Set.item;
                       Texture_is_lucid : in Boolean) return openGL.Model.any.item
    is
    begin
-      return Self : openGL.Model.any.item := (openGL.Model.item with
+      --  return Self : openGL.Model.any. := (openGL.Model.item with
+      return Self : openGL.Model.any.item := (textured_Model.textured_item with
                                               Model,
                                               Texture,
                                               Texture_is_lucid,
                                               Geometry => null)
       do
          Self.Bounds.Ball := 1.0;
+         Self.texture_Details_is (texture_Details);
       end return;
    end to_Model;
 
 
    function new_Model (Model            : in asset_Name;
                        Texture          : in asset_Name;
+                       texture_Details  : in texture_Set.item;
                        Texture_is_lucid : in Boolean) return openGL.Model.any.view
    is
    begin
-      return new openGL.Model.any.item' (to_Model (Model, Texture, Texture_is_lucid));
+      return new openGL.Model.any.item' (to_Model (Model, Texture, texture_Details, Texture_is_lucid));
    end new_Model;
 
 
+
    --------------
    --- Attributes
    --
@@ -415,6 +420,9 @@ is
          deallocate (the_Vertices);
          destroy    (the_Model);
 
+         Self.Geometry.Model_is (Self'unchecked_Access);
+
+
          --  Set the geometry texture.
          --
          if Self.Texture /= null_Asset
@@ -501,40 +509,40 @@ is
    -- Texturing
    --
 
-   overriding
+   --  overriding
-   procedure Fade_is (Self : in out Item;   Which : in texture_Set.texture_Id;
+   --  procedure Fade_is (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                            Now   : in texture_Set.fade_Level)
+   --                                           Now   : in texture_Set.fade_Level)
-   is
+   --  is
-   begin
+   --  begin
-      null;
+   --     null;
-   end Fade_is;
+   --  end Fade_is;
-
+   --
-
+   --
-
+   --
-   overriding
+   --  overriding
-   function Fade (Self : in Item;   Which : in texture_Set.texture_Id) return texture_Set.fade_Level
+   --  function Fade (Self : in Item;   Which : in texture_Set.texture_Id) return texture_Set.fade_Level
-   is
+   --  is
-   begin
+   --  begin
-      return 0.0;
+   --     return 0.0;
-   end Fade;
+   --  end Fade;
-
+   --
-
+   --
-
+   --
-   procedure Texture_is (Self : in out Item;   Which : in texture_Set.texture_Id;
+   --  procedure Texture_is (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                               Now   : in openGL.asset_Name)
+   --                                              Now   : in openGL.asset_Name)
-   is
+   --  is
-   begin
+   --  begin
-      null;
+   --     null;
-   end Texture_is;
+   --  end Texture_is;
-
+   --
-
+   --
-
+   --
-   overriding
+   --  overriding
-   function texture_Count (Self : in Item) return Natural
+   --  function texture_Count (Self : in Item) return Natural
-   is
+   --  is
-   begin
+   --  begin
-      return 1;
+   --     return 1;
-   end texture_Count;
+   --  end texture_Count;
 
 
 

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

@@ -1,5 +1,6 @@
 with
-     openGL.Geometry;
+     openGL.Geometry,
+     openGL.Model.texturing;
 
 
 package openGL.Model.any
@@ -9,7 +10,11 @@ package openGL.Model.any
 --  This model is largely used by the IO importers of various model formats (ie collada, wavefront, etc).
 --
 is
-   type Item is new Model.item with private;
+   package textured_Model is new texturing.Mixin (openGL.Model.item);
+
+   type Item is new textured_Model.textured_item with private;
+
+   --  type Item is new Model.item with private;
    type View is access all Item'Class;
 
 
@@ -19,6 +24,7 @@ is
 
    function new_Model (Model            : in asset_Name;
                        Texture          : in asset_Name;
+                       texture_Details  : in texture_Set.item;
                        Texture_is_lucid : in Boolean) return openGL.Model.any.view;
 
    --------------
@@ -43,24 +49,25 @@ is
    -- Texturing
    --
 
-   overriding
+   --  overriding
-   function  Fade       (Self : in     Item;   Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
+   --  function  Fade       (Self : in     Item;   Which : in texture_Set.texture_Id) return texture_Set.fade_Level;
-
+   --
-   overriding
+   --  overriding
-   procedure Fade_is    (Self : in out Item;   Which : in texture_Set.texture_Id;
+   --  procedure Fade_is    (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                               Now   : in texture_Set.fade_Level);
+   --                                              Now   : in texture_Set.fade_Level);
-
+   --
-   procedure Texture_is (Self : in out Item;   Which : in texture_Set.texture_Id;
+   --  procedure Texture_is (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                               Now   : in asset_Name);
+   --                                              Now   : in asset_Name);
-
+   --
-   overriding
+   --  overriding
-   function  texture_Count (Self : in Item) return Natural;
+   --  function  texture_Count (Self : in Item) return Natural;
 
 
 
 private
 
-   type Item is new Model.item with
+   --  type Item is new Model.item with
+   type Item is new textured_Model.textured_item with
       record
          Model             : asset_Name := null_Asset;   -- A wavefront '.obj' or collada '.dae' file.   -- TODO: Rename to 'model_Name'.
 

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

@@ -44,7 +44,7 @@ is
    --
 
    overriding
-   function to_GL_Geometries (Self : access Item;   Textures : access Texture.name_Map_of_texture'Class;
+   function to_GL_Geometries (Self : access Item;   Textures : access openGL.Texture.name_Map_of_texture'Class;
                                                     Fonts    : in     Font.font_id_Map_of_font) return Geometry.views
    is
       pragma unreferenced (Textures, Fonts);
@@ -99,8 +99,6 @@ is
 
    procedure set_side_Bits (Self : in out Item)
    is
-      use linear_Algebra_3d;
-
       End_1 : Vector_3    renames Self.Vertices (1).Site;
       End_2 : Vector_3    renames Self.Vertices (2).Site;
 

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

@@ -27,7 +27,7 @@ is
    --
 
    overriding
-   function  to_GL_Geometries (Self : access Item;   Textures : access Texture.name_Map_of_texture'Class;
+   function  to_GL_Geometries (Self : access Item;   Textures : access openGL.Texture.name_Map_of_texture'Class;
                                                      Fonts    : in     Font.font_id_Map_of_font) return Geometry.views;
 
    procedure end_Site_is (Self : in out Item;   Now     : in Vector_3;

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

@@ -14,7 +14,8 @@ is
    function new_Billboard (Size    : in Size_t         := default_Size;
                            Plane   : in billboard.Plane;
                            Color   : in lucid_Color;
-                           Texture : in asset_Name) return View
+                           Texture : in asset_Name;
+                           texture_Details : in texture_Set.item) return View
    is
       Self : constant View := new Item;
    begin
@@ -23,6 +24,7 @@ is
       Self.Plane        := Plane;
       Self.Color        := Color;
       Self.Texture_Name := Texture;
+      Self.texture_Details_is (texture_Details);
 
       return Self;
    end new_Billboard;
@@ -55,6 +57,7 @@ is
          the_Primitive : constant Primitive.view := Primitive.indexed.new_Primitive (triangle_Fan,
                                                                                      the_Indices).all'Access;
       begin
+         the_Geometry.Model_is (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices.all);
          the_Geometry.add (the_Primitive);
          the_Geometry.is_Transparent;
@@ -62,8 +65,8 @@ is
          return the_Geometry;
       end new_Face;
 
-      Color    : constant rgba_Color := +Self.Color;
+      Color    : constant rgba_Color   := +Self.Color;
-      the_Face : Geometry_view;
+      the_Face :          Geometry_view;
 
    begin
       declare
@@ -90,6 +93,7 @@ is
 
       Self.Geometry := the_Face;
 
+
       return [1 => Geometry.view (the_Face)];
    end to_GL_Geometries;
 

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

@@ -1,6 +1,7 @@
 with
      openGL.Geometry.colored_textured,
      openGL.Texture,
+     openGL.Model.texturing,
      openGL.Font,
      openGL.Palette;
 
@@ -10,7 +11,9 @@ package openGL.Model.billboard.colored_textured
 --  Models a colored, textured billboard.
 --
 is
-   type Item is new Model.billboard.item with private;
+   package textured_Model is new texturing.Mixin (openGL.Model.billboard.item);
+
+   type Item is new textured_Model.textured_item with private;
    type View is access all Item'Class;
 
 
@@ -21,7 +24,8 @@ is
    function new_Billboard (Size    : in Size_t         := default_Size;
                            Plane   : in billboard.Plane;
                            Color   : in lucid_Color;
-                           Texture : in asset_Name) return View;
+                           Texture : in asset_Name;
+                           texture_Details : in texture_Set.item) return View;
 
    --------------
    --- Attributes
@@ -44,7 +48,7 @@ is
 
 private
 
-   type Item is new Model.billboard.item with
+   type Item is new textured_Model.textured_item with
       record
          Color          : lucid_Color           := (Palette.White, Opaque);
 

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

@@ -17,6 +17,7 @@ is
       function new_Billboard (Size    : in Size_t         := default_Size;
                               Plane   : in billboard.Plane;
                               Texture : in asset_Name;
+                              texture_Details : in texture_Set.item;
                               Lucid   : in Boolean        := False) return View
       is
          Self : constant View := new Item (Lucid);
@@ -25,6 +26,8 @@ is
          Self.Texture_Name := Texture;
          Self.define (Size);
 
+         Self.texture_Details_is (texture_Details);
+
          return Self;
       end new_Billboard;
    end Forge;
@@ -57,6 +60,7 @@ is
          the_Primitive : constant Primitive.view         := Primitive.indexed.new_Primitive (triangle_Fan,
                                                                                              the_Indices).all'Access;
       begin
+         the_Geometry.Model_is (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices);
          the_Geometry.add (the_Primitive);
          the_Geometry.is_Transparent;
@@ -110,8 +114,6 @@ is
          end if;
       end;
 
-      the_Face.Model_is (Self.all'unchecked_Access);
-
       return [1 => the_Face.all'Access];
    end to_GL_Geometries;
 
@@ -197,47 +199,4 @@ is
    end Image_is;
 
 
-
-   ------------
-   -- 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
-      null;
-   end Texture_is;
-
-
-
-
-   overriding
-   function texture_Count (Self : in Item) return Natural
-   is
-   begin
-      return 1;
-   end texture_Count;
-
-
-
 end openGL.Model.billboard.textured;

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

@@ -1,6 +1,7 @@
 with
      openGL.Geometry,
-     openGL.Texture;
+     openGL.Texture,
+     openGL.Model.texturing;
 
 
 package openGL.Model.billboard.textured
@@ -8,7 +9,9 @@ package openGL.Model.billboard.textured
 --  Models a textured billboard.
 --
 is
-   type Item (Lucid : Boolean) is new Model.billboard.item with private;
+   package textured_Model is new texturing.Mixin (openGL.Model.billboard.item);
+
+   type Item (Lucid : Boolean) is new textured_Model.textured_item with private;
    type View                   is access all Item'Class;
 
    type       Image_view  is access       Image;
@@ -21,10 +24,11 @@ is
 
    package Forge
    is
-      function new_Billboard (Size    : in Size_t         := default_Size;
+      function new_Billboard (Size            : in Size_t         := default_Size;
-                              Plane   : in billboard.Plane;
+                              Plane           : in billboard.Plane;
-                              Texture : in asset_Name;
+                              Texture         : in asset_Name;
-                              Lucid   : in Boolean        := False) return View;
+                              texture_Details : in texture_Set.item;
+                              Lucid           : in Boolean        := False) return View;
    end Forge;
 
 
@@ -46,28 +50,10 @@ is
    procedure Image_is           (Self : in out Item;   Now : in lucid_Image);
 
 
-   ------------
-   -- 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
 
-   type Item (Lucid : Boolean) is new Model.billboard.item with
+   type Item (Lucid : Boolean) is new textured_Model.textured_item with
       record
          texture_Name   : asset_Name            := null_Asset;
          Texture        : openGL.Texture.Object := openGL.Texture.null_Object;      -- The texture to be applied to the billboard face.

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

@@ -51,6 +51,7 @@ is
                                                       (triangle_Fan,
                                                        the_Indices).all'Access;
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices.all);
          the_Geometry.add          (the_Primitive);
 
@@ -72,7 +73,7 @@ is
          the_Vertices : aliased Geometry.lit_colored_textured.Vertex_array
            := [1 => (Site => the_Sites ( Left_Lower_Front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (1),   Coords => (0.0, 0.0),   Shine => default_Shine),
                2 => (Site => the_Sites (Right_Lower_Front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (2),   Coords => (1.0, 0.0),   Shine => default_Shine),
-               3 => (Site => the_Sites (right_upper_front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (3),   Coords => (1.0, 1.0),   Shine => default_Shine),
+               3 => (Site => the_Sites (Right_Upper_front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (3),   Coords => (1.0, 1.0),   Shine => default_Shine),
                4 => (Site => the_Sites ( Left_Upper_Front),   Normal => front_Normal,   Color => +Self.Faces (Front).Colors (4),   Coords => (0.0, 1.0),   Shine => default_Shine)];
       begin
          front_Face := new_Face (Vertices => the_Vertices'Access);

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

@@ -1,6 +1,7 @@
 with
      openGL.Geometry,
      openGL.Font,
+     openGL.Model.texturing,
      openGL.Texture;
 
 
@@ -12,7 +13,9 @@ package openGL.Model.Box.lit_colored_textured
 --  Each face may have a separate texture.
 --
 is
-   type Item is new Model.box.item with private;
+   package textured_Model is new texturing.Mixin (openGL.Model.box.item);
+
+   type Item is new textured_Model.textured_item with private;
    type View is access all Item'Class;
 
 
@@ -44,7 +47,7 @@ is
 
 private
 
-   type Item is new Model.box.item with
+   type Item is new textured_Model.textured_item with
       record
          Faces : lit_colored_textured.Faces;
       end record;

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

@@ -90,6 +90,7 @@ is
       the_Primitive : constant Primitive.view := Primitive.indexed            .new_Primitive (Triangles, the_Indices).all'Access;
 
    begin
+      the_Geometry.Model_is     (Self.all'unchecked_Access);
       the_Geometry.Vertices_are (the_Vertices);
       the_Geometry.add          (the_Primitive);
 

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

@@ -1,6 +1,7 @@
 with
      openGL.Geometry,
      openGL.Font,
+     openGL.Model.texturing,
      openGL.Texture;
 
 
@@ -12,7 +13,9 @@ package openGL.Model.Box.lit_colored_textured_x1
 --  All faces use the same texture.
 --
 is
-   type Item is new Model.box.item with private;
+   package textured_Model is new texturing.Mixin (openGL.Model.box.item);
+
+   type Item is new textured_Model.textured_item with private;
    type View is access all Item'Class;
 
 
@@ -44,7 +47,7 @@ is
 
 private
 
-   type Item is new Model.box.item with
+   type Item is new textured_Model.textured_item with
       record
          Faces        : lit_colored_textured_x1.Faces;
          texture_Name : asset_Name := null_Asset;     -- The texture applied to all faces.

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

@@ -9,14 +9,18 @@ is
    --- Forge
    --
 
-   function new_Box (Size  : in Vector_3;
+   function new_Box (Size            : in Vector_3;
-                     Faces : in lit_textured.Faces) return View
+                     Faces           : in lit_textured.Faces;
+                     texture_Details : in texture_Set.item := texture_Set.null_Set) return View
+
    is
       Self : constant View := new Item;
    begin
       Self.Faces := Faces;
       Self.Size  := Size;
 
+      Self.texture_Details_is (texture_Details);
+
       return Self;
    end new_Box;
 
@@ -44,8 +48,9 @@ is
          the_Geometry  : constant Geometry.lit_textured.view  := Geometry.lit_textured.new_Geometry;
          the_Primitive : constant Primitive.view              := Primitive.indexed.new_Primitive
                                                                    (triangle_Fan,
-                                                                    the_Indices).all'Access;
+                                                                    the_Indices).all'unchecked_Access;
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices);
          the_Geometry.add          (the_Primitive);
 
@@ -76,7 +81,6 @@ is
          then
             front_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
             front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
-            front_Face.Model_is       (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -96,7 +100,6 @@ is
          then
             rear_Face.Texture_is     (Textures.fetch (Self.Faces (Rear).texture_Name));
             rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
-            rear_Face.Model_is       (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -116,7 +119,6 @@ is
          then
             upper_Face.Texture_is     (Textures.fetch (Self.Faces (Upper).texture_Name));
             upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
-            upper_Face.Model_is       (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -136,7 +138,6 @@ is
          then
             lower_Face.Texture_is (Textures.fetch (Self.Faces (Lower).texture_Name));
             lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
-            lower_Face.Model_is (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -156,7 +157,6 @@ is
          then
             left_Face.Texture_is     (Textures.fetch (Self.Faces (Left).texture_Name));
             left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
-            left_Face.Model_is       (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -176,7 +176,6 @@ is
          then
             right_Face.Texture_is     (Textures.fetch (Self.Faces (Right).texture_Name));
             right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
-            right_Face.Model_is       (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -190,48 +189,4 @@ is
    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
-      null;
-   end Texture_is;
-
-
-
-
-   overriding
-   function texture_Count (Self : in Item) return Natural
-   is
-   begin
-      return 1;
-   end texture_Count;
-
-
-
 end openGL.Model.box.lit_textured;

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

@@ -1,6 +1,8 @@
 with
      openGL.Geometry,
-     openGL.Font;
+     openGL.Font,
+     openGL.Model.texturing,
+     openGL.texture_Set;
 
 
 package openGL.Model.Box.lit_textured
@@ -10,7 +12,9 @@ package openGL.Model.Box.lit_textured
 --  Each face may have a separate texture.
 --
 is
-   type Item is new Model.box.item with private;
+   package textured_Model is new texturing.Mixin (openGL.Model.box.item);
+
+   type Item is new textured_Model.textured_item with private;
    type View is access all Item'Class;
 
 
@@ -26,8 +30,9 @@ is
    --- Forge
    --
 
-   function new_Box (Size  : in Vector_3;
+   function new_Box (Size            : in Vector_3;
-                     Faces : in lit_textured.Faces) return View;
+                     Faces           : in lit_textured.Faces;
+                     texture_Details : in texture_Set.item := texture_Set.null_Set) return View;
 
 
    --------------
@@ -39,30 +44,12 @@ 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
 
-   type Item is new Model.box.item with
+   type Item is new textured_Model.textured_item with
       record
          Faces : lit_textured.Faces;
       end record;
 
+
 end openGL.Model.Box.lit_textured;

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

@@ -9,9 +9,10 @@ is
    --- Forge
    --
 
-   function new_Box (Size      : in Vector_3;
+   function new_Box (Size            : in Vector_3;
-                     Faces     : in textured.Faces;
+                     Faces           : in textured.Faces;
-                     is_Skybox : in Boolean := False) return View
+                     texture_Details : in texture_Set.item;
+                     is_Skybox       : in Boolean := False) return View
    is
       Self : constant View := new Item;
    begin
@@ -19,6 +20,8 @@ is
       Self.is_Skybox := is_Skybox;
       Self.Size      := Size;
 
+      Self.texture_Details_is (texture_Details);
+
       return Self;
    end new_Box;
 
@@ -48,6 +51,7 @@ is
          the_Primitive : constant Primitive.view         := Primitive.indexed.new_Primitive (triangle_Fan,
                                                                                              the_Indices).all'Access;
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices);
          the_Geometry.add          (the_Primitive);
 
@@ -83,7 +87,6 @@ is
          then
             front_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
             front_Face.is_Transparent (now => front_Face.Texture.is_Transparent);
-            front_Face.Model_is       (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -103,7 +106,6 @@ is
          then
             rear_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
             rear_Face.is_Transparent (now => rear_Face.Texture.is_Transparent);
-            rear_Face.Model_is       (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -123,7 +125,6 @@ is
          then
             upper_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
             upper_Face.is_Transparent (now => upper_Face.Texture.is_Transparent);
-            upper_Face.Model_is       (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -143,7 +144,6 @@ is
          then
             lower_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
             lower_Face.is_Transparent (now => lower_Face.Texture.is_Transparent);
-            lower_Face.Model_is       (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -163,7 +163,6 @@ is
          then
             left_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
             left_Face.is_Transparent (now => left_Face.Texture.is_Transparent);
-            left_Face.Model_is       (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -183,7 +182,6 @@ is
          then
             right_Face.Texture_is     (Textures.fetch (Self.Faces (Front).texture_Name));
             right_Face.is_Transparent (now => right_Face.Texture.is_Transparent);
-            right_Face.Model_is       (Self.all'unchecked_Access);
          end if;
       end;
 
@@ -197,46 +195,4 @@ is
    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
-      null;
-   end Texture_is;
-
-
-
-   overriding
-   function texture_Count (Self : in Item) return Natural
-   is
-   begin
-      return 1;
-   end texture_Count;
-
-
 end openGL.Model.box.textured;

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

@@ -1,7 +1,8 @@
 with
      openGL.Geometry,
      openGL.Font,
-     openGL.Texture;
+     openGL.Texture,
+     openGL.Model.texturing;
 
 
 package openGL.Model.Box.textured
@@ -11,7 +12,9 @@ package openGL.Model.Box.textured
 --  Each face may have a separate texture.
 --
 is
-   type Item is new Model.box.item with private;
+   package textured_Model is new texturing.Mixin (openGL.Model.box.item);
+
+   type Item is new textured_Model.textured_item with private;
    type View is access all Item'Class;
 
 
@@ -27,9 +30,10 @@ is
    --- Forge
    --
 
-   function new_Box (Size      : in Vector_3;
+   function new_Box (Size            : in Vector_3;
-                     Faces     : in textured.Faces;
+                     Faces           : in textured.Faces;
-                     is_Skybox : in Boolean := False) return View;
+                     texture_Details : in texture_Set.item;
+                     is_Skybox       : in Boolean := False) return View;
 
 
    --------------
@@ -40,31 +44,14 @@ is
    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
-   --
-
-   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
 
-   type Item is new Model.box.item with
+   type Item is new textured_Model.textured_item with
       record
          Faces     : textured.Faces;
          is_Skybox : Boolean := False;
       end record;
 
+
 end openGL.Model.Box.textured;

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

@@ -80,6 +80,8 @@ is
    begin
       --  Define capsule shaft,
       --
+      the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
+
       declare
          vertex_Count  : constant      Index_t :=      Index_t (sides_Count * 2 + 2);   -- 2 triangles per side plus 2 since we cannot share the first and last edge.
          indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3);   -- 2 triangles per side with 3 vertices per triangle.
@@ -232,7 +234,10 @@ is
             longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
 
             a, b : Real := 0.0;          -- Angular 'cursors' used to track lat/long for texture coords.
+
          begin
+            cap_Geometry.Model_is (Self.all'unchecked_Access);
+
             if not is_Fore
             then
                a := Degrees_360;

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

@@ -1,5 +1,6 @@
 with
-     openGL.Geometry;
+     openGL.Geometry,
+     openGL.Model.texturing;
 
 
 package openGL.Model.capsule.lit_colored_textured
@@ -7,7 +8,9 @@ package openGL.Model.capsule.lit_colored_textured
 --  Models a lit, colored and textured capsule.
 --
 is
-   type Item is new Model.capsule.item with private;
+   package textured_Model is new texturing.Mixin (openGL.Model.capsule.item);
+
+   type Item is new textured_Model.textured_item with private;
    type View is access all Item'Class;
 
 
@@ -32,7 +35,7 @@ is
 
 private
 
-   type Item is new Model.capsule.item with
+   type Item is new textured_Model.textured_item with
       record
          Radius : Real;
          Height : Real;
@@ -41,4 +44,5 @@ private
          Image  : asset_Name := null_Asset;
       end record;
 
+
 end openGL.Model.capsule.lit_colored_textured;

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

@@ -13,6 +13,7 @@ is
 
    function new_Capsule (Radius : in Real;
                          Height : in Real;
+                         texture_Details : in texture_Set.item;
                          Image  : in asset_Name := null_Asset) return View
    is
       Self : constant View := new Item;
@@ -21,6 +22,8 @@ is
       Self.Height := Height;
       Self.Image  := Image;
 
+      Self.texture_Details_is (texture_Details);
+
       return Self;
    end new_Capsule;
 
@@ -29,9 +32,6 @@ is
    --- Attributes
    --
 
---     type Geometry_view is access all Geometry.lit_textured.item'Class;
-
-
    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
@@ -77,6 +77,8 @@ is
    begin
       --  Define capsule shaft,
       --
+      the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
+
       declare
          vertex_Count  : constant      Index_t :=      Index_t (sides_Count * 2 + 2);   -- 2 triangles per side plus 2 since we cannot share the first and last edge.
          indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3);   -- 2 triangles per side with 3 vertices per triangle.
@@ -190,8 +192,6 @@ is
          begin
             the_shaft_Geometry.add (Primitive.view (the_Primitive));
          end;
-
-         the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
       end;
 
 
@@ -228,6 +228,8 @@ is
 
             a, b : Real := 0.0;          -- Angular 'cursors' used to track lat/long for texture coords.
          begin
+            cap_Geometry.Model_is (Self.all'unchecked_Access);
+
             if not is_Fore
             then
                a := Degrees_360;
@@ -388,8 +390,6 @@ is
                end;
             end;
 
-            cap_Geometry.Model_is (Self.all'unchecked_Access);
-
             return cap_Geometry;
          end new_Cap;
 
@@ -404,45 +404,4 @@ is
    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
-      null;
-   end Texture_is;
-
-
-
-   overriding
-   function texture_Count (Self : in Item) return Natural
-   is
-   begin
-      return 1;
-   end texture_Count;
-
-
 end openGL.Model.capsule.lit_textured;

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

@@ -1,5 +1,6 @@
 with
-     openGL.Geometry;
+     openGL.Geometry,
+     openGL.Model.texturing;
 
 
 package openGL.Model.capsule.lit_textured
@@ -7,7 +8,9 @@ package openGL.Model.capsule.lit_textured
 --  Models a lit and textured capsule.
 --
 is
-   type Item is new Model.capsule.item with private;
+   package textured_Model is new texturing.Mixin (openGL.Model.capsule.item);
+
+   type Item is new textured_Model.textured_item with private;
    type View is access all Item'Class;
 
 
@@ -17,6 +20,7 @@ is
 
    function new_Capsule (Radius : in Real;
                          Height : in Real;
+                         texture_Details : in texture_Set.item;
                          Image  : in asset_Name := null_Asset) return View;
 
    --------------
@@ -28,28 +32,9 @@ 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
 
-   type Item is new Model.capsule.item with
+   type Item is new textured_Model.textured_item with
       record
          Radius : Real;
          Height : Real;
@@ -57,4 +42,5 @@ private
          Image  : asset_Name := null_Asset;
       end record;
 
+
 end openGL.Model.capsule.lit_textured;

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

@@ -13,6 +13,7 @@ is
 
    function new_Capsule (Radius : in Real;
                          Height : in Real;
+                         texture_Details : in texture_Set.item;
                          Image  : in asset_Name := null_Asset) return View
    is
       Self : constant View := new Item;
@@ -21,6 +22,8 @@ is
       Self.Height := Height;
       Self.Image  := Image;
 
+      Self.texture_Details_is (texture_Details);
+
       return Self;
    end new_Capsule;
 
@@ -35,8 +38,7 @@ is
    is
       pragma unreferenced (Textures, Fonts);
 
-      use --Geometry,
+      use Geometry.textured,
-          Geometry.textured,
           real_Functions;
 
       Length        : constant Real    := Self.Height;
@@ -74,12 +76,14 @@ is
    begin
       --  Define capsule shaft,
       --
+      the_shaft_Geometry.Model_is (Self.all'unchecked_Access);
+
       declare
          vertex_Count  : constant      Index_t :=      Index_t (sides_Count * 2 + 2);   -- 2 triangles per side plus 2 since we cannot share the first and last edge.
          indices_Count : constant long_Index_t := long_Index_t (sides_Count * 2 * 3);   -- 2 triangles per side with 3 vertices per triangle.
 
-         the_Vertices  : aliased Geometry.textured.Vertex_array := (1 .. vertex_Count  => <>);
+         the_Vertices  : aliased Geometry.textured.Vertex_array := [1 .. vertex_Count  => <>];
-         the_Indices   : aliased Indices                        := (1 .. indices_Count => <>);
+         the_Indices   : aliased Indices                        := [1 .. indices_Count => <>];
 
       begin
          ny := 1.0;
@@ -187,14 +191,14 @@ is
             indices_Count : constant long_Index_t := long_Index_t (  (hoop_count - 1) * sides_Count * 2 * 3    -- For each hoop, 2 triangles per side with 3 vertices per triangle
                                                                    + sides_Count * 3);                         -- plus the extra indices for the pole triangles.
 
-            the_Vertices  : aliased Geometry.textured.Vertex_array := (1 ..  vertex_Count => <>);
+            the_Vertices  : aliased Geometry.textured.Vertex_array := [1 ..  vertex_Count => <>];
-            the_Indices   : aliased Indices                        := (1 .. indices_Count => <>);
+            the_Indices   : aliased Indices                        := [1 .. indices_Count => <>];
 
             the_arch_Edges : arch_Edges;
             i              : Index_t   := 1;
 
-            pole_Site      : constant Site := (if is_Fore then (0.0, 0.0,  L + Radius)
+            pole_Site      : constant Site := (if is_Fore then [0.0, 0.0,  L + Radius]
-                                                          else (0.0, 0.0, -L - Radius));
+                                                          else [0.0, 0.0, -L - Radius]);
 
             Degrees_90        : constant := Pi / 2.0;
             Degrees_360       : constant := Pi * 2.0;
@@ -206,7 +210,10 @@ is
             longitude_Spacing : constant Real := Degrees_360 / Real (longitude_Count);
 
             a, b : Real := 0.0;          -- Angular 'cursors' used to track lat/long for texture coords.
+
          begin
+            cap_Geometry.Model_is (Self.all'unchecked_Access);
+
             if not is_Fore
             then
                a := Degrees_360;
@@ -368,9 +375,10 @@ is
          cap_2_Geometry := new_Cap (is_Fore => False);
       end;
 
-      return (1 => the_shaft_Geometry.all'Access,
+
+      return [1 => the_shaft_Geometry.all'Access,
               2 =>     cap_1_Geometry.all'Access,
-              3 =>     cap_2_Geometry.all'Access);
+              3 =>     cap_2_Geometry.all'Access];
    end to_GL_Geometries;
 
 

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

@@ -1,13 +1,16 @@
 with
-     openGL.Geometry;
+     openGL.Geometry,
+     openGL.Model.texturing;
 
 
 package openGL.Model.capsule.textured
 --
---  Models a lit and textured capsule.
+--  Models a textured capsule.
 --
 is
-   type Item is new Model.capsule.item with private;
+   package textured_Model is new texturing.Mixin (openGL.Model.capsule.item);
+
+   type Item is new textured_Model.textured_item with private;
    type View is access all Item'Class;
 
 
@@ -17,6 +20,7 @@ is
 
    function new_Capsule (Radius : in Real;
                          Height : in Real;
+                         texture_Details : in texture_Set.item;
                          Image  : in asset_Name := null_Asset) return View;
 
    --------------
@@ -31,7 +35,7 @@ is
 
 private
 
-   type Item is new Model.capsule.item with
+   type Item is new textured_Model.textured_item with
       record
          Radius : Real;
          Height : Real;
@@ -39,4 +43,5 @@ private
          Image  : asset_Name := null_Asset;
       end record;
 
+
 end openGL.Model.capsule.textured;

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

@@ -3,6 +3,8 @@ with
      openGL.Primitive.indexed,
      openGL.Texture.Coordinates;
 
+with ada.Text_IO;   use ada.Text_IO;
+
 
 package body openGL.Model.circle.lit_textured
 is
@@ -10,14 +12,14 @@ is
    --- Forge
    --
 
-   function new_circle (Radius : in Real;
+   function new_circle (Radius          : in Real;
-                        Face   : in lit_textured.Face_t;
+                        texture_Details : in texture_Set.item;
-                        Sides  : in Positive         := 24) return View
+                        Sides           : in Positive           := 24) return View
    is
       Self : constant View := new Item;
    begin
       Self.Radius := Radius;
-      Self.Face   := Face;
+      Self.texture_Details_is (texture_Details);
       Self.Sides  := Sides;
 
       return Self;
@@ -29,90 +31,6 @@ is
    --- Attributes ---
    ------------------
 
-   function Face (Self : in Item) return Face_t
-   is
-   begin
-      return Self.Face;
-   end Face;
-
-
-
-   ------------
-   -- Texturing
-   --
-
-   overriding
-   procedure Fade_is (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                            Now   : in texture_Set.fade_Level)
-   is
-   begin
-      Self.Face.texture_Details.Fades (which) := Now;
-   end Fade_is;
-
-
-
-   overriding
-   function Fade (Self : in Item;   Which : in texture_Set.texture_Id) return texture_Set.fade_Level
-   is
-   begin
-      return Self.Face.texture_Details.Fades (which);
-   end Fade;
-
-
-
-   procedure Texture_is (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                               Now   : in openGL.asset_Name)
-   is
-   begin
-      Self.Face.texture_Details.Textures (Positive (which)) := Now;
-   end Texture_is;
-
-
-
-
-   overriding
-   function texture_Count (Self : in Item) return Natural
-   is
-   begin
-      return Self.Face.texture_Details.texture_Count;
-   end texture_Count;
-
-
-
-   overriding
-   function texture_Applied (Self : in Item;   Which : in texture_Set.texture_Id) return Boolean
-   is
-   begin
-      return Self.Face.texture_Details.texture_Applies (Which);
-   end texture_Applied;
-
-
-
-   overriding
-   procedure texture_Applied_is (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                                       Now   : in Boolean)
-   is
-   begin
-      Self.Face.texture_Details.texture_Applies (Which) := Now;
-   end texture_Applied_is;
-
-
-
-   overriding
-   procedure animate (Self : in out Item)
-   is
-      use type texture_Set.Animation_view;
-   begin
-      if Self.Face.texture_Details.Animation = null
-      then
-         return;
-      end if;
-
-      texture_Set.animate (Self.Face.texture_Details.Animation.all,
-                           Self.Face.texture_Details.texture_Applies);
-   end animate;
-
-
 
    ---------------------
    --- openGL Geometries
@@ -162,23 +80,23 @@ is
 
          Id : texture_Set.texture_Id;
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices);
          the_Geometry.add          (Primitive.view (the_Primitive));
 
-         for i in 1 .. Self.Face.texture_Details.texture_Count
+         for i in 1 .. Self.texture_Details.Count
          loop
             Id := texture_Id (i);
 
-            the_Geometry.Fade_is (which => Id,
+            --  the_Geometry.Fade_is (which => Id,
-                                  now   => Self.Face.texture_Details.Fades (Id));
+            --                        now   => Self.texture_Details.Fades (Id));
 
-            the_Geometry.Texture_is     (which => Id,
+            the_Geometry.Texture_is     (Which => Id,
-                                         now   => Textures.fetch (Self.Face.texture_Details.Textures (i)));
+                                         Now   => Textures.fetch (Self.texture_Details.Details (i).Texture));
-            the_Geometry.is_Transparent (now   => the_Geometry.Texture.is_Transparent);
+            the_Geometry.is_Transparent (Now   => the_Geometry.Texture.is_Transparent);
          end loop;
 
          the_Geometry.is_Transparent (True);     -- TODO: Do transparency properly.
-         the_Geometry.Model_is       (Self.all'unchecked_Access);
 
          return the_Geometry;
       end new_Geometry;

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

@@ -1,78 +1,41 @@
 with
      openGL.texture_Set,
-     openGL.Texture;
+     openGL.Texture,
+     openGL.Model.texturing;
 
 
 package openGL.Model.circle.lit_textured
 --
---  Models a lit, colored and textured hexagon.
+--  Models a lit and textured circle.
 --
 is
-   type Item is new Model.item with private;
+   package textured_Model is new texturing.Mixin (Model.circle.item);
+
+   type Item is new textured_Model.textured_Item with private;
    type View is access all Item'Class;
 
 
-   type Face_t is
-      record
-         texture_Details : texture_Set.Details;
-      end record;
-
-
    ---------
    --- Forge
    --
 
-   function new_circle (Radius : in Real;
+   function new_circle (Radius          : in Real;
-                        Face   : in lit_textured.Face_t;
+                        texture_Details : in texture_Set.item;
-                        Sides  : in Positive         := 24) return View;
+                        Sides           : in Positive           := 24) return View;
 
 
    --------------
    --- Attributes
    --
 
-   function Face (Self : in Item) return Face_t;
-
-
    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
-   --
-
-   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;
-
-
-   overriding
-   function  texture_Applied    (Self : in     Item;   Which : in texture_Set.texture_Id) return Boolean;
-
-   overriding
-   procedure texture_Applied_is (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                                       Now   : in Boolean);
-
-   overriding
-   procedure animate            (Self : in out Item);
-
-
 
 private
 
-   type Item is new Model.circle.item with
+   type Item is new textured_Model.textured_Item with null record;
-      record
+
-         Face  : lit_textured.Face_t;
-      end record;
 
 end openGL.Model.circle.lit_textured;

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

@@ -39,7 +39,7 @@ is
           Texture;
 
       the_Sites    :         constant hexagon.Sites := vertex_Sites (Self.Radius);
-      the_Indices  : aliased constant Indices       := (1, 2, 3, 4, 5, 6, 7, 2);
+      the_Indices  : aliased constant Indices       := [1, 2, 3, 4, 5, 6, 7, 2];
 
 
       function new_Face (Vertices : in geometry.lit_colored_textured.Vertex_array) return Geometry_view
@@ -52,6 +52,7 @@ is
          the_Primitive : constant Primitive.indexed.view
            := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices);
          the_Geometry.add          (Primitive.view (the_Primitive));
 
@@ -66,13 +67,13 @@ is
       --
       declare
          the_Vertices : constant Geometry.lit_colored_textured.Vertex_array
-           := (1 => (Site => (0.0, 0.0, 0.0), Normal => Normal, Color => +Self.Face.center_Color, Coords => (0.0, 0.0),   Shine => default_Shine),
+           := [1 => (Site => [0.0, 0.0, 0.0], Normal => Normal, Color => +Self.Face.center_Color, Coords => (0.0, 0.0),   Shine => default_Shine),
                2 => (Site =>   the_Sites (1), Normal => Normal, Color => +Self.Face.Colors (1),   Coords => (0.0, 0.0),   Shine => default_Shine),
                3 => (Site =>   the_Sites (2), Normal => Normal, Color => +Self.Face.Colors (2),   Coords => (1.0, 0.0),   Shine => default_Shine),
                4 => (Site =>   the_Sites (3), Normal => Normal, Color => +Self.Face.Colors (3),   Coords => (1.0, 1.0),   Shine => default_Shine),
                5 => (Site =>   the_Sites (4), Normal => Normal, Color => +Self.Face.Colors (4),   Coords => (0.0, 1.0),   Shine => default_Shine),
                6 => (Site =>   the_Sites (5), Normal => Normal, color => +Self.Face.Colors (5),   Coords => (0.0, 1.0),   Shine => default_Shine),
-               7 => (Site =>   the_Sites (6), Normal => Normal, Color => +Self.Face.Colors (6),   Coords => (0.0, 1.0),   Shine => default_Shine));
+               7 => (Site =>   the_Sites (6), Normal => Normal, Color => +Self.Face.Colors (6),   Coords => (0.0, 1.0),   Shine => default_Shine)];
       begin
          upper_Face := new_Face (Vertices => the_Vertices);
 
@@ -82,7 +83,7 @@ is
          end if;
       end;
 
-      return (1 => upper_Face.all'Access);
+      return [1 => upper_Face.all'Access];
    end to_GL_Geometries;
 
 

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

@@ -1,6 +1,7 @@
 with
      openGL.Geometry,
-     openGL.Texture;
+     openGL.Texture,
+     openGL.Model.texturing;
 
 
 package openGL.Model.hexagon.lit_colored_textured
@@ -8,14 +9,16 @@ package openGL.Model.hexagon.lit_colored_textured
 --  Models a lit, colored and textured hexagon.
 --
 is
-   type Item is new Model.item with private;
+   package textured_Model is new texturing.Mixin (Model.hexagon.item);
+
+   type Item is new textured_Model.textured_Item with private;
    type View is access all Item'Class;
 
    type Face is
       record
          center_Color : lucid_Color;                                           --  The color at the center of the hex.
          Colors       : lucid_Colors (1 .. 6);                                 --  The color at each of the hexes 6 vertices.
-         Texture      : openGL.Texture.Object := openGL.Texture.null_Object;   --  The texture to be applied to the hex..
+         Texture      : openGL.Texture.Object := openGL.Texture.null_Object;   --  The texture to be applied to the hex.
       end record;
 
 
@@ -38,7 +41,7 @@ is
 
 private
 
-   type Item is new Model.hexagon.item with
+   type Item is new textured_Model.textured_Item with
       record
          Face : lit_colored_textured.Face;
       end record;

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

@@ -9,13 +9,13 @@ is
    --- Forge
    --
 
-   function new_Hexagon (Radius : in Real;
+   function new_Hexagon (Radius          : in Real;
-                         Face   : in lit_textured.Face) return View
+                         texture_Details : in texture_Set.item) return View
    is
       Self : constant View := new Item;
    begin
       Self.Radius := Radius;
-      Self.Face   := Face;
+      Self.texture_Details_is (texture_Details);
 
       return Self;
    end new_Hexagon;
@@ -28,84 +28,6 @@ is
    ------------------
 
 
-   ------------
-   -- Texturing
-   --
-
-   overriding
-   procedure Fade_is (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                            Now   : in texture_Set.fade_Level)
-   is
-   begin
-      Self.Face.Fades (Which) := Now;
-   end Fade_is;
-
-
-
-   overriding
-   function Fade (Self : in Item;   Which : in texture_Set.texture_Id) return texture_Set.fade_Level
-   is
-   begin
-      return Self.Face.Fades (Which);
-   end Fade;
-
-
-
-   procedure Texture_is (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                               Now   : in openGL.asset_Name)
-   is
-   begin
-      Self.Face.Textures (Positive (Which)) := Now;
-   end Texture_is;
-
-
-
-
-   overriding
-   function texture_Count (Self : in Item) return Natural
-   is
-   begin
-      return Self.Face.texture_Count;
-   end texture_Count;
-
-
-
-
-   overriding
-   function texture_Applied (Self : in Item;   Which : in texture_Set.texture_Id) return Boolean
-   is
-   begin
-      return Self.Face.texture_Applies (Which);
-   end texture_Applied;
-
-
-
-   overriding
-   procedure texture_Applied_is (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                                       Now   : in Boolean)
-   is
-   begin
-      Self.Face.texture_Applies (Which) := Now;
-   end texture_Applied_is;
-
-
-
-   overriding
-   procedure animate (Self : in out Item)
-   is
-      use type texture_Set.Animation_view;
-   begin
-      if Self.Face.Animation = null
-      then
-         return;
-      end if;
-
-      texture_Set.animate (Self.Face.Animation.all,
-                           Self.Face.texture_Applies);
-   end animate;
-
-
-
    ---------------------
    --- openGL Geometries
    --
@@ -121,7 +43,7 @@ is
           Texture;
 
       the_Sites   :         constant hexagon.Sites := vertex_Sites (Self.Radius);
-      the_Indices : aliased constant Indices       := (1, 2, 3, 4, 5, 6, 7, 2);
+      the_Indices : aliased constant Indices       := [1, 2, 3, 4, 5, 6, 7, 2];
 
 
       function new_Face (Vertices : in geometry.lit_textured.Vertex_array) return Geometry.lit_textured.view
@@ -136,24 +58,25 @@ is
            := Primitive.indexed.new_Primitive (triangle_Fan, the_Indices);
 
          Id : texture_Set.texture_Id;
+
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices);
          the_Geometry.add          (Primitive.view (the_Primitive));
 
-         for i in 1 .. Self.Face.texture_Count
+         for i in 1 .. Self.texture_Details.Count
          loop
             Id := texture_Id (i);
 
-            the_Geometry.Fade_is (which => Id,
+            --  the_Geometry.Fade_is (Which => Id,
-                                  now   => Self.Face.Fades (Id));
+            --                        Now   => Self.texture_Details.Fades (Id));
 
-            the_Geometry.Texture_is     (which => Id,
+            the_Geometry.Texture_is     (Which => Id,
-                                         now   => Textures.fetch (Self.Face.Textures (i)));
+                                         Now   => Textures.fetch (Self.texture_Details.Details (i).Texture));
-            the_Geometry.is_Transparent (now   => the_Geometry.Texture.is_Transparent);
+            the_Geometry.is_Transparent (Now   => the_Geometry.Texture.is_Transparent);
          end loop;
 
          the_Geometry.is_Transparent (True);     -- TODO: Do transparency properly.
-         the_Geometry.Model_is       (Self.all'unchecked_Access);
 
          return the_Geometry;
       end new_Face;
@@ -166,19 +89,19 @@ is
       --
       declare
          the_Vertices : constant Geometry.lit_textured.Vertex_array
-           := (1 => (Site => (0.0, 0.0, 0.0),  Normal => Normal,  Coords => (0.50, 0.50),  Shine => default_Shine),     -- Center.
+           := [1 => (Site => [0.0, 0.0, 0.0],  Normal => Normal,  Coords => (0.50, 0.50),  Shine => default_Shine),     -- Center.
 
                2 => (Site =>   the_Sites (1),  Normal => Normal,  Coords => (1.00, 0.50),  Shine => default_Shine),     -- Mid    right.
                3 => (Site =>   the_Sites (2),  Normal => Normal,  Coords => (0.75, 1.00),  Shine => default_Shine),     -- Bottom right.
                4 => (Site =>   the_Sites (3),  Normal => Normal,  Coords => (0.25, 1.00),  Shine => default_Shine),     -- Bottom left.
                5 => (Site =>   the_Sites (4),  Normal => Normal,  Coords => (0.00, 0.50),  Shine => default_Shine),     -- Mid    left.
                6 => (Site =>   the_Sites (5),  Normal => Normal,  Coords => (0.25, 0.00),  Shine => default_Shine),     -- Top    left.
-               7 => (Site =>   the_Sites (6),  Normal => Normal,  Coords => (0.75, 0.00),  Shine => default_Shine));    -- Top    right.
+               7 => (Site =>   the_Sites (6),  Normal => Normal,  Coords => (0.75, 0.00),  Shine => default_Shine)];    -- Top    right.
       begin
          upper_Face := new_Face (Vertices => the_Vertices);
       end;
 
-      return (1 => upper_Face.all'Access);
+      return [1 => upper_Face.all'Access];
    end to_GL_Geometries;
 
 

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

@@ -1,33 +1,26 @@
 with
      openGL.texture_Set,
-     openGL.Texture;
+     openGL.Texture,
+     openGL.Model.texturing;
 
 
 package openGL.Model.hexagon.lit_textured
 --
---  Models a lit, colored and textured hexagon.
+--  Models a lit and textured hexagon.
 --
 is
-   type Item is new Model.item with private;
+   package textured_Model is new texturing.Mixin (Model.hexagon.item);
+
+   type Item is new textured_Model.textured_Item with private;
    type View is access all Item'Class;
 
 
-   type Face is
-      record
-         Fades           : texture_Set.fade_Levels           (texture_Set.texture_Id)       := [others => 0.0];
-         Textures        : openGL.asset_Names (1 .. Positive (texture_Set.texture_Id'Last)) := [others => null_Asset];     -- The textures to be applied to the hex.
-         texture_Count   : Natural                                                          := 0;
-         texture_Applies : texture_Set.texture_Apply_array                                  := [others => True];
-         Animation       : texture_Set.Animation_view;
-      end record;
-
-
    ---------
    --- Forge
    --
 
-   function new_Hexagon (Radius : in Real;
+   function new_Hexagon (Radius          : in Real;
-                         Face   : in lit_textured.Face) return View;
+                         texture_Details : in texture_Set.item) return View;
 
 
    --------------
@@ -38,41 +31,10 @@ is
    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
-   --
-
-   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;
-
-
-   overriding
-   function  texture_Applied    (Self : in     Item;   Which : in texture_Set.texture_Id) return Boolean;
-
-   overriding
-   procedure texture_Applied_is (Self : in out Item;   Which : in texture_Set.texture_Id;
-                                                       Now   : in Boolean);
-
-   overriding
-   procedure animate            (Self : in out Item);
-
-
 
 private
 
-   type Item is new Model.hexagon.item with
+   type Item is new textured_Model.textured_Item with null record;
-      record
+
-         Face : lit_textured.Face;
-      end record;
 
 end openGL.Model.hexagon.lit_textured;

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

@@ -70,8 +70,9 @@ is
            := Primitive.indexed.new_Primitive (triangle_Fan,
                                                the_Indices);
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices.all);
-         the_Geometry.add (Primitive.view (the_Primitive));
+         the_Geometry.add          (Primitive.view (the_Primitive));
 
          return the_Geometry;
       end new_hexagon_Face;
@@ -90,6 +91,7 @@ is
          the_Primitive : constant Primitive.view
            := Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices.all);
          the_Geometry.add          (the_Primitive);
 

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

@@ -75,8 +75,9 @@ is
            := Primitive.indexed.new_Primitive (triangle_Fan,
                                                the_Indices);
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices.all);
-         the_Geometry.add (Primitive.view (the_Primitive));
+         the_Geometry.add          (Primitive.view (the_Primitive));
 
          return the_Geometry;
       end new_hexagon_Face;
@@ -95,6 +96,7 @@ is
          the_Primitive : constant Primitive.view
            := Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices.all);
          the_Geometry.add          (the_Primitive);
 

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

@@ -1,6 +1,7 @@
 with
      openGL.Geometry,
-     openGL.Texture;
+     openGL.Texture,
+     openGL.Model.texturing;
 
 
 package openGL.Model.hexagon_Column.lit_colored_textured_faceted
@@ -8,7 +9,10 @@ package openGL.Model.hexagon_Column.lit_colored_textured_faceted
 --  Models a lit, colored and textured column with 6 faceted shaft sides.
 --
 is
-   type Item is new Model.hexagon_Column.Item with private;
+   package textured_Model is new texturing.Mixin (Model.hexagon_Column.item);
+
+
+   type Item is new textured_Model.textured_Item with private;
    type View is access all Item'Class;
 
 
@@ -51,7 +55,7 @@ is
 
 private
 
-   type Item is new Model.hexagon_Column.item with
+   type Item is new textured_Model.textured_Item with
       record
          upper_Face,
          lower_Face : hex_Face;

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

@@ -77,6 +77,7 @@ is
                                                the_Indices).all'Access;
 
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices);
          the_Geometry.add          (the_Primitive);
 
@@ -99,6 +100,7 @@ is
            := Primitive.indexed.new_Primitive (triangle_Strip,
                                                the_Indices);
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices);
          the_Geometry.add          (Primitive.view (the_Primitive));
 

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

@@ -1,6 +1,7 @@
 with
      openGL.Geometry,
-     openGL.Texture;
+     openGL.Texture,
+     openGL.Model.texturing;
 
 
 package openGL.Model.hexagon_Column.lit_colored_textured_rounded
@@ -10,7 +11,10 @@ package openGL.Model.hexagon_Column.lit_colored_textured_rounded
 --  The shaft of the column appears rounded, whereas the top and bottom appear as hexagons.
 --
 is
-   type Item is new Model.hexagon_Column.item with private;
+   package textured_Model is new texturing.Mixin (Model.hexagon_Column.item);
+
+
+   type Item is new textured_Model.textured_Item with private;
    type View is access all Item'Class;
 
 
@@ -54,7 +58,7 @@ is
 
 private
 
-   type Item is new Model.hexagon_Column.item with
+   type Item is new textured_Model.textured_Item with
       record
          upper_Face,
          lower_Face : hex_Face;

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

@@ -71,8 +71,9 @@ is
            := Primitive.indexed.new_Primitive (triangle_Fan,
                                                the_Indices);
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices.all);
-         the_Geometry.add (Primitive.view (the_Primitive));
+         the_Geometry.add          (Primitive.view (the_Primitive));
 
          return the_Geometry;
       end new_hexagon_Face;
@@ -91,6 +92,7 @@ is
          the_Primitive : constant Primitive.view
            := Primitive.indexed.new_Primitive (triangle_Strip, the_Indices).all'Access;
       begin
+         the_Geometry.Model_is     (Self.all'unchecked_Access);
          the_Geometry.Vertices_are (Vertices.all);
          the_Geometry.add          (the_Primitive);
 

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

@@ -1,6 +1,7 @@
 with
      openGL.Geometry,
-     openGL.Texture;
+     openGL.Texture,
+     openGL.Model.texturing;
 
 
 package openGL.Model.hexagon_Column.lit_textured_faceted
@@ -8,7 +9,9 @@ package openGL.Model.hexagon_Column.lit_textured_faceted
 --  Models a lit, colored and textured column with 6 faceted shaft sides.
 --
 is
-   type Item is new Model.hexagon_Column.Item with private;
+   package textured_Model is new texturing.Mixin (Model.hexagon_Column.item);
+
+   type Item is new textured_Model.textured_Item with private;
    type View is access all Item'Class;
 
 
@@ -48,7 +51,7 @@ is
 
 private
 
-   type Item is new Model.hexagon_Column.item with
+   type Item is new textured_Model.textured_Item with
       record
          upper_Face,
          lower_Face : hex_Face;