diff --git a/4-high/gel/source/applet/gel-applet.ads b/4-high/gel/source/applet/gel-applet.ads index a073417..2b30fc0 100644 --- a/4-high/gel/source/applet/gel-applet.ads +++ b/4-high/gel/source/applet/gel-applet.ads @@ -137,7 +137,7 @@ is private - pragma Suppress (Container_Checks); -- Suppress expensive tamper checks. + -- 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/gel-sprite.ads b/4-high/gel/source/gel-sprite.ads index cf5b575..02787f3 100644 --- a/4-high/gel/source/gel-sprite.ads +++ b/4-high/gel/source/gel-sprite.ads @@ -49,7 +49,7 @@ is --- Containers -- - pragma Suppress (Container_Checks); -- Suppress expensive tamper checks. + -- pragma Suppress (Container_Checks); -- Suppress expensive tamper checks. type Grid is array (math.Index range <>, math.Index range <>) of Sprite.view; diff --git a/4-high/gel/source/gel-window.ads b/4-high/gel/source/gel-window.ads index d086ebd..86273e4 100644 --- a/4-high/gel/source/gel-window.ads +++ b/4-high/gel/source/gel-window.ads @@ -110,7 +110,7 @@ private type String_view is access all String; - pragma Suppress (Container_Checks); -- Suppress expensive tamper checks. + -- 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 ca65dfc..a980941 100644 --- a/4-high/gel/source/remote/gel-remote-world.ads +++ b/4-high/gel/source/remote/gel-remote-world.ads @@ -20,7 +20,7 @@ package gel.remote.World -- is pragma remote_Types; - pragma suppress (Container_Checks); -- Suppress expensive tamper checks. + -- pragma suppress (Container_Checks); -- Suppress expensive tamper checks. type Item is limited interface and lace.Subject .item @@ -180,6 +180,9 @@ is + ------------------------------ + --- Sprite add and rid events. + -- type sprite_added_Event is new lace.Event.item with record @@ -187,6 +190,12 @@ is end record; + type sprite_ridded_Event is new lace.Event.item with + record + Sprite : gel.sprite_Id; + end record; + + -------------- -- Test/Debug diff --git a/4-high/gel/source/world/gel-world-client.adb b/4-high/gel/source/world/gel-world-client.adb index 9b9d794..de99a5c 100644 --- a/4-high/gel/source/world/gel-world-client.adb +++ b/4-high/gel/source/world/gel-world-client.adb @@ -302,13 +302,10 @@ is Self.graphics_Models.all, Self. physics_Models.all, Self.World); - added_Event : gel.remote.World.sprite_added_Event; begin + log ("*** gel.world.client.my_new_sprite_Response.add sprite ~ " & the_Sprite.Name'Image); Self.World.add (the_Sprite); - -- Self.World.emit (sprite_added_Event' (Sprite => the_Sprite.Id)); - - added_Event.Sprite := the_Sprite.Id; - Self.World.emit (added_Event); + Self.World.emit (remote.world.sprite_added_Event' (Sprite => the_Sprite.Id)); end; end respond; @@ -373,6 +370,7 @@ is -- Self.World); begin Self.World.rid (Self.World.fetch_Sprite (the_Event.Id)); + Self.World.emit (remote.world.sprite_ridded_Event' (Sprite => the_Event.Id)); end; end respond; @@ -512,7 +510,7 @@ is -- end sprite_Fetcher; - the_server_Sprites : remote.World.sprite_model_Pairs := of_World.Sprites; + the_server_Sprites : constant remote.World.sprite_model_Pairs := of_World.Sprites; begin @@ -569,6 +567,7 @@ is Self.graphics_Models, Self. physics_Models, gel.World.view (Self)); + log ("*** gel.world.client.is_a_Mirror.add sprite ~ " & the_Sprite.Name'Image); Self.add (the_Sprite); end loop; end; @@ -588,15 +587,22 @@ is procedure add (Self : access Item; the_Sprite : in gel.Sprite.view; and_Children : in Boolean := False) is - added_Event : gel.remote.World.sprite_added_Event; + -- added_Event : gel.remote.World.sprite_added_Event; begin - log ("gel.world.client.add (sprite and children)" & the_Sprite.Name & the_Sprite.Id'Image); - gel.World.item (Self.all).add (the_Sprite); -- Do base class. - Self.all_Sprites.Map.add (the_Sprite); + log ("gel.world.client.add (sprite and children) " & the_Sprite.Name & the_Sprite.Id'Image); + gel.World.item (Self.all).add (the_Sprite, and_Children); -- Do base class. + -- Self.all_Sprites.Map.add (the_Sprite); - added_Event.Sprite := the_Sprite.Id; - Self.emit (added_Event); + -- added_Event.Sprite := the_Sprite.Id; + + -- log ("****** gel.world.client.add " & the_Sprite.Name); + -- if the_Sprite.Id /= 50000000 + -- then + -- raise Program_Error; + -- end if; + + -- Self.emit (added_Event); end add; @@ -803,6 +809,8 @@ is procedure add (the_Sprite : in Sprite.view) is begin + log ("safe_id_Map_of_sprite" & the_Sprite.Id'Image); + -- raise Program_Error; Map.insert (the_Sprite.Id, the_Sprite); end add; diff --git a/4-high/gel/source/world/gel-world-client.ads b/4-high/gel/source/world/gel-world-client.ads index d1977e4..9f98cfb 100644 --- a/4-high/gel/source/world/gel-world-client.ads +++ b/4-high/gel/source/world/gel-world-client.ads @@ -8,7 +8,7 @@ package gel.World.client -- Provides a gel world. -- is - pragma Suppress (Container_Checks); -- Suppress expensive tamper checks. + -- 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-server.ads b/4-high/gel/source/world/gel-world-server.ads index 5173b4c..0aaf05a 100644 --- a/4-high/gel/source/world/gel-world-server.ads +++ b/4-high/gel/source/world/gel-world-server.ads @@ -12,7 +12,7 @@ package gel.World.server -- Provides a gel world server. -- is - pragma Suppress (Container_Checks); -- Suppress expensive tamper checks. + -- 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 c735d98..d059beb 100644 --- a/4-high/gel/source/world/gel-world-simple.ads +++ b/4-high/gel/source/world/gel-world-simple.ads @@ -11,7 +11,7 @@ package gel.World.simple -- Provides a simple gel world. -- is - pragma Suppress (Container_Checks); -- Suppress expensive tamper checks. + -- 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 03243ac..d5c3851 100644 --- a/4-high/gel/source/world/gel-world.adb +++ b/4-high/gel/source/world/gel-world.adb @@ -597,6 +597,14 @@ is + function sprite_Exists (Self : in out Item'Class; Id : in sprite_Id) return Boolean + is + begin + return Self.all_Sprites.fetch.Contains (Id); + end sprite_Exists; + + + procedure set_Scale (Self : in out Item; for_Sprite : in gel.Sprite.view; To : in Vector_3) is @@ -830,7 +838,8 @@ is -- Emit a new model event. -- - -- log ("gel.World.add ~ emit new physics model event"); + log ("gel.World.add ~ emit new physics model event"); + declare the_Event : remote.World.new_physics_model_Event; begin diff --git a/4-high/gel/source/world/gel-world.ads b/4-high/gel/source/world/gel-world.ads index 41ca74a..277bcc2 100644 --- a/4-high/gel/source/world/gel-world.ads +++ b/4-high/gel/source/world/gel-world.ads @@ -29,7 +29,7 @@ package gel.World -- Provides a gel world. -- is - pragma Suppress (Container_Checks); -- Suppress expensive tamper checks. + -- pragma Suppress (Container_Checks); -- Suppress expensive tamper checks. type Item is abstract limited new lace.Subject_and_deferred_Observer.item @@ -92,6 +92,7 @@ is function new_sprite_Id (Self : access Item) return sprite_Id; function free_sprite_Set (Self : access Item) return gel.Sprite.views; function fetch_Sprite (Self : in out Item'Class; Id : in sprite_Id) return gel.Sprite.view; + function sprite_Exists (Self : in out Item'Class; Id : in sprite_Id) return Boolean; procedure destroy (Self : in out Item; the_Sprite : in gel.Sprite.view); procedure set_Scale (Self : in out Item; for_Sprite : in gel.Sprite.view; To : in Vector_3);