gel.world: Add 'Mirror_as_observer' parameter to 'deregister' procedure.

This commit is contained in:
Rod Kay
2024-08-20 11:07:04 +10:00
parent 2a82dc5fda
commit e63740494b
7 changed files with 28 additions and 19 deletions

View File

@@ -163,22 +163,22 @@ is
procedure Write (Stream : not null access ada.Streams.Root_Stream_type'Class; procedure write (Stream : not null access ada.Streams.Root_Stream_type'Class;
the_Event : in new_graphics_model_Event) the_Event : in new_graphics_model_Event)
is is
begin begin
openGL.remote_Model.item'Class'Output (Stream, openGL.remote_Model.item'Class'Output (Stream,
the_Event.Model.all); the_Event.Model.all);
end Write; end write;
procedure Read (Stream : not null access ada.Streams.Root_Stream_type'Class; procedure read (Stream : not null access ada.Streams.Root_Stream_type'Class;
the_Event : out new_graphics_model_Event) the_Event : out new_graphics_model_Event)
is is
begin begin
the_Event.Model := new openGL.remote_Model.item'Class' (openGL.remote_Model.item'Class'Input (Stream)); the_Event.Model := new openGL.remote_Model.item'Class' (openGL.remote_Model.item'Class'Input (Stream));
end Read; end read;

View File

@@ -39,7 +39,8 @@ is
procedure register (Self : access Item; the_Mirror : in World.view; procedure register (Self : access Item; the_Mirror : in World.view;
Mirror_as_observer : in lace.Observer.view) is abstract; Mirror_as_observer : in lace.Observer.view) is abstract;
procedure deregister (Self : access Item; the_Mirror : in World.view) is abstract; procedure deregister (Self : access Item; the_Mirror : in World.view;
Mirror_as_observer : in lace.Observer.view) is abstract;
@@ -71,8 +72,8 @@ is
end record; end record;
procedure Write (Stream : not null access ada.Streams.Root_Stream_type'Class; the_Event : in new_graphics_model_Event); procedure write (Stream : not null access ada.Streams.Root_Stream_type'Class; the_Event : in new_graphics_model_Event);
procedure Read (Stream : not null access ada.Streams.Root_Stream_type'Class; the_Event : out new_graphics_model_Event); procedure read (Stream : not null access ada.Streams.Root_Stream_type'Class; the_Event : out new_graphics_model_Event);
for new_graphics_model_Event'write use write; for new_graphics_model_Event'write use write;
for new_graphics_model_Event'read use read; for new_graphics_model_Event'read use read;

View File

@@ -419,8 +419,8 @@ is
-- --
the_new_graphics_model_Response.World := Self.all'Access; the_new_graphics_model_Response.World := Self.all'Access;
Self.add (the_new_graphics_model_Response'Access, Self.add (the_Response => the_new_graphics_model_Response'Access,
to_Kind (remote.World.new_graphics_model_Event'Tag), to_Kind => to_Kind (remote.World.new_graphics_model_Event'Tag),
from_Subject => of_World.Name); from_Subject => of_World.Name);
-- New physics model response. -- New physics model response.

View File

@@ -284,7 +284,6 @@ 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_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 (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 .new_sprite_Event 'Tag)); 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)); Self.register (Mirror_as_observer, to_Kind (gel.events .rid_sprite_Event 'Tag));
end register; end register;
@@ -292,10 +291,16 @@ is
overriding overriding
procedure deregister (Self : access Item; the_Mirror : in remote.World.view) procedure deregister (Self : access Item; the_Mirror : in remote.World.view;
Mirror_as_observer : in lace.Observer.view)
is is
begin begin
Self.Clients.delete (Self.Clients.find_Index (the_Mirror)); Self.Clients.delete (Self.Clients.find_Index (the_Mirror));
Self.deregister (Mirror_as_observer, to_Kind (remote.World.new_graphics_model_Event'Tag));
Self.deregister (Mirror_as_observer, to_Kind (remote.World. new_physics_model_Event'Tag));
Self.deregister (Mirror_as_observer, to_Kind (gel.events .new_sprite_Event 'Tag));
Self.deregister (Mirror_as_observer, to_Kind (gel.events .rid_sprite_Event 'Tag));
end deregister; end deregister;

View File

@@ -51,7 +51,8 @@ is
procedure register (Self : access Item; the_Mirror : in remote.World.view; procedure register (Self : access Item; the_Mirror : in remote.World.view;
Mirror_as_observer : in lace.Observer.view); Mirror_as_observer : in lace.Observer.view);
overriding overriding
procedure deregister (Self : access Item; the_Mirror : in remote.World.view); procedure deregister (Self : access Item; the_Mirror : in remote.World.view;
Mirror_as_observer : in lace.Observer.view);
overriding overriding
procedure evolve (Self : in out Item); procedure evolve (Self : in out Item);

View File

@@ -883,7 +883,8 @@ is
procedure register (Self : access Item; the_Mirror : in remote.World.view; procedure register (Self : access Item; the_Mirror : in remote.World.view;
Mirror_as_observer : in lace.Observer.view) is null; Mirror_as_observer : in lace.Observer.view) is null;
overriding overriding
procedure deregister (Self : access Item; the_Mirror : in remote.World.view) is null; procedure deregister (Self : access Item; the_Mirror : in remote.World.view;
Mirror_as_observer : in lace.Observer.view) is null;
overriding overriding
procedure motion_Updates_are (Self : in Item; seq_Id : in remote.World.sequence_Id; procedure motion_Updates_are (Self : in Item; seq_Id : in remote.World.sequence_Id;

View File

@@ -251,7 +251,8 @@ is
procedure register (Self : access Item; the_Mirror : in remote.World.view; procedure register (Self : access Item; the_Mirror : in remote.World.view;
Mirror_as_observer : in lace.Observer.view); Mirror_as_observer : in lace.Observer.view);
overriding overriding
procedure deregister (Self : access Item; the_Mirror : in remote.World.view); procedure deregister (Self : access Item; the_Mirror : in remote.World.view;
Mirror_as_observer : in lace.Observer.view);
overriding overriding
procedure motion_Updates_are (Self : in Item; seq_Id : in remote.World.sequence_Id; procedure motion_Updates_are (Self : in Item; seq_Id : in remote.World.sequence_Id;