lace.events: Optimise.

1-base/lace/source/events/concrete/lace-observer-deferred.ads

@@ -33,6 +33,9 @@ is
 private
    use ada.Strings.unbounded;
 
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
+
    package Observer is new lace.make_Observer (Any.limited_item);
    package Deferred is new Observer.deferred  (Observer.item);
 

1-base/lace/source/events/concrete/lace-observer-instant.ads

@@ -32,6 +32,9 @@ is
 private
    use ada.Strings.unbounded;
 
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
+
    package Observer is new make_Observer (Any.limited_item);
 
    type Item is limited new Observer.item with

1-base/lace/source/events/concrete/lace-subject-local.ads

@@ -36,6 +36,9 @@ private
 
    use ada.Strings.unbounded;
 
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
+
    package Subject is new make_Subject (Any.limited_item);
 
    type Item is limited new Subject.item with

1-base/lace/source/events/concrete/lace-subject_and_deferred_observer.ads

@@ -39,6 +39,9 @@ is
 private
    use ada.Strings.unbounded;
 
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
+
    package Subject  is new make_Subject      (Any.limited_item);
    package Observer is new make_Observer     (Subject    .item);
    package Deferred is new Observer.deferred (Observer   .item);

1-base/lace/source/events/concrete/lace-subject_and_instant_observer.ads

@@ -36,6 +36,9 @@ is
 private
    use ada.Strings.unbounded;
 
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
+
    package Subject  is new make_Subject  (Any.limited_item);
    package Observer is new make_Observer (Subject    .item);
 

1-base/lace/source/events/mixin/lace-make_observer.ads

@@ -56,6 +56,10 @@ is
 
 
 private
+
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
+
    ----------------------
    -- Event response maps
    --

1-base/lace/source/events/mixin/lace-make_subject.ads

@@ -58,6 +58,9 @@ is
 
 private
 
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
+
    -------------------------
    -- Event observer vectors
    --

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

@@ -40,6 +40,8 @@ is
 
 private
 
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
    ----------------
    -- Event Vectors
    --

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

@@ -11,7 +11,7 @@ is
    -- Files
    --
 
-   function to_String (Filename : in forge.Filename) return String
+   function File_to_String (Filename : in forge.Filename) return String
    is
       use ada.Characters,
           ada.Directories;
@@ -47,15 +47,15 @@ is
       end loop;
 
       return Result (1 .. i);
-   end to_String;
+   end File_to_String;
 
 
 
-   function to_Text (Filename : in forge.Filename) return Item
+   function File_to_Text (Filename : in forge.Filename) return Item
    is
    begin
-      return to_Text (to_String (Filename));
+      return to_Text (File_to_String (Filename));
-   end to_Text;
+   end File_to_Text;
 
 
 

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

@@ -10,8 +10,8 @@ is
 
    type Filename is new String;
 
-   function to_String (Filename : in forge.Filename) return String;     -- Converts 'CR & LF' to 'LF' at the end of a line.
+   function File_to_String (Filename : in forge.Filename) return String;     -- Converts 'CR & LF' to 'LF' at the end of a line.
-   function to_Text   (Filename : in forge.Filename) return Item;       -- Converts 'CR & LF' to 'LF' at the end of a line.
+   function File_to_Text   (Filename : in forge.Filename) return Item;       -- Converts 'CR & LF' to 'LF' at the end of a line.
 
 
    procedure store (Filename : in forge.Filename;   the_String : in String);

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

@@ -20,7 +20,7 @@ is
          when GL_INVALID_VALUE     =>   return "invalid Value";
          when GL_INVALID_OPERATION =>   return "invalid Operation";
          when GL_OUT_OF_MEMORY     =>   return "out of Memory";
-         when others               =>   return "unknown openGL error detected";
+         when others               =>   return "unknown openGL error detected (Code:" & the_Error'Image & ")";
       end case;
    end Current;
 

4-high/gel/source/applet/distributed/gel-applet-client_world.adb

@@ -29,9 +29,9 @@ is
 
       Self.Worlds.append (the_world_Info);
 
-      Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
+      --  Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
-                                           to_Kind (gel.events.new_sprite_added_to_world_Event'Tag),
+      --                                       to_Kind (gel.events.new_sprite_added_to_world_Event'Tag),
-                                           the_world_Info.World.Name);
+      --                                       the_world_Info.World.Name);
       the_world_Info.World.start;
    end define;
 

4-high/gel/source/applet/distributed/gel-applet-server_world.adb

@@ -29,9 +29,9 @@ is
 
       Self.Worlds.append (the_world_Info);
 
-      Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
+      --  Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
-                                           to_Kind (gel.events.new_sprite_added_to_world_Event'Tag),
+      --                                       to_Kind (gel.events.new_sprite_added_to_world_Event'Tag),
-                                           the_world_Info.World.Name);
+      --                                       the_world_Info.World.Name);
       the_world_Info.World.start;
    end define;
 

4-high/gel/source/applet/gel-applet-gui_and_sim_world.adb

@@ -24,8 +24,8 @@ is
                                                                    space_Kind => physics.Bullet,
                                                                    Renderer   => Self.Renderer).all'Access;
 
-         the_world_Info.World.register (Self.all'unchecked_Access,
+         --  the_world_Info.World.register (Self.all'unchecked_Access,
-                                        to_Kind (gel.events.new_sprite_added_to_world_Event'Tag));
+         --                                 to_Kind (gel.events.new_sprite_added_to_world_Event'Tag));
 
          the_Camera.Viewport_is (Self.Window.Width, Self.Window.Height);
          the_Camera.Renderer_is (Self.Renderer);
@@ -34,9 +34,9 @@ is
          the_world_Info.Cameras.append (the_Camera);
          Self.Worlds           .append (the_world_Info);
 
-         Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
+         --  Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
-                                              to_Kind (gel.events.new_sprite_added_to_world_Event'Tag),
+         --                                       to_Kind (gel.events.new_sprite_added_to_world_Event'Tag),
-                                              the_world_Info.World.Name);
+         --                                       the_world_Info.World.Name);
          the_world_Info.World.start;
       end;
 
@@ -49,8 +49,8 @@ is
                                                                    space_Kind => physics.Bullet,
                                                                    Renderer   => Self.Renderer).all'Access;
 
-         the_world_Info.World.register (the_Observer => Self.all'unchecked_Access,
+         --  the_world_Info.World.register (the_Observer => Self.all'unchecked_Access,
-                                        of_Kind      => to_Kind (gel.events.new_sprite_added_to_world_Event'Tag));
+         --                                 of_Kind      => to_Kind (gel.events.new_sprite_added_to_world_Event'Tag));
 
          the_Camera.Viewport_is (Self.Window.Width, Self.Window.Height);
          the_Camera.Renderer_is (Self.Renderer);
@@ -59,9 +59,9 @@ is
          the_world_Info.Cameras.append (the_Camera);
          Self.Worlds           .append (the_world_Info);
 
-         Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
+         --  Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
-                                              to_Kind (gel.events.new_sprite_added_to_world_Event'Tag),
+         --                                       to_Kind (gel.events.new_sprite_added_to_world_Event'Tag),
-                                              the_world_Info.World.Name);
+         --                                       the_world_Info.World.Name);
          the_world_Info.World.start;
       end;
    end define;

4-high/gel/source/applet/gel-applet-gui_world.adb

@@ -30,9 +30,9 @@ is
 
       Self.Worlds.append (the_world_Info);
 
-      Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
+      --  Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
-                                           to_Kind (gel.events.new_sprite_added_to_world_Event'Tag),
+      --                                       to_Kind (gel.events.new_sprite_added_to_world_Event'Tag),
-                                           the_world_Info.World.Name);
+      --                                       the_world_Info.World.Name);
       the_world_Info.World.start;
    end define;
 

4-high/gel/source/applet/gel-applet.adb

@@ -55,14 +55,14 @@ is
    overriding
    procedure respond (Self : in out add_new_Sprite;   to_Event : in lace.Event.item'Class)
    is
-      the_Event : constant gel.events.new_sprite_added_to_world_Event
+      --  the_Event : constant gel.events.new_sprite_added_to_world_Event
-        := gel.events.new_sprite_added_to_world_Event (to_Event);
+      --    := gel.events.new_sprite_added_to_world_Event (to_Event);
 
       the_Sprite : gel.Sprite.view;
 
    begin
       log ("gel.applet.add_new_Sprite.respond");
-      the_Sprite := Self.Applet.World (the_Event.World_Id).fetch_Sprite (the_event.Sprite_Id);
+      --  the_Sprite := Self.Applet.World (the_Event.World_Id).fetch_Sprite (the_event.Sprite_Id);
 
       the_Sprite.is_Visible (True);
       Self.Applet.add (the_Sprite);
@@ -276,9 +276,9 @@ is
 
       Self.Worlds.append (the_world_Info);
 
-      Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
+      --  Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
-                                           to_Kind (gel.Events.new_sprite_added_to_world_Event'Tag),
+      --                                       to_Kind (gel.Events.new_sprite_added_to_world_Event'Tag),
-                                           the_world_Info.World.Name);
+      --                                       the_world_Info.World.Name);
       the_world_Info.World.start;
 
       Self.add (the_world_Info);

4-high/gel/source/applet/gel-applet.ads

@@ -137,6 +137,8 @@ is
 
 private
 
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
    use type Sprite.view;
    package sprite_Vectors is new ada.containers.Vectors (Positive, Sprite.view);
 

4-high/gel/source/forge/gel-forge.adb

@@ -1,6 +1,8 @@
 with
      openGL.Model.text     .lit_colored,
 
+     openGL.Model.circle   .lit_textured,
+
      openGL.Model.sphere   .lit_colored_textured,
      openGL.Model.sphere   .lit_colored,
      openGL.Model.sphere   .textured,
@@ -20,7 +22,8 @@ with
      openGL.Model.segment_line,
 
      physics.Model,
-     gel.Window;
+     gel.Window,
+     float_Math.Random;
 
 
 package body gel.Forge
@@ -132,7 +135,7 @@ is
       use openGL;
       use type Vector_2;
 
-      the_graphics_Model : openGL.Model.sphere.view;
+      the_graphics_Model : openGL.Model.view;
 
       the_physics_Model  : constant physics.Model.view
         := physics.Model.Forge.new_physics_Model (shape_Info  => (physics.Model.Circle, Radius),
@@ -146,14 +149,18 @@ is
          the_graphics_Model := openGL.Model.sphere.lit_colored.new_Sphere (Radius,
                                                                            Color => (Color, Opaque)).all'Access;
       else
-         the_graphics_Model := openGL.Model.sphere.lit_colored_textured.new_Sphere (Radius,
+         --  the_graphics_Model := openGL.Model.sphere.lit_colored_textured.new_Sphere (Radius,
-                                                                                    Color => (Color, Opaque),
+         --                                                                             Color => (Color, Opaque),
-                                                                                    Image => Texture).all'Access;
+         --                                                                             Image => Texture).all'Access;
+         the_graphics_Model := openGL.Model.circle.lit_textured.new_Circle (Radius,
+                                                                            Face => (Fades         => (1 => 0.0,     others => <>),
+                                                                                     Textures      => (1 => Texture, others => <>),
+                                                                                     texture_Count => 1)).all'Access;
       end if;
 
       return gel.Sprite.Forge.new_Sprite ("circle_Sprite",
                                           sprite.World_view (in_World),
-                                          Vector_3 (Site & 0.0),
+                                          Vector_3 (Site & float_Math.Random.random_Real (Lower => 0.0, Upper => 1.1)),
                                           the_graphics_Model,
                                           the_physics_Model,
                                           owns_graphics => True,

4-high/gel/source/gel-events.ads

@@ -48,22 +48,28 @@ is
       end record;
 
 
+   --  type new_sprite_Event is new lace.Event.item with
+   --     record
+   --        Pair : gel.remote.World.sprite_model_Pair;
+   --     end record;
+
+
+   --  type new_sprite_added_to_world_Event is new lace.Event.item with
+   --     record
+   --        Sprite_Id : gel.sprite_Id;
+   --        World_Id  : gel. world_Id;
+   --     end record;
+
+
    type new_sprite_Event is new lace.Event.item with
       record
          Pair : gel.remote.World.sprite_model_Pair;
       end record;
 
 
-   type new_sprite_added_to_world_Event is new lace.Event.item with
+   type rid_sprite_Event is new lace.Event.item with
       record
-         Sprite_Id : gel.sprite_Id;
+         Id : gel.sprite_Id;
-         World_Id  : gel. world_Id;
-      end record;
-
-
-   type my_new_sprite_added_to_world_Event is new lace.Event.item with
-      record
-         Pair : gel.remote.World.sprite_model_Pair;
       end record;
 
 

4-high/gel/source/gel-sprite.ads

@@ -49,6 +49,8 @@ is
    --- Containers
    --
 
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
    type Grid       is array (math.Index range <>,
                              math.Index range <>) of Sprite.view;
    type Grid_view  is access all Grid;

4-high/gel/source/gel-window.ads

@@ -110,6 +110,7 @@ private
 
    type String_view is access all String;
 
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
 
    type Item is limited new lace.Subject_and_deferred_Observer.item with
       record

4-high/gel/source/remote/gel-remote-world.ads

@@ -19,6 +19,7 @@ package gel.remote.World
 --
 is
    pragma remote_Types;
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
 
    type Item is  limited interface
              and lace.Subject .item

4-high/gel/source/world/gel-world-client.adb

@@ -158,15 +158,16 @@ is
    procedure respond (Self : in out create_new_Sprite;   to_Event : in lace.Event.item'Class)
    is
    begin
-      declare
+      raise Program_Error with "KKK";
-         the_Event  : constant gel.Events.new_sprite_Event := gel.Events.new_sprite_Event (to_Event);
+      --  declare
-         the_Sprite : constant gel.Sprite.view             := to_Sprite (the_Event.Pair,
+      --     the_Event  : constant gel.Events.new_sprite_Event := gel.Events.new_sprite_Event (to_Event);
-                                                                         Self.Models.all,
+      --     the_Sprite : constant gel.Sprite.view             := to_Sprite (the_Event.Pair,
-                                                                         Self.physics_Models.all,
+      --                                                                     Self.Models.all,
-                                                                         Self.World);
+      --                                                                     Self.physics_Models.all,
-      begin
+      --                                                                     Self.World);
-         Self.World.add (the_Sprite);
+      --  begin
-      end;
+      --     Self.World.add (the_Sprite);
+      --  end;
    end respond;
 
 
@@ -299,8 +300,8 @@ is
       log ("gel.world.client.my_new_Sprite.respond");
 
       declare
-         the_Event  : constant gel.Events.my_new_sprite_added_to_world_Event
+         the_Event  : constant gel.Events.new_sprite_Event
-           := gel.events.my_new_sprite_added_to_world_Event (to_Event);
+           := gel.events.new_sprite_Event (to_Event);
 
          the_Sprite : constant gel.Sprite.view
            := to_Sprite (the_Event.Pair,
@@ -320,9 +321,9 @@ is
                                                              physics_Models : access id_Maps_of_physics_model.Map)
    is
    begin
-      Self.World          := World;
+      Self.World           := World;
-      Self.graphics_Models         := Models;
+      Self.graphics_Models := Models;
-      Self.physics_Models := physics_Models;
+      Self.physics_Models  := physics_Models;
    end define;
 
 
@@ -339,6 +340,74 @@ is
 
 
 
+   --------------------------
+   --- my_rid_sprite_Response
+   --
+
+   type my_rid_sprite_Response is new lace.Response.item with
+      record
+         World           :        gel.World.view;
+         graphics_Models : access id_Maps_of_graphics_model.Map;
+         physics_Models  : access id_Maps_of_physics_model .Map;
+      end record;
+
+
+   overriding
+   function Name (Self : in my_rid_sprite_Response) return String;
+
+
+
+   overriding
+   procedure respond (Self : in out my_rid_sprite_Response;   to_Event : in lace.Event.Item'Class)
+   is
+   begin
+      log ("gel.world.client.my_rid_Sprite.respond");
+
+      declare
+         the_Event  : constant gel.Events.rid_sprite_Event
+           := gel.events.rid_sprite_Event (to_Event);
+
+         --  the_Sprite : constant gel.Sprite.view
+         --    := to_Sprite (the_Event.Pair,
+         --                  Self.graphics_Models.all,
+         --                  Self.physics_Models.all,
+         --                  Self.World);
+      begin
+         Self.World.rid (Self.World.fetch_Sprite (the_Event.Id));
+      end;
+
+   end respond;
+
+
+
+   procedure define (Self : in out my_rid_sprite_Response;   World          : in     gel.World.view;
+                                                             Models         : access id_Maps_of_graphics_model.Map;
+                                                             physics_Models : access id_Maps_of_physics_model.Map)
+   is
+   begin
+      Self.World           := World;
+      Self.graphics_Models := Models;
+      Self.physics_Models  := physics_Models;
+   end define;
+
+
+
+   overriding
+   function Name (Self : in my_rid_sprite_Response) return String
+   is
+      pragma unreferenced (Self);
+   begin
+      return "my_rid_sprite_Response";
+   end Name;
+
+   the_my_rid_sprite_Response : aliased my_rid_sprite_Response;
+
+
+
+
+   -------------------
+   --- World Mirroring
+   --
    type graphics_Model_iface_view is access all openGL .remote_Model.item'Class;
    type  physics_Model_iface_view is access all physics.remote.Model.item'Class;
 
@@ -370,7 +439,17 @@ is
                                             physics_Models => Self. physics_Models'Access);
 
       Self.add (the_my_new_sprite_Response'Access,
-                to_Kind (gel.Events.my_new_sprite_added_to_world_Event'Tag),
+                to_Kind (gel.Events.new_sprite_Event'Tag),
+                from_Subject => of_World.Name);
+
+      --  Rid sprite response.
+      --
+      define   (the_my_rid_sprite_Response, World          => Self.all'Access,
+                                            Models         => Self.graphics_Models'Access,
+                                            physics_Models => Self. physics_Models'Access);
+
+      Self.add (the_my_rid_sprite_Response'Access,
+                to_Kind (gel.Events.rid_sprite_Event'Tag),
                 from_Subject => of_World.Name);
 
       --  Obtain and make a local copy of graphics_Models, sprites and humans from the mirrored world.
@@ -455,50 +534,56 @@ is
    procedure motion_Updates_are (Self : in Item;   Now : in remote.World.motion_Updates)
    is
       all_Sprites : constant id_Maps_of_sprite.Map := Self.all_Sprites.Map.fetch_all;
+      the_Id      :          gel.sprite_Id;
 
    begin
       for i in Now'Range
       loop
-         declare
-            use remote.World;
-
-            the_Id             : constant gel.sprite_Id := Now (i).Id;
-            the_Sprite         : constant Sprite.view   := all_Sprites.Element (the_Id);
-
-            new_Site           : constant Vector_3      := refined (Now (i).Site);
-            --  site_Delta         :          Vector_3;
-            --  min_teleport_Delta : constant               := 20.0;
-
-            new_Spin           : constant Quaternion    := refined (Now (i).Spin);
-            --  new_Spin           : constant Matrix_3x3        := Now (i).Spin;
-
          begin
-            --  site_Delta := new_Site - the_Sprite.desired_Site;
+            the_Id := Now (i).Id;
-            --
-            --  if        abs site_Delta (1) > min_teleport_Delta
-            --    or else abs site_Delta (2) > min_teleport_Delta
-            --    or else abs site_Delta (3) > min_teleport_Delta
-            --  then
-            --     log ("Teleport.");
-            --     the_Sprite.Site_is (new_Site);   -- Sprite has been 'teleported', so move it now
-            --  end if;                             -- to prevent later interpolation.
 
-            null;
+            declare
+               use remote.World;
 
-            --  the_Sprite.Site_is (new_Site);
+               the_Sprite         : constant Sprite.view   := all_Sprites.Element (the_Id);
-            --  the_Sprite.Spin_is (to_Rotation (Axis  => new_Spin.V,
+               new_Site           : constant Vector_3      := refined (Now (i).Site);
-            --                                   Angle => new_Spin.R));
+               --  site_Delta         :          Vector_3;
+               --  min_teleport_Delta : constant               := 20.0;
 
-            --  the_Sprite.Spin_is (to_Matrix (to_Quaternion (new_Spin)));
+               new_Spin           : constant Quaternion    := refined (Now (i).Spin);
+               --  new_Spin           : constant Matrix_3x3        := Now (i).Spin;
 
-            --  the_Sprite.desired_Dynamics_are (Site => new_Site,
+            begin
-            --                                   Spin => to_Quaternion (new_Spin));
+               --  site_Delta := new_Site - the_Sprite.desired_Site;
+               --
+               --  if        abs site_Delta (1) > min_teleport_Delta
+               --    or else abs site_Delta (2) > min_teleport_Delta
+               --    or else abs site_Delta (3) > min_teleport_Delta
+               --  then
+               --     log ("Teleport.");
+               --     the_Sprite.Site_is (new_Site);   -- Sprite has been 'teleported', so move it now
+               --  end if;                             -- to prevent later interpolation.
 
-            the_Sprite.desired_Dynamics_are (Site => new_Site,
-                                             Spin => new_Spin);
 
-            --  the_Sprite.desired_Site_is (new_Site);
+               --  the_Sprite.Site_is (new_Site);
-            --  the_Sprite.desired_Spin_is (new_Spin);
+               --  the_Sprite.Spin_is (to_Rotation (Axis  => new_Spin.V,
+               --                                   Angle => new_Spin.R));
+
+               --  the_Sprite.Spin_is (to_Matrix (to_Quaternion (new_Spin)));
+
+               --  the_Sprite.desired_Dynamics_are (Site => new_Site,
+               --                                   Spin => to_Quaternion (new_Spin));
+
+               the_Sprite.desired_Dynamics_are (Site => new_Site,
+                                                Spin => new_Spin);
+
+               --  the_Sprite.desired_Site_is (new_Site);
+               --  the_Sprite.desired_Spin_is (new_Spin);
+            end;
+
+         exception
+            when constraint_Error =>
+               log ("Warning: Received motion updates for unknown sprite" & the_Id'Image & ".");
          end;
       end loop;
    end motion_Updates_are;

4-high/gel/source/world/gel-world-client.ads

@@ -8,6 +8,8 @@ package gel.World.client
 --  Provides a gel world.
 --
 is
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
    type Item  is limited new gel.World.item with private;
 
    type View  is access all Item'Class;

4-high/gel/source/world/gel-world-server.adb

@@ -280,8 +280,9 @@ is
 
       Self.register (Mirror_as_observer,  to_Kind (remote.World.        new_graphics_model_Event'Tag));
       Self.register (Mirror_as_observer,  to_Kind (remote.World.         new_physics_model_Event'Tag));
-      Self.register (Mirror_as_observer,  to_Kind (gel.events.                  new_sprite_Event'Tag));     -- TODO: Rid.
+      --  Self.register (Mirror_as_observer,  to_Kind (gel.events.                  new_sprite_Event'Tag));     -- TODO: Rid.
-      Self.register (Mirror_as_observer,  to_Kind (gel.events.my_new_sprite_added_to_world_Event'Tag));
+      Self.register (Mirror_as_observer,  to_Kind (gel.events.new_sprite_Event'Tag));
+      Self.register (Mirror_as_observer,  to_Kind (gel.events.rid_sprite_Event'Tag));
    end register;
 
 

4-high/gel/source/world/gel-world-server.ads

@@ -13,6 +13,8 @@ package gel.World.server
 --  Provides a gel world server.
 --
 is
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
    type Item  is limited new gel.World.item
    with private;
 

4-high/gel/source/world/gel-world-simple.ads

@@ -11,6 +11,8 @@ package gel.World.simple
 --  Provides a simple gel world.
 --
 is
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
    type Item  is limited new gel.World.item
    with private;
 

4-high/gel/source/world/gel-world.adb

@@ -142,15 +142,16 @@ is
    procedure respond (Self : in out create_new_Sprite;   to_Event : in lace.Event.item'Class)
    is
    begin
-      declare
+      raise Program_Error with "JJJ";
-         the_Event  : constant gel.Events.new_sprite_Event := gel.Events.new_sprite_Event (to_Event);
+      --  declare
-         the_Sprite : constant gel.Sprite.view             := to_Sprite (the_Event.Pair,
+      --     the_Event  : constant gel.Events.new_sprite_Event := gel.Events.new_sprite_Event (to_Event);
-                                                                         Self.graphics_Models.all,
+      --     the_Sprite : constant gel.Sprite.view             := to_Sprite (the_Event.Pair,
-                                                                         Self. physics_Models.all,
+      --                                                                     Self.graphics_Models.all,
-                                                                         Self.World);
+      --                                                                     Self. physics_Models.all,
-      begin
+      --                                                                     Self.World);
-         Self.World.add (the_Sprite, and_children => False);
+      --  begin
-      end;
+      --     Self.World.add (the_Sprite, and_children => False);
+      --  end;
    end respond;
 
 
@@ -928,35 +929,35 @@ is
 
       --  Perform responses to events for all sprites.
       --
-      declare
+      --  declare
-         use id_Maps_of_sprite;
+      --     use id_Maps_of_sprite;
-
+      --
-         all_Sprites : constant id_Maps_of_sprite.Map    := Item'Class (Self).all_Sprites.fetch;
+      --     all_Sprites : constant id_Maps_of_sprite.Map    := Item'Class (Self).all_Sprites.fetch;
-         Cursor      :          id_Maps_of_sprite.Cursor := all_Sprites.First;
+      --     Cursor      :          id_Maps_of_sprite.Cursor := all_Sprites.First;
-         the_Sprite  :          Sprite.view;
+      --     the_Sprite  :          Sprite.view;
-      begin
+      --  begin
-         while has_Element (Cursor)
+      --     while has_Element (Cursor)
-         loop
+      --     loop
-            the_Sprite := Element (Cursor);
+      --        the_Sprite := Element (Cursor);
-
+      --
-            begin
+      --        begin
-               if not the_Sprite.is_Destroyed
+      --           if not the_Sprite.is_Destroyed
-               then
+      --           then
-                  the_Sprite.respond;
+      --              the_Sprite.respond;
-               end if;
+      --           end if;
-
+      --
-            exception
+      --        exception
-               when E : others =>
+      --           when E : others =>
-                  new_Line (2);
+      --              new_Line (2);
-                  put_Line ("Error in 'gel.World.evolve' sprite response.");
+      --              put_Line ("Error in 'gel.World.evolve' sprite response.");
-                  new_Line;
+      --              new_Line;
-                  put_Line (ada.Exceptions.exception_Information (E));
+      --              put_Line (ada.Exceptions.exception_Information (E));
-                  new_Line (2);
+      --              new_Line (2);
-            end;
+      --        end;
-
+      --
-            next (Cursor);
+      --        next (Cursor);
-         end loop;
+      --     end loop;
-      end;
+      --  end;
 
    end evolve;
 

4-high/gel/source/world/gel-world.ads

@@ -29,6 +29,9 @@ package gel.World
 --  Provides a gel world.
 --
 is
+   pragma Suppress (Container_Checks);     -- Suppress expensive tamper checks.
+
+
    type Item  is abstract limited new lace.Subject_and_deferred_Observer.item
                                   and gel.remote.World.item
    with private;