nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gel.world: Work on server and client worlds.

Browse Source
This commit is contained in:
Rod Kay
2024-10-16 19:36:46 +11:00
parent 3077f2a4cd
commit ad2f92b791
10 changed files with 48 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
4-high/gel/source/applet/gel-applet.ads
View File

@@ -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);

2
4-high/gel/source/gel-sprite.ads
View File

@@ -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;

2
4-high/gel/source/gel-window.ads
View File

@@ -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

11
4-high/gel/source/remote/gel-remote-world.ads
View File

@@ -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

32
4-high/gel/source/world/gel-world-client.adb
View File

@@ -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;

2
4-high/gel/source/world/gel-world-client.ads
View File

@@ -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;

2
4-high/gel/source/world/gel-world-server.ads
View File

@@ -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;

2
4-high/gel/source/world/gel-world-simple.ads
View File

@@ -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;

11
4-high/gel/source/world/gel-world.adb
View File

@@ -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

3
4-high/gel/source/world/gel-world.ads
View File

@@ -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);