diff --git a/1-base/lace/source/events/concrete/lace-observer-deferred.ads b/1-base/lace/source/events/concrete/lace-observer-deferred.ads index 9d10a70..55f8a82 100644 --- a/1-base/lace/source/events/concrete/lace-observer-deferred.ads +++ b/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); diff --git a/1-base/lace/source/events/concrete/lace-observer-instant.ads b/1-base/lace/source/events/concrete/lace-observer-instant.ads index 717763a..d0a7b8e 100644 --- a/1-base/lace/source/events/concrete/lace-observer-instant.ads +++ b/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 diff --git a/1-base/lace/source/events/concrete/lace-subject-local.ads b/1-base/lace/source/events/concrete/lace-subject-local.ads index 9100c91..3fb8d5e 100644 --- a/1-base/lace/source/events/concrete/lace-subject-local.ads +++ b/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 diff --git a/1-base/lace/source/events/concrete/lace-subject_and_deferred_observer.ads b/1-base/lace/source/events/concrete/lace-subject_and_deferred_observer.ads index 16c16a1..1e3775e 100644 --- a/1-base/lace/source/events/concrete/lace-subject_and_deferred_observer.ads +++ b/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); diff --git a/1-base/lace/source/events/concrete/lace-subject_and_instant_observer.ads b/1-base/lace/source/events/concrete/lace-subject_and_instant_observer.ads index ecaa3b1..c6aac49 100644 --- a/1-base/lace/source/events/concrete/lace-subject_and_instant_observer.ads +++ b/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); diff --git a/1-base/lace/source/events/mixin/lace-make_observer.ads b/1-base/lace/source/events/mixin/lace-make_observer.ads index dce0a38..dfee279 100644 --- a/1-base/lace/source/events/mixin/lace-make_observer.ads +++ b/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 -- diff --git a/1-base/lace/source/events/mixin/lace-make_subject.ads b/1-base/lace/source/events/mixin/lace-make_subject.ads index 3a32892..6edeb84 100644 --- a/1-base/lace/source/events/mixin/lace-make_subject.ads +++ b/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 -- diff --git a/1-base/lace/source/events/mixin/xgc/lace-make_observer-deferred.ads b/1-base/lace/source/events/mixin/xgc/lace-make_observer-deferred.ads index 1c6ae3b..b71ab37 100644 --- a/1-base/lace/source/events/mixin/xgc/lace-make_observer-deferred.ads +++ b/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 -- diff --git a/1-base/lace/source/text/lace-text-forge.adb b/1-base/lace/source/text/lace-text-forge.adb index abd4ac6..d264a78 100644 --- a/1-base/lace/source/text/lace-text-forge.adb +++ b/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)); - end to_Text; + return to_Text (File_to_String (Filename)); + end File_to_Text; diff --git a/1-base/lace/source/text/lace-text-forge.ads b/1-base/lace/source/text/lace-text-forge.ads index 8da67ad..39f0368 100644 --- a/1-base/lace/source/text/lace-text-forge.ads +++ b/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 to_Text (Filename : in forge.Filename) return Item; -- 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 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); diff --git a/3-mid/opengl/source/opengl-errors.adb b/3-mid/opengl/source/opengl-errors.adb index 334cfba..20141bb 100644 --- a/3-mid/opengl/source/opengl-errors.adb +++ b/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; diff --git a/4-high/gel/source/applet/distributed/gel-applet-client_world.adb b/4-high/gel/source/applet/distributed/gel-applet-client_world.adb index 6f70953..f81bc90 100644 --- a/4-high/gel/source/applet/distributed/gel-applet-client_world.adb +++ b/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, - to_Kind (gel.events.new_sprite_added_to_world_Event'Tag), - the_world_Info.World.Name); + -- Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access, + -- to_Kind (gel.events.new_sprite_added_to_world_Event'Tag), + -- the_world_Info.World.Name); the_world_Info.World.start; end define; diff --git a/4-high/gel/source/applet/distributed/gel-applet-server_world.adb b/4-high/gel/source/applet/distributed/gel-applet-server_world.adb index 06d7562..b26de2c 100644 --- a/4-high/gel/source/applet/distributed/gel-applet-server_world.adb +++ b/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, - to_Kind (gel.events.new_sprite_added_to_world_Event'Tag), - the_world_Info.World.Name); + -- Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access, + -- to_Kind (gel.events.new_sprite_added_to_world_Event'Tag), + -- the_world_Info.World.Name); the_world_Info.World.start; end define; diff --git a/4-high/gel/source/applet/gel-applet-gui_and_sim_world.adb b/4-high/gel/source/applet/gel-applet-gui_and_sim_world.adb index 92a320c..7422fd8 100644 --- a/4-high/gel/source/applet/gel-applet-gui_and_sim_world.adb +++ b/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, - to_Kind (gel.events.new_sprite_added_to_world_Event'Tag)); + -- the_world_Info.World.register (Self.all'unchecked_Access, + -- 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, - to_Kind (gel.events.new_sprite_added_to_world_Event'Tag), - the_world_Info.World.Name); + -- Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access, + -- to_Kind (gel.events.new_sprite_added_to_world_Event'Tag), + -- 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, - of_Kind => to_Kind (gel.events.new_sprite_added_to_world_Event'Tag)); + -- the_world_Info.World.register (the_Observer => Self.all'unchecked_Access, + -- 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, - to_Kind (gel.events.new_sprite_added_to_world_Event'Tag), - the_world_Info.World.Name); + -- Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access, + -- to_Kind (gel.events.new_sprite_added_to_world_Event'Tag), + -- the_world_Info.World.Name); the_world_Info.World.start; end; end define; diff --git a/4-high/gel/source/applet/gel-applet-gui_world.adb b/4-high/gel/source/applet/gel-applet-gui_world.adb index b559b23..d531be6 100644 --- a/4-high/gel/source/applet/gel-applet-gui_world.adb +++ b/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, - to_Kind (gel.events.new_sprite_added_to_world_Event'Tag), - the_world_Info.World.Name); + -- Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access, + -- to_Kind (gel.events.new_sprite_added_to_world_Event'Tag), + -- the_world_Info.World.Name); the_world_Info.World.start; end define; diff --git a/4-high/gel/source/applet/gel-applet.adb b/4-high/gel/source/applet/gel-applet.adb index 455cdcd..68cf2d6 100644 --- a/4-high/gel/source/applet/gel-applet.adb +++ b/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 - := gel.events.new_sprite_added_to_world_Event (to_Event); + -- the_Event : constant gel.events.new_sprite_added_to_world_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, - to_Kind (gel.Events.new_sprite_added_to_world_Event'Tag), - the_world_Info.World.Name); + -- Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access, + -- to_Kind (gel.Events.new_sprite_added_to_world_Event'Tag), + -- the_world_Info.World.Name); the_world_Info.World.start; Self.add (the_world_Info); diff --git a/4-high/gel/source/applet/gel-applet.ads b/4-high/gel/source/applet/gel-applet.ads index b4fc362..a073417 100644 --- a/4-high/gel/source/applet/gel-applet.ads +++ b/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); diff --git a/4-high/gel/source/forge/gel-forge.adb b/4-high/gel/source/forge/gel-forge.adb index 048dca8..bb20b34 100644 --- a/4-high/gel/source/forge/gel-forge.adb +++ b/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, - Color => (Color, Opaque), - Image => Texture).all'Access; + -- the_graphics_Model := openGL.Model.sphere.lit_colored_textured.new_Sphere (Radius, + -- Color => (Color, Opaque), + -- 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, diff --git a/4-high/gel/source/gel-events.ads b/4-high/gel/source/gel-events.ads index cfb168e..11c7f14 100644 --- a/4-high/gel/source/gel-events.ads +++ b/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; - 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; + Id : gel.sprite_Id; end record; diff --git a/4-high/gel/source/gel-sprite.ads b/4-high/gel/source/gel-sprite.ads index cfadf40..6725dd4 100644 --- a/4-high/gel/source/gel-sprite.ads +++ b/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; diff --git a/4-high/gel/source/gel-window.ads b/4-high/gel/source/gel-window.ads index 890b75e..d086ebd 100644 --- a/4-high/gel/source/gel-window.ads +++ b/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 diff --git a/4-high/gel/source/remote/gel-remote-world.ads b/4-high/gel/source/remote/gel-remote-world.ads index 3aea150..9e165a5 100644 --- a/4-high/gel/source/remote/gel-remote-world.ads +++ b/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 diff --git a/4-high/gel/source/world/gel-world-client.adb b/4-high/gel/source/world/gel-world-client.adb index a2d9c11..1c39747 100644 --- a/4-high/gel/source/world/gel-world-client.adb +++ b/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 - the_Event : constant gel.Events.new_sprite_Event := gel.Events.new_sprite_Event (to_Event); - the_Sprite : constant gel.Sprite.view := to_Sprite (the_Event.Pair, - Self.Models.all, - Self.physics_Models.all, - Self.World); - begin - Self.World.add (the_Sprite); - end; + raise Program_Error with "KKK"; + -- declare + -- the_Event : constant gel.Events.new_sprite_Event := gel.Events.new_sprite_Event (to_Event); + -- the_Sprite : constant gel.Sprite.view := to_Sprite (the_Event.Pair, + -- Self.Models.all, + -- Self.physics_Models.all, + -- Self.World); + -- begin + -- 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 - := gel.events.my_new_sprite_added_to_world_Event (to_Event); + the_Event : constant gel.Events.new_sprite_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.graphics_Models := Models; - Self.physics_Models := physics_Models; + Self.World := World; + Self.graphics_Models := 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; - -- - -- 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_Id := Now (i).Id; - null; + declare + use remote.World; - -- the_Sprite.Site_is (new_Site); - -- the_Sprite.Spin_is (to_Rotation (Axis => new_Spin.V, - -- Angle => new_Spin.R)); + 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; - -- 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, - -- Spin => to_Quaternion (new_Spin)); + begin + -- 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.desired_Spin_is (new_Spin); + -- the_Sprite.Site_is (new_Site); + -- 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; diff --git a/4-high/gel/source/world/gel-world-client.ads b/4-high/gel/source/world/gel-world-client.ads index faf572c..3c88f2e 100644 --- a/4-high/gel/source/world/gel-world-client.ads +++ b/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; diff --git a/4-high/gel/source/world/gel-world-server.adb b/4-high/gel/source/world/gel-world-server.adb index 8c379dc..06fbb9e 100644 --- a/4-high/gel/source/world/gel-world-server.adb +++ b/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.my_new_sprite_added_to_world_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)); + Self.register (Mirror_as_observer, to_Kind (gel.events.rid_sprite_Event'Tag)); end register; diff --git a/4-high/gel/source/world/gel-world-server.ads b/4-high/gel/source/world/gel-world-server.ads index 669a87c..2843439 100644 --- a/4-high/gel/source/world/gel-world-server.ads +++ b/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; diff --git a/4-high/gel/source/world/gel-world-simple.ads b/4-high/gel/source/world/gel-world-simple.ads index 0c5c083..c735d98 100644 --- a/4-high/gel/source/world/gel-world-simple.ads +++ b/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; diff --git a/4-high/gel/source/world/gel-world.adb b/4-high/gel/source/world/gel-world.adb index 6ea2496..3e443b0 100644 --- a/4-high/gel/source/world/gel-world.adb +++ b/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 - the_Event : constant gel.Events.new_sprite_Event := gel.Events.new_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.add (the_Sprite, and_children => False); - end; + raise Program_Error with "JJJ"; + -- declare + -- the_Event : constant gel.Events.new_sprite_Event := gel.Events.new_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.add (the_Sprite, and_children => False); + -- end; end respond; @@ -928,35 +929,35 @@ is -- Perform responses to events for all sprites. -- - declare - use id_Maps_of_sprite; - - all_Sprites : constant id_Maps_of_sprite.Map := Item'Class (Self).all_Sprites.fetch; - Cursor : id_Maps_of_sprite.Cursor := all_Sprites.First; - the_Sprite : Sprite.view; - begin - while has_Element (Cursor) - loop - the_Sprite := Element (Cursor); - - begin - if not the_Sprite.is_Destroyed - then - the_Sprite.respond; - end if; - - exception - when E : others => - new_Line (2); - put_Line ("Error in 'gel.World.evolve' sprite response."); - new_Line; - put_Line (ada.Exceptions.exception_Information (E)); - new_Line (2); - end; - - next (Cursor); - end loop; - end; + -- declare + -- use id_Maps_of_sprite; + -- + -- all_Sprites : constant id_Maps_of_sprite.Map := Item'Class (Self).all_Sprites.fetch; + -- Cursor : id_Maps_of_sprite.Cursor := all_Sprites.First; + -- the_Sprite : Sprite.view; + -- begin + -- while has_Element (Cursor) + -- loop + -- the_Sprite := Element (Cursor); + -- + -- begin + -- if not the_Sprite.is_Destroyed + -- then + -- the_Sprite.respond; + -- end if; + -- + -- exception + -- when E : others => + -- new_Line (2); + -- put_Line ("Error in 'gel.World.evolve' sprite response."); + -- new_Line; + -- put_Line (ada.Exceptions.exception_Information (E)); + -- new_Line (2); + -- end; + -- + -- next (Cursor); + -- end loop; + -- end; end evolve; diff --git a/4-high/gel/source/world/gel-world.ads b/4-high/gel/source/world/gel-world.ads index 204a425..fb9c4c1 100644 --- a/4-high/gel/source/world/gel-world.ads +++ b/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;