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

gel: Only send motion updates for sprites if they have moved.

Browse Source
This commit is contained in:
Rod Kay
2023-12-13 17:48:42 +11:00
parent 80dab00932
commit bcd283c6d6
13 changed files with 186 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
3-mid/physics/interface/source/physics-object.ads
View File

@@ -3,6 +3,7 @@ with
physics.Model, physics.Model,
lace.Any; lace.Any;
package physics.Object package physics.Object
-- --
-- Provide an interface for physics objects. -- Provide an interface for physics objects.

30
4-high/gel/applet/demo/game/pong-sdl/launch_pong.adb
View File

@@ -50,7 +50,7 @@ is
-- --
the_Ball : constant gel.Sprite.view the_Ball : constant gel.Sprite.view
:= gel.Forge.new_circle_Sprite (in_World => the_Applet.World, := gel.Forge.new_circle_Sprite (in_World => the_Applet.World,
Site => [0.0, 0.0], Site => [0.0, 0.0, 0.0],
Mass => 1.0, Mass => 1.0,
Bounce => 1.0, Bounce => 1.0,
Friction => 0.0, Friction => 0.0,
@@ -77,10 +77,12 @@ is
procedure add_Player (Id : in player_Id; procedure add_Player (Id : in player_Id;
Site : in Vector_2) Site : in Vector_3)
is is
the_Player : Player renames the_Players (Id); the_Player : Player renames the_Players (Id);
score_Site : constant Vector_2 := Site + [0.0, stadium_Height / 2.0 + 0.8]; score_Site : constant Vector_3 := Site + [0.0,
stadium_Height / 2.0 + 0.8,
0.0];
begin begin
the_Player.Paddle := gel.Forge.new_rectangle_Sprite (the_Applet.World, the_Player.Paddle := gel.Forge.new_rectangle_Sprite (the_Applet.World,
Site => Site, Site => Site,
@@ -101,13 +103,13 @@ is
the_Applet.World.add (the_Player.Paddle); the_Applet.World.add (the_Player.Paddle);
the_Applet.World.add (the_Player.score_Text); the_Applet.World.add (the_Player.score_Text);
the_Player.score_Text.Site_is (Vector_3 (score_Site & 0.0)); the_Player.score_Text.Site_is (score_Site);
end add_Player; end add_Player;
--- Walls --- Walls
-- --
procedure add_Wall (Site : in Vector_2; procedure add_Wall (Site : in Vector_3;
Width, Width,
Height : in Real) Height : in Real)
is is
@@ -204,8 +206,8 @@ begin
declare declare
paddle_X_Offset : constant := stadium_Width / 2.0 - 2.0; paddle_X_Offset : constant := stadium_Width / 2.0 - 2.0;
begin begin
add_Player (1, Site => [-paddle_X_Offset, 0.0]); add_Player (1, Site => [-paddle_X_Offset, 0.0, 0.0]);
add_Player (2, Site => [ paddle_X_Offset, 0.0]); add_Player (2, Site => [ paddle_X_Offset, 0.0, 0.0]);
end; end;
--- Build the stadium. --- Build the stadium.
@@ -219,14 +221,14 @@ begin
side_wall_X_Offset : constant := stadium_Width / 2.0; side_wall_X_Offset : constant := stadium_Width / 2.0;
side_wall_Y_Offset : constant := (side_wall_Height + goal_Size) / 2.0; side_wall_Y_Offset : constant := (side_wall_Height + goal_Size) / 2.0;
begin begin
add_Wall (Site => [0.0, top_wall_Y_Offset], Width => stadium_Width, Height => Thickness); -- Top add_Wall (Site => [0.0, top_wall_Y_Offset, 0.0], Width => stadium_Width, Height => Thickness); -- Top
add_Wall (Site => [0.0, -top_wall_Y_Offset], Width => stadium_Width, Height => Thickness); -- Bottom add_Wall (Site => [0.0, -top_wall_Y_Offset, 0.0], Width => stadium_Width, Height => Thickness); -- Bottom
add_Wall (Site => [-side_wall_X_Offset, side_wall_Y_Offset], Width => Thickness, Height => side_wall_Height); -- upper Left add_Wall (Site => [-side_wall_X_Offset, side_wall_Y_Offset, 0.0], Width => Thickness, Height => side_wall_Height); -- upper Left
add_Wall (Site => [-side_wall_X_Offset, -side_wall_Y_Offset], Width => Thickness, Height => side_wall_Height); -- lower Left add_Wall (Site => [-side_wall_X_Offset, -side_wall_Y_Offset, 0.0], Width => Thickness, Height => side_wall_Height); -- lower Left
add_Wall (Site => [ side_wall_X_Offset, side_wall_Y_Offset], Width => Thickness, Height => side_wall_Height); -- upper Right add_Wall (Site => [ side_wall_X_Offset, side_wall_Y_Offset, 0.0], Width => Thickness, Height => side_wall_Height); -- upper Right
add_Wall (Site => [ side_wall_X_Offset, -side_wall_Y_Offset], Width => Thickness, Height => side_wall_Height); -- lower Right add_Wall (Site => [ side_wall_X_Offset, -side_wall_Y_Offset, 0.0], Width => Thickness, Height => side_wall_Height); -- lower Right
end; end;
-- Connect events. -- Connect events.
@@ -248,7 +250,7 @@ begin
loop loop
Cycle := Cycle + 1; Cycle := Cycle + 1;
the_Applet.World.evolve; -- Advance the world. -- the_Applet.World.evolve; -- Advance the world.
the_Applet.freshen; -- Handle any new events and update the screen. the_Applet.freshen; -- Handle any new events and update the screen.
--- Check goal scoring. --- Check goal scoring.

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

@@ -426,7 +426,7 @@ is
declare declare
the_world_Info : world_Info renames Element (world_Cursor).all; the_world_Info : world_Info renames Element (world_Cursor).all;
begin begin
the_world_Info.World.evolve; null; -- the_world_Info.World.evolve;
end; end;
next (world_Cursor); next (world_Cursor);

27
4-high/gel/source/gel-sprite.adb
View File

@@ -1098,6 +1098,33 @@ is
-----------------
-- Motion Updates
--
function has_Moved (Self : in out Item; current_Site : Vector_3;
current_Spin : Matrix_3x3) return Boolean
is
Result : Boolean := False;
begin
if current_Site /= Self.prior_Site
then
Self.prior_Site := current_Site;
Result := True;
end if;
if current_Spin /= Self.prior_Spin
then
Self.prior_Spin := current_Spin;
Result := True;
end if;
return Result;
end has_Moved;
------------ ------------
--- Graphics --- Graphics
-- --

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

@@ -328,6 +328,16 @@ is
-- Motion Updates
--
function has_Moved (Self : in out Item; current_Site : Vector_3;
current_Spin : Matrix_3x3) return Boolean;
private private
type access_Joint_views is access all Joint.views; type access_Joint_views is access all Joint.views;
@@ -422,6 +432,11 @@ private
user_Data : any_user_Data_view; user_Data : any_user_Data_view;
is_Destroyed : Boolean := False; is_Destroyed : Boolean := False;
-- Motion Updates
--
prior_Site : Vector_3 := Origin_3D;
prior_Spin : Matrix_3x3 := Identity_3x3;
end record; end record;

1
4-high/gel/source/platform/gtk/gel-window-gtk.adb
View File

@@ -219,6 +219,7 @@ is
begin begin
Self.gl_Area := gtk_glArea_new; Self.gl_Area := gtk_glArea_new;
Self.gl_Area.set_use_ES (True); Self.gl_Area.set_use_ES (True);
Self.gl_Area.Set_Can_Focus (True);
Callbacks_with_gel_Window_user_Data.connect (Self.gl_Area, Callbacks_with_gel_Window_user_Data.connect (Self.gl_Area,
"realize", "realize",

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

@@ -160,7 +160,7 @@ is
type motion_Updates is array (Positive range <>) of motion_Update type motion_Updates is array (Positive range <>) of motion_Update
with Pack; with Pack;
procedure motion_Updates_write (Stream : access ada.Streams.Root_Stream_type'Class; Item : in motion_Updates); procedure motion_Updates_write (Stream : access ada.Streams.Root_Stream_type'Class; Item : in motion_Updates);
procedure motion_Updates_read (Stream : access ada.Streams.Root_Stream_type'Class; Item : out motion_Updates); procedure motion_Updates_read (Stream : access ada.Streams.Root_Stream_type'Class; Item : out motion_Updates);
@@ -168,7 +168,13 @@ is
for motion_Updates'write use motion_Updates_write; for motion_Updates'write use motion_Updates_write;
for motion_Updates'read use motion_Updates_read; for motion_Updates'read use motion_Updates_read;
procedure motion_Updates_are (Self : in Item; Now : in motion_Updates) is abstract;
type sequence_Id is range 0 .. 2**32 - 1;
procedure motion_Updates_are (Self : in Item; seq_Id : in sequence_Id;
Now : in motion_Updates) is abstract;
-------------- --------------

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

@@ -531,61 +531,70 @@ is
overriding overriding
procedure motion_Updates_are (Self : in Item; Now : in remote.World.motion_Updates) procedure motion_Updates_are (Self : in Item; seq_Id : in remote.World.sequence_Id;
Now : in remote.World.motion_Updates)
is is
use type remote.World.sequence_Id;
all_Sprites : constant id_Maps_of_sprite.Map := Self.all_Sprites.Map.fetch_all; all_Sprites : constant id_Maps_of_sprite.Map := Self.all_Sprites.Map.fetch_all;
the_Id : gel.sprite_Id; the_Id : gel.sprite_Id;
begin begin
for i in Now'Range if seq_Id > Self.seq_Id.Value
loop then
begin Self.seq_Id.Value_is (seq_Id);
the_Id := Now (i).Id;
declare
use remote.World;
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;
for i in Now'Range
loop
begin begin
-- site_Delta := new_Site - the_Sprite.desired_Site; the_Id := Now (i).Id;
--
-- if abs site_Delta (1) > min_teleport_Delta declare
-- or else abs site_Delta (2) > min_teleport_Delta use remote.World;
-- or else abs site_Delta (3) > min_teleport_Delta
-- then the_Sprite : constant Sprite.view := all_Sprites.Element (the_Id);
-- log ("Teleport."); new_Site : constant Vector_3 := refined (Now (i).Site);
-- the_Sprite.Site_is (new_Site); -- Sprite has been 'teleported', so move it now -- site_Delta : Vector_3;
-- end if; -- to prevent later interpolation. -- 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_Sprite.Site_is (new_Site); -- the_Sprite.Site_is (new_Site);
-- the_Sprite.Spin_is (to_Rotation (Axis => new_Spin.V, -- the_Sprite.Spin_is (to_Rotation (Axis => new_Spin.V,
-- Angle => new_Spin.R)); -- Angle => new_Spin.R));
-- the_Sprite.Spin_is (to_Matrix (to_Quaternion (new_Spin))); -- the_Sprite.Spin_is (to_Matrix (to_Quaternion (new_Spin)));
-- the_Sprite.desired_Dynamics_are (Site => new_Site, -- the_Sprite.desired_Dynamics_are (Site => new_Site,
-- Spin => to_Quaternion (new_Spin)); -- Spin => to_Quaternion (new_Spin));
the_Sprite.desired_Dynamics_are (Site => new_Site, the_Sprite.desired_Dynamics_are (Site => new_Site,
Spin => new_Spin); Spin => new_Spin);
-- the_Sprite.desired_Site_is (new_Site); -- the_Sprite.desired_Site_is (new_Site);
-- the_Sprite.desired_Spin_is (new_Spin); -- 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;
end loop;
exception end if;
when constraint_Error =>
log ("Warning: Received motion updates for unknown sprite" & the_Id'Image & ".");
end;
end loop;
end motion_Updates_are; end motion_Updates_are;
@@ -662,6 +671,26 @@ is
-- Containers -- Containers
-- --
protected
body safe_sequence_Id
is
procedure Value_is (Now : in remote.World.sequence_Id)
is
begin
the_Value := Now;
end Value_is;
function Value return remote.World.sequence_Id
is
begin
return the_Value;
end Value;
end safe_sequence_Id;
protected protected
body safe_id_Map_of_sprite body safe_id_Map_of_sprite
is is

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

@@ -60,7 +60,8 @@ is
procedure is_a_Mirror (Self : access Item'Class; of_World : in remote.World.view); procedure is_a_Mirror (Self : access Item'Class; of_World : in remote.World.view);
overriding overriding
procedure motion_Updates_are (Self : in Item; Now : in remote.World.motion_Updates); procedure motion_Updates_are (Self : in Item; seq_Id : in remote.World.sequence_Id;
Now : in remote.World.motion_Updates);
-- --
-- 'Self' must use 'in' as mode to ensure async transmission with DSA. -- 'Self' must use 'in' as mode to ensure async transmission with DSA.
@@ -98,6 +99,20 @@ private
procedure rid (To : in out sprite_Map; the_Sprite : in Sprite.view); procedure rid (To : in out sprite_Map; the_Sprite : in Sprite.view);
protected
type safe_sequence_Id
is
procedure Value_is (Now : in remote.World.sequence_Id);
function Value return remote.World.sequence_Id;
private
the_Value : remote.World.sequence_Id := 0;
end safe_sequence_Id;
type safe_sequence_Id_view is access all safe_sequence_Id;
-------------- --------------
--- World Item --- World Item
-- --
@@ -106,6 +121,10 @@ private
record record
Age_at_last_mirror_update : Duration := 0.0; Age_at_last_mirror_update : Duration := 0.0;
all_Sprites : aliased sprite_Map; all_Sprites : aliased sprite_Map;
-- Motion Updates
--
seq_Id : safe_sequence_Id_view := new safe_sequence_Id;
end record; end record;

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

@@ -174,7 +174,7 @@ is
the_Sprite : gel.Sprite.view; the_Sprite : gel.Sprite.view;
is_a_mirrored_World : constant Boolean := not Self.Clients.Is_Empty; is_a_mirrored_World : constant Boolean := not Self.Clients.is_Empty;
mirror_Updates_are_due : constant Boolean := Self.Age >= Self.Age_at_last_Clients_update + client_update_Period; mirror_Updates_are_due : constant Boolean := Self.Age >= Self.Age_at_last_Clients_update + client_update_Period;
updates_Count : Natural := 0; updates_Count : Natural := 0;
@@ -187,17 +187,20 @@ is
while has_Element (Cursor) while has_Element (Cursor)
loop loop
the_Sprite := Sprite.view (Element (Cursor)); the_Sprite := Sprite.view (Element (Cursor));
-- the_Sprite.apply_Force ([0.0, 1.0, 0.0]);
-- the_Sprite.apply_Torque_impulse ([0.0, 1.0, 0.0]);
updates_Count := updates_Count + 1; declare
the_motion_Updates (updates_Count) := (Id => the_Sprite.Id, the_Site : constant Vector_3 := the_Sprite.Site;
Site => coarsen (the_Sprite.Site), the_Spin : constant Matrix_3x3 := the_Sprite.Spin;
Spin => coarsen (to_Quaternion (the_Sprite.Spin))); begin
-- Spin => the_Sprite.Spin); if the_Sprite.has_Moved (current_Site => the_Site,
current_Spin => the_Spin)
-- log (Image (Quaternion' (refined (the_motion_Updates (updates_Count).Spin)))); then
-- ada.Text_IO.put (refined (the_motion_Updates (updates_Count).Site)'Image); updates_Count := updates_Count + 1;
the_motion_Updates (updates_Count) := (Id => the_Sprite.Id,
Site => coarsen (the_Site),
Spin => coarsen (to_Quaternion (the_Spin)));
end if;
end;
next (Cursor); next (Cursor);
end loop; end loop;
@@ -205,6 +208,7 @@ is
-- Send updated sprite motions to all registered client worlds. -- Send updated sprite motions to all registered client worlds.
-- --
Self.Age_at_last_clients_update := Self.Age; Self.Age_at_last_clients_update := Self.Age;
Self.seq_Id := Self.seq_Id + 1;
if updates_Count > 0 if updates_Count > 0
then then
@@ -217,8 +221,8 @@ is
while has_Element (Cursor) while has_Element (Cursor)
loop loop
the_Mirror := Element (Cursor); the_Mirror := Element (Cursor);
the_Mirror.motion_Updates_are (the_motion_Updates (1 .. updates_Count)); the_Mirror.motion_Updates_are (Self.seq_Id,
the_motion_Updates (1 .. updates_Count));
next (Cursor); next (Cursor);
end loop; end loop;
end; end;

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

@@ -1,6 +1,5 @@
with with
lace.Observer, lace.Observer,
ada.unchecked_Conversion,
ada.Containers.Vectors; ada.Containers.Vectors;
limited limited
@@ -96,6 +95,10 @@ private
Clients : World_vector; Clients : World_vector;
all_Sprites : aliased sprite_Map; all_Sprites : aliased sprite_Map;
-- Motion Updates
--
seq_Id : remote.World.sequence_Id := 0;
end record; end record;

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

@@ -862,7 +862,8 @@ is
procedure deregister (Self : access Item; the_Mirror : in remote.World.view) is null; procedure deregister (Self : access Item; the_Mirror : in remote.World.view) is null;
overriding overriding
procedure motion_Updates_are (Self : in Item; Now : in remote.World.motion_Updates) is null; procedure motion_Updates_are (Self : in Item; seq_Id : in remote.World.sequence_Id;
Now : in remote.World.motion_Updates) is null;
---------- ----------

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

@@ -241,7 +241,8 @@ is
procedure deregister (Self : access Item; the_Mirror : in remote.World.view); procedure deregister (Self : access Item; the_Mirror : in remote.World.view);
overriding overriding
procedure motion_Updates_are (Self : in Item; Now : in remote.World.motion_Updates); procedure motion_Updates_are (Self : in Item; seq_Id : in remote.World.sequence_Id;
Now : in remote.World.motion_Updates);
-- --
-- 'Self' must use 'in' as mode to ensure async transmission with DSA. -- 'Self' must use 'in' as mode to ensure async transmission with DSA.
@@ -293,7 +294,7 @@ private
type Hertz is new Real; type Hertz is new Real;
evolve_Hz : constant Hertz := 60.0; evolve_Hz : constant Hertz := 60.0;
client_update_Hz : constant Hertz := 4.0; client_update_Hz : constant Hertz := 20.0; -- Too small will make player movement response time sluggish. Too large consumes much bandwidth.
evolve_Period : constant Duration := 1.0 / Duration (evolve_Hz); evolve_Period : constant Duration := 1.0 / Duration (evolve_Hz);
client_update_Period : constant Duration := 1.0 / Duration (client_update_Hz); client_update_Period : constant Duration := 1.0 / Duration (client_update_Hz);
@@ -404,8 +405,8 @@ private
-- Models -- Models
-- --
graphics_Models : aliased id_Maps_of_graphics_model .Map; graphics_Models : aliased id_Maps_of_graphics_model.Map;
physics_Models : aliased id_Maps_of_physics_model.Map; physics_Models : aliased id_Maps_of_physics_model .Map;
-- Ids -- Ids
-- --