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

lace.events: Fix bugs.

Browse Source
This commit is contained in:
Rod Kay
2024-10-30 11:39:32 +11:00
parent 2a17b624c1
commit c70aec24f2
10 changed files with 93 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
1-base/lace/source/events/mixin/lace-event-make_observer.adb
View File

@@ -72,6 +72,11 @@ is
Sequence : in sequence_Id)
is
begin
if not Self.sequence_Id_Map.contains (from_Subject)
then
Self.sequence_Id_Map.insert (from_Subject, 0);
end if;
Self.Responses.receive (Self, the_Event, from_Subject);
end receive;
@@ -146,6 +151,11 @@ is
begin
my_Responses.Element (from_Subject).delete (to_Kind);
if my_Responses.Element (from_Subject).is_Empty
then
Self.sequence_Id_Map.delete (from_Subject);
end if;
if Observer.Logger /= null
then
Observer.Logger.log_rid_Response (the_Response,

1
1-base/lace/source/events/mixin/lace-event-make_observer.ads
View File

@@ -140,4 +140,5 @@ private
sequence_Id_Map : Containers.name_Map_of_sequence_Id; -- Contains the next expected sequence ID from each subject.
end record;
end lace.event.make_Observer;

39
1-base/lace/source/events/mixin/lace-event-make_subject.adb
View File

@@ -4,6 +4,8 @@ with
system.RPC,
ada.unchecked_Deallocation;
with ada.Text_IO; use ada.Text_IO;
package body lace.event.make_Subject
is
@@ -88,7 +90,7 @@ is
of_Kind : in Event.Kind)
is
begin
Self.safe_Observers.rid (the_Observer, of_Kind);
Self.safe_Observers.rid (the_Observer, of_Kind, Self.sequence_Id_Map);
if Subject.Logger /= null
then
@@ -297,7 +299,7 @@ is
use event_Observer_Vectors,
event_kind_Maps_of_event_observers;
Cursor : constant event_kind_Maps_of_event_observers.Cursor := the_Observers.find (of_Kind);
Cursor : constant event_kind_Maps_of_event_observers.Cursor := the_Observers.find (of_Kind);
the_event_Observers : event_Observer_Vector_view;
begin
if has_Element (Cursor)
@@ -314,12 +316,39 @@ is
procedure rid (the_Observer : in Observer.view;
of_Kind : in Event.Kind)
procedure rid (the_Observer : in Observer.view;
of_Kind : in Event.Kind;
sequence_Id_Map : in out Containers.safe_sequence_Id_Map)
is
the_event_Observers : event_Observer_Vector renames the_Observers.Element (of_Kind).all;
begin
the_event_Observers.delete (the_event_Observers.find_Index (the_Observer));
declare
Found : Boolean := False;
begin
for each_of_the_event_Observers of the_Observers
loop
declare
the_event_Observers : event_Observer_Vector renames each_of_the_event_Observers.all;
begin
for each_Observer of the_event_Observers
loop
if each_Observer = the_Observer
then
Found := True;
exit;
end if;
end loop;
end;
end loop;
if not Found
then
sequence_Id_Map.rid (the_Observer.Name);
end if;
end;
end rid;
@@ -347,7 +376,7 @@ is
function observer_Count return Natural
function observer_Count return Natural -- TODO: This is wrong.
is
use event_kind_Maps_of_event_observers;

5
1-base/lace/source/events/mixin/lace-event-make_subject.ads
View File

@@ -121,8 +121,9 @@ private
procedure add (the_Observer : in Observer.view;
of_Kind : in Event.Kind);
procedure rid (the_Observer : in Observer.view;
of_Kind : in Event.Kind);
procedure rid (the_Observer : in Observer.view;
of_Kind : in Event.Kind;
sequence_Id_Map : in out Containers.safe_sequence_Id_Map);
function fetch_Observers (of_Kind : in Event.Kind) return Subject.Observer_views;
function observer_Count return Natural;

2
1-base/lace/source/events/mixin/private/lace-event-containers.ads
View File

@@ -42,7 +42,7 @@ is
procedure get_Next (Id : out event.sequence_Id;
for_Name : in String);
procedure decrement (for_Name : in String);
procedure decrement (for_Name : in String); -- TODO: Rid.
private
the_Map : name_Map_of_sequence_Id;

5
1-base/lace/source/events/mixin/xgc/lace-event-make_observer-deferred.adb
View File

@@ -136,6 +136,11 @@ is
begin
if Self.Responses.contains (subject_Name.all)
then
if not Self.sequence_Id_Map.contains (subject_Name.all)
then
Self.sequence_Id_Map.insert (subject_Name.all, 0);
end if;
Sorter.sort (the_Events);
actuate (Self.Responses.Element (subject_Name.all),
the_Events,

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

@@ -786,7 +786,8 @@ is
if the_Collision.near_Sprite /= null
then
declare
sprite_clicked_Event : constant gel.Events.sprite_click_down_Event := (mouse_Button => the_Event.Button,
sprite_clicked_Event : constant gel.Events.sprite_click_down_Event := (Sprite => the_Collision.near_Sprite.Id,
mouse_Button => the_Event.Button,
world_Site => Site_world_space);
begin
the_Collision.near_Sprite.emit (sprite_clicked_Event);
@@ -805,7 +806,8 @@ is
if the_Collision.near_Sprite /= null
then
declare
sprite_clicked_Event : constant gel.Events.sprite_click_down_Event := (mouse_Button => the_Event.Button,
sprite_clicked_Event : constant gel.Events.sprite_click_down_Event := (Sprite => the_Collision.near_Sprite.Id,
mouse_Button => the_Event.Button,
world_Site => the_Collision.Site_world);
begin
@@ -855,8 +857,6 @@ is
Site_world_space : constant Vector_3 := the_Camera.to_world_Site (Site_window_space);
sprite_Event : constant gel.Events.sprite_click_up_Event := (mouse_Button => the_Event.Button,
world_Site => Site_world_space);
begin
case the_world_Info.World.space_Kind
is
@@ -865,10 +865,16 @@ is
the_Collision : ray_Collision := the_world_Info.World.cast_Ray (From => the_Camera.Site,
To => Site_world_space);
begin
if the_Collision.near_Sprite /= null
then
the_Collision.near_Sprite.emit (sprite_Event);
end if;
declare
click_Event : constant gel.Events.sprite_click_up_Event := (Sprite => the_Collision.near_Sprite.Id,
mouse_Button => the_Event.Button,
world_Site => Site_world_space);
begin
if the_Collision.near_Sprite /= null
then
the_Collision.near_Sprite.emit (click_Event);
end if;
end;
end;
when physics.Box2D =>
@@ -881,7 +887,13 @@ is
begin
if the_Collision.near_Sprite /= null
then
the_Collision.near_Sprite.emit (sprite_Event);
declare
click_Event : constant gel.Events.sprite_click_up_Event := (Sprite => the_Collision.near_Sprite.Id,
mouse_Button => the_Event.Button,
world_Site => Site_world_space);
begin
the_Collision.near_Sprite.emit (click_Event);
end;
end if;
end;
end case;

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

@@ -76,6 +76,7 @@ is
type sprite_click_down_Event is new lace.Event.item with
record
Sprite : gel.sprite_Id;
mouse_Button : gel.Mouse.Button_Id;
world_Site : math.Vector_3;
end record;
@@ -83,6 +84,7 @@ is
type sprite_click_up_Event is new lace.Event.item with
record
Sprite : gel.sprite_Id;
mouse_Button : gel.Mouse.Button_Id;
world_Site : math.Vector_3;
end record;

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

@@ -131,7 +131,7 @@ is
-------------------------
--- Sprite Motion Updates
--- Id Motion Updates
--
-- Coarse types to help minimise network use - (TODO: Currently disabled til better quaternion 'coarsen' is ready.)
@@ -181,7 +181,7 @@ is
------------------------------
--- Sprite add and rid events.
--- Id add and rid events.
--
type sprite_added_Event is new lace.Event.item with
@@ -192,7 +192,8 @@ is
type sprite_ridded_Event is new lace.Event.item with
record
Sprite : gel.sprite_Id;
Id : gel.sprite_Id;
Name : lace.Text.item_128;
end record;

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

@@ -9,7 +9,7 @@ with
lace.Response,
lace.Event.utility,
lace.Text,
lace.Text.forge,
ada.unchecked_Deallocation,
ada.Exceptions,
@@ -216,7 +216,7 @@ is
is
the_Event : constant remote.World.new_graphics_model_Event := remote.World.new_graphics_model_Event (to_Event);
begin
log ("gel.world.client ~ new graphics model response ~ model id:" & the_Event.Model.Id'Image);
-- log ("gel.world.client ~ new graphics model response ~ model id:" & the_Event.Model.Id'Image);
Self.World.add (new openGL.Model.item'Class' (openGL.Model.item'Class (the_Event.Model.all)));
end respond;
@@ -253,7 +253,7 @@ is
is
the_Event : constant remote.World.new_physics_model_Event := remote.World.new_physics_model_Event (to_Event);
begin
log ("gel.world.client ~ new physics model response ~ model id:" & the_Event.Model.Id'Image);
-- log ("gel.world.client ~ new physics model response ~ model id:" & the_Event.Model.Id'Image);
Self.World.add (new physics.Model.item'Class' (physics.Model.item'Class (the_Event.Model.all)));
end respond;
@@ -363,14 +363,11 @@ is
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);
the_Sprite : constant gel.Sprite.view := Self.World.fetch_Sprite (the_Event.Id);
begin
Self.World.rid (Self.World.fetch_Sprite (the_Event.Id));
Self.World.emit (remote.world.sprite_ridded_Event' (Sprite => the_Event.Id));
Self.World.rid (the_Sprite);
Self.World.emit (remote.world.sprite_ridded_Event' (Id => the_Event.Id,
Name => lace.Text.forge.to_Text_128 (the_Sprite.Name)));
end;
end respond;
@@ -429,7 +426,7 @@ is
to_Kind (remote.World.new_physics_model_Event'Tag),
from_Subject => of_World.Name);
-- New sprite response.
-- New Id response.
--
define (the_my_new_sprite_Response, World => Self.all'Access,
Models => Self.graphics_Models'Access,
@@ -439,7 +436,7 @@ is
to_Kind (gel.Events.new_sprite_Event'Tag),
from_Subject => of_World.Name);
-- Rid sprite response.
-- Rid Id response.
--
define (the_my_rid_sprite_Response, World => Self.all'Access,
Models => Self.graphics_Models'Access,
@@ -594,7 +591,7 @@ is
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;
-- added_Event.Id := the_Sprite.Id;
-- log ("****** gel.world.client.add " & the_Sprite.Name);
-- if the_Sprite.Id /= 50000000
@@ -685,7 +682,7 @@ is
Self.respond;
Self.local_Subject_and_deferred_Observer.respond;
-- Interpolate sprite transforms.
-- Interpolate Id transforms.
--
declare
use id_Maps_of_sprite;
@@ -730,7 +727,7 @@ is
-- exception
-- when E : others =>
-- log (""); log ("");
-- log ("Error in 'gel.World.client.evolve' sprite response.");
-- log ("Error in 'gel.World.client.evolve' Id response.");
-- log ("");
-- log (ada.Exceptions.exception_Information (E));
-- log (""); log ("");