From bcd283c6d62bc981f3c34bae7bd6e2f4bd1907b4 Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Wed, 13 Dec 2023 17:48:42 +1100 Subject: [PATCH] gel: Only send motion updates for sprites if they have moved. --- .../interface/source/physics-object.ads | 1 + .../applet/demo/game/pong-sdl/launch_pong.adb | 30 ++--- 4-high/gel/source/applet/gel-applet.adb | 2 +- 4-high/gel/source/gel-sprite.adb | 27 +++++ 4-high/gel/source/gel-sprite.ads | 15 +++ .../source/platform/gtk/gel-window-gtk.adb | 1 + 4-high/gel/source/remote/gel-remote-world.ads | 10 +- 4-high/gel/source/world/gel-world-client.adb | 109 +++++++++++------- 4-high/gel/source/world/gel-world-client.ads | 21 +++- 4-high/gel/source/world/gel-world-server.adb | 30 ++--- 4-high/gel/source/world/gel-world-server.ads | 5 +- 4-high/gel/source/world/gel-world.adb | 3 +- 4-high/gel/source/world/gel-world.ads | 9 +- 13 files changed, 186 insertions(+), 77 deletions(-) diff --git a/3-mid/physics/interface/source/physics-object.ads b/3-mid/physics/interface/source/physics-object.ads index c4a074e..3602c9a 100644 --- a/3-mid/physics/interface/source/physics-object.ads +++ b/3-mid/physics/interface/source/physics-object.ads @@ -3,6 +3,7 @@ with physics.Model, lace.Any; + package physics.Object -- -- Provide an interface for physics objects. diff --git a/4-high/gel/applet/demo/game/pong-sdl/launch_pong.adb b/4-high/gel/applet/demo/game/pong-sdl/launch_pong.adb index 9e6b7bb..070bf67 100644 --- a/4-high/gel/applet/demo/game/pong-sdl/launch_pong.adb +++ b/4-high/gel/applet/demo/game/pong-sdl/launch_pong.adb @@ -50,7 +50,7 @@ is -- the_Ball : constant gel.Sprite.view := 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, Bounce => 1.0, Friction => 0.0, @@ -77,10 +77,12 @@ is procedure add_Player (Id : in player_Id; - Site : in Vector_2) + Site : in Vector_3) is 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 the_Player.Paddle := gel.Forge.new_rectangle_Sprite (the_Applet.World, Site => Site, @@ -101,13 +103,13 @@ is the_Applet.World.add (the_Player.Paddle); 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; --- Walls -- - procedure add_Wall (Site : in Vector_2; + procedure add_Wall (Site : in Vector_3; Width, Height : in Real) is @@ -204,8 +206,8 @@ begin declare paddle_X_Offset : constant := stadium_Width / 2.0 - 2.0; begin - add_Player (1, Site => [-paddle_X_Offset, 0.0]); - add_Player (2, 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, 0.0]); end; --- Build the stadium. @@ -219,14 +221,14 @@ begin side_wall_X_Offset : constant := stadium_Width / 2.0; side_wall_Y_Offset : constant := (side_wall_Height + goal_Size) / 2.0; 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], Width => stadium_Width, Height => Thickness); -- Bottom + 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, 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], 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); -- upper 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], 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); -- upper Right + add_Wall (Site => [ side_wall_X_Offset, -side_wall_Y_Offset, 0.0], Width => Thickness, Height => side_wall_Height); -- lower Right end; -- Connect events. @@ -248,7 +250,7 @@ begin loop 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. --- Check goal scoring. diff --git a/4-high/gel/source/applet/gel-applet.adb b/4-high/gel/source/applet/gel-applet.adb index 68cf2d6..d7a07a2 100644 --- a/4-high/gel/source/applet/gel-applet.adb +++ b/4-high/gel/source/applet/gel-applet.adb @@ -426,7 +426,7 @@ is declare the_world_Info : world_Info renames Element (world_Cursor).all; begin - the_world_Info.World.evolve; + null; -- the_world_Info.World.evolve; end; next (world_Cursor); diff --git a/4-high/gel/source/gel-sprite.adb b/4-high/gel/source/gel-sprite.adb index fa1b7f1..4361f39 100644 --- a/4-high/gel/source/gel-sprite.adb +++ b/4-high/gel/source/gel-sprite.adb @@ -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 -- diff --git a/4-high/gel/source/gel-sprite.ads b/4-high/gel/source/gel-sprite.ads index 6725dd4..3bf66ee 100644 --- a/4-high/gel/source/gel-sprite.ads +++ b/4-high/gel/source/gel-sprite.ads @@ -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 type access_Joint_views is access all Joint.views; @@ -422,6 +432,11 @@ private user_Data : any_user_Data_view; is_Destroyed : Boolean := False; + + -- Motion Updates + -- + prior_Site : Vector_3 := Origin_3D; + prior_Spin : Matrix_3x3 := Identity_3x3; end record; diff --git a/4-high/gel/source/platform/gtk/gel-window-gtk.adb b/4-high/gel/source/platform/gtk/gel-window-gtk.adb index eaed8f6..943f447 100644 --- a/4-high/gel/source/platform/gtk/gel-window-gtk.adb +++ b/4-high/gel/source/platform/gtk/gel-window-gtk.adb @@ -219,6 +219,7 @@ is begin Self.gl_Area := gtk_glArea_new; Self.gl_Area.set_use_ES (True); + Self.gl_Area.Set_Can_Focus (True); Callbacks_with_gel_Window_user_Data.connect (Self.gl_Area, "realize", diff --git a/4-high/gel/source/remote/gel-remote-world.ads b/4-high/gel/source/remote/gel-remote-world.ads index 9e165a5..c206c13 100644 --- a/4-high/gel/source/remote/gel-remote-world.ads +++ b/4-high/gel/source/remote/gel-remote-world.ads @@ -160,7 +160,7 @@ is 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_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'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; + + -------------- diff --git a/4-high/gel/source/world/gel-world-client.adb b/4-high/gel/source/world/gel-world-client.adb index 323b80f..46b7bde 100644 --- a/4-high/gel/source/world/gel-world-client.adb +++ b/4-high/gel/source/world/gel-world-client.adb @@ -531,61 +531,70 @@ is 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 + use type remote.World.sequence_Id; + 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 - begin - 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; + if seq_Id > Self.seq_Id.Value + then + Self.seq_Id.Value_is (seq_Id); + for i in Now'Range + loop 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; + + 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; + + 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.Spin_is (to_Rotation (Axis => new_Spin.V, - -- Angle => new_Spin.R)); + -- 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.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 => to_Quaternion (new_Spin)); - the_Sprite.desired_Dynamics_are (Site => new_Site, - Spin => 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); + -- 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; - exception - when constraint_Error => - log ("Warning: Received motion updates for unknown sprite" & the_Id'Image & "."); - end; - end loop; + end if; end motion_Updates_are; @@ -662,6 +671,26 @@ is -- 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 body safe_id_Map_of_sprite is diff --git a/4-high/gel/source/world/gel-world-client.ads b/4-high/gel/source/world/gel-world-client.ads index 3c88f2e..303b718 100644 --- a/4-high/gel/source/world/gel-world-client.ads +++ b/4-high/gel/source/world/gel-world-client.ads @@ -60,7 +60,8 @@ is procedure is_a_Mirror (Self : access Item'Class; of_World : in remote.World.view); 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. @@ -98,6 +99,20 @@ private 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 -- @@ -106,6 +121,10 @@ private record Age_at_last_mirror_update : Duration := 0.0; all_Sprites : aliased sprite_Map; + + -- Motion Updates + -- + seq_Id : safe_sequence_Id_view := new safe_sequence_Id; end record; diff --git a/4-high/gel/source/world/gel-world-server.adb b/4-high/gel/source/world/gel-world-server.adb index 06fbb9e..ce63527 100644 --- a/4-high/gel/source/world/gel-world-server.adb +++ b/4-high/gel/source/world/gel-world-server.adb @@ -174,7 +174,7 @@ is 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; updates_Count : Natural := 0; @@ -187,17 +187,20 @@ is while has_Element (Cursor) loop 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; - the_motion_Updates (updates_Count) := (Id => the_Sprite.Id, - Site => coarsen (the_Sprite.Site), - Spin => coarsen (to_Quaternion (the_Sprite.Spin))); - -- Spin => the_Sprite.Spin); - - -- log (Image (Quaternion' (refined (the_motion_Updates (updates_Count).Spin)))); - -- ada.Text_IO.put (refined (the_motion_Updates (updates_Count).Site)'Image); + declare + the_Site : constant Vector_3 := the_Sprite.Site; + the_Spin : constant Matrix_3x3 := the_Sprite.Spin; + begin + if the_Sprite.has_Moved (current_Site => the_Site, + current_Spin => the_Spin) + then + 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); end loop; @@ -205,6 +208,7 @@ is -- Send updated sprite motions to all registered client worlds. -- Self.Age_at_last_clients_update := Self.Age; + Self.seq_Id := Self.seq_Id + 1; if updates_Count > 0 then @@ -217,8 +221,8 @@ is while has_Element (Cursor) loop 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); end loop; end; diff --git a/4-high/gel/source/world/gel-world-server.ads b/4-high/gel/source/world/gel-world-server.ads index 2843439..79b5d06 100644 --- a/4-high/gel/source/world/gel-world-server.ads +++ b/4-high/gel/source/world/gel-world-server.ads @@ -1,6 +1,5 @@ with lace.Observer, - ada.unchecked_Conversion, ada.Containers.Vectors; limited @@ -96,6 +95,10 @@ private Clients : World_vector; all_Sprites : aliased sprite_Map; + + -- Motion Updates + -- + seq_Id : remote.World.sequence_Id := 0; end record; diff --git a/4-high/gel/source/world/gel-world.adb b/4-high/gel/source/world/gel-world.adb index 19cc9d2..e630814 100644 --- a/4-high/gel/source/world/gel-world.adb +++ b/4-high/gel/source/world/gel-world.adb @@ -862,7 +862,8 @@ is procedure deregister (Self : access Item; the_Mirror : in remote.World.view) is null; 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; ---------- diff --git a/4-high/gel/source/world/gel-world.ads b/4-high/gel/source/world/gel-world.ads index fb9c4c1..ff1dbdf 100644 --- a/4-high/gel/source/world/gel-world.ads +++ b/4-high/gel/source/world/gel-world.ads @@ -241,7 +241,8 @@ is procedure deregister (Self : access Item; the_Mirror : in remote.World.view); 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. @@ -293,7 +294,7 @@ private type Hertz is new Real; 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); client_update_Period : constant Duration := 1.0 / Duration (client_update_Hz); @@ -404,8 +405,8 @@ private -- Models -- - graphics_Models : aliased id_Maps_of_graphics_model .Map; - physics_Models : aliased id_Maps_of_physics_model.Map; + graphics_Models : aliased id_Maps_of_graphics_model.Map; + physics_Models : aliased id_Maps_of_physics_model .Map; -- Ids --