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

lace.events: Optimise.

Browse Source
This commit is contained in:
Rod Kay
2023-12-08 14:42:45 +11:00
parent f12686d233
commit dbe487c074
29 changed files with 275 additions and 136 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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

5
4-high/gel/source/world/gel-world-server.adb
View File

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

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

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

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

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

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

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

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

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