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

gel.world: Work on dsa.

Browse Source
This commit is contained in:
Rod Kay
2023-11-17 15:09:14 +11:00
parent fa02760f9c
commit c921b638a1
8 changed files with 207 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -23,6 +23,11 @@ is
use lace.Event.utility;
procedure log (Message : in String := "")
renames ada.Text_IO.put_Line;
procedure my_context_Setter
is
begin
@@ -56,6 +61,7 @@ is
the_Sprite : gel.Sprite.view;
begin
log ("gel.applet.add_new_Sprite.respond");
the_Sprite := Self.Applet.World (the_Event.World_Id).fetch_Sprite (the_event.Sprite_Id);
the_Sprite.is_Visible (True);

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

@@ -665,7 +665,8 @@ is
procedure Speed_is (Self : in out Item; Now : in Vector_3)
is
begin
Self.World.set_Speed (Self'unchecked_Access, Now);
Self.Solid.Speed_is (Now);
-- Self.World.set_Speed (Self'unchecked_Access, Now);
end Speed_is;

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

@@ -164,7 +164,7 @@ is
procedure Write (Stream : not null access ada.Streams.Root_Stream_type'Class;
the_Event : in new_model_Event)
the_Event : in new_graphics_model_Event)
is
begin
openGL.remote_Model.item'Class'Output (Stream,
@@ -174,7 +174,7 @@ is
procedure Read (Stream : not null access ada.Streams.Root_Stream_type'Class;
the_Event : out new_model_Event)
the_Event : out new_graphics_model_Event)
is
begin
the_Event.Model := new openGL.remote_Model.item'Class' (openGL.remote_Model.item'Class'Input (Stream));

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

@@ -27,6 +27,7 @@ is
type View is access all Item'Class with asynchronous;
-----------
-- Mirrors
--
@@ -39,6 +40,7 @@ is
procedure deregister (Self : access Item; the_Mirror : in World.view) is abstract;
----------
-- Models
--
@@ -52,26 +54,26 @@ is
function Hash is new ada.unchecked_Conversion (gel.graphics_model_Id, ada.containers.Hash_type);
use type gel.graphics_model_Id;
package id_Maps_of_model_plan is new ada.Containers.indefinite_Hashed_Maps (gel.graphics_model_Id,
openGL.remote_Model.item'Class,
Hash,
"=");
subtype graphics_Model_Set is id_Maps_of_model_plan.Map; -- TODO: Rename to id_Map_of_graphics_model_plan.
package id_Maps_of_graphics_model is new ada.Containers.indefinite_Hashed_Maps (gel.graphics_model_Id,
openGL.remote_Model.item'Class,
Hash,
"=");
subtype id_Map_of_graphics_model is id_Maps_of_graphics_model.Map;
function graphics_Models (Self : in Item) return graphics_Model_Set is abstract;
function graphics_Models (Self : in Item) return id_Map_of_graphics_model is abstract;
type new_model_Event is new lace.Event.item with
type new_graphics_model_Event is new lace.Event.item with
record
Model : access openGL.remote_Model.item'Class;
end record;
procedure Write (Stream : not null access ada.Streams.Root_Stream_type'Class; the_Event : in new_model_Event);
procedure Read (Stream : not null access ada.Streams.Root_Stream_type'Class; the_Event : out new_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);
for new_model_Event'write use write;
for new_model_Event'read use read;
for new_graphics_model_Event'write use write;
for new_graphics_model_Event'read use read;
-- Physics
@@ -83,13 +85,13 @@ is
use type physics.model_Id;
function Hash is new ada.unchecked_Conversion (physics.model_Id, ada.containers.Hash_type);
package id_Maps_of_physics_model_plan is new ada.containers.indefinite_Hashed_Maps (physics.model_Id,
physics.remote.Model.item'Class,
Hash,
"=");
subtype physics_Model_Set is id_Maps_of_physics_model_plan.Map; -- TODO: Rename to id_Map_of_physics_model_plan.
package id_Maps_of_physics_model is new ada.containers.indefinite_Hashed_Maps (physics.model_Id,
physics.remote.Model.item'Class,
Hash,
"=");
subtype id_Map_of_physics_model is id_Maps_of_physics_model.Map;
function physics_Models (Self : in Item) return physics_Model_Set is abstract;
function physics_Models (Self : in Item) return id_Map_of_physics_model is abstract;
type new_physics_model_Event is new lace.Event.item with

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

@@ -22,7 +22,6 @@ is
procedure log (Message : in String)
renames ada.text_IO.put_Line;
pragma Unreferenced (log);
---------
@@ -92,10 +91,10 @@ is
function to_Sprite (the_Pair : in remote.World.sprite_model_Pair;
the_Models : in Id_Maps_of_Model .Map;
the_physics_Models : in Id_Maps_of_physics_Model.Map;
the_World : in gel.World.view) return gel.Sprite.view
function to_Sprite (the_Pair : in remote.World.sprite_model_Pair;
the_graphics_Models : in id_Maps_of_graphics_model.Map;
the_physics_Models : in Id_Maps_of_physics_Model .Map;
the_World : in gel.World.view) return gel.Sprite.view
is
the_graphics_Model : access openGL .Model.item'Class;
the_physics_Model : access physics.Model.item'Class;
@@ -103,8 +102,13 @@ is
use openGL;
begin
the_graphics_Model := openGL .Model.view (the_Models .Element (the_Pair.graphics_Model_Id));
the_physics_Model := physics.Model.view (the_physics_Models.Element (the_Pair. physics_Model_Id));
log ("gel.world.client.to_Sprite ~ the_Pair.graphics_Model_Id:" & the_Pair.graphics_Model_Id'Image);
the_graphics_Model := openGL .Model.view (the_graphics_Models.Element (the_Pair.graphics_Model_Id));
log ("gel.world.client.to_Sprite ~ the_Pair.physics_Model_Id:" & the_Pair.physics_Model_Id'Image);
the_physics_Model := physics.Model.view ( the_physics_Models.Element (the_Pair. physics_Model_Id));
the_Sprite := gel.Sprite.forge.new_Sprite ("Sprite" & the_Pair.sprite_Id'Image,
sprite.World_view (the_World),
@@ -140,7 +144,7 @@ is
type create_new_Sprite is new lace.Response.item with
record
World : gel.World.view;
Models : access id_Maps_of_model .Map;
Models : access id_Maps_of_graphics_model .Map;
physics_Models : access id_Maps_of_physics_model.Map;
end record;
@@ -197,49 +201,89 @@ is
----------------------
--- new_model_Response
-------------------------------
--- new_graphics_model_Response
--
type new_model_Response is new lace.Response.item with
type new_graphics_model_Response is new lace.Response.item with
record
World : gel.World.view;
end record;
overriding
function Name (Self : in new_model_Response) return String;
function Name (Self : in new_graphics_model_Response) return String;
overriding
procedure respond (Self : in out new_model_Response; to_Event : in lace.Event.Item'Class)
procedure respond (Self : in out new_graphics_model_Response; to_Event : in lace.Event.Item'Class)
is
the_Event : constant remote.World.new_model_Event := remote.World.new_model_Event (to_Event);
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);
Self.World.add (new openGL.Model.item'Class' (openGL.Model.item'Class (the_Event.Model.all)));
end respond;
overriding
function Name (Self : in new_model_Response) return String
function Name (Self : in new_graphics_model_Response) return String
is
pragma unreferenced (Self);
begin
return "new_model_Response";
return "new_graphics_model_Response";
end Name;
the_new_model_Response : aliased new_model_Response;
the_new_graphics_model_Response : aliased new_graphics_model_Response;
------------------------------
--- new_physics_model_Response
--
type new_physics_model_Response is new lace.Response.item with
record
World : gel.World.view;
end record;
overriding
function Name (Self : in new_physics_model_Response) return String;
overriding
procedure respond (Self : in out new_physics_model_Response; to_Event : in lace.Event.Item'Class)
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);
Self.World.add (new physics.Model.item'Class' (physics.Model.item'Class (the_Event.Model.all)));
end respond;
overriding
function Name (Self : in new_physics_model_Response) return String
is
pragma unreferenced (Self);
begin
return "new_physics_model_Response";
end Name;
the_new_physics_model_Response : aliased new_physics_model_Response;
--------------------------
--- my_new_sprite_Response
--
type my_new_sprite_Response is new lace.Response.item with
record
World : gel.World.view;
Models : access id_Maps_of_model .Map;
physics_Models : access id_Maps_of_physics_model.Map;
World : gel.World.view;
graphics_Models : access id_Maps_of_graphics_model.Map;
physics_Models : access id_Maps_of_physics_model .Map;
end record;
@@ -251,29 +295,38 @@ is
overriding
procedure respond (Self : in out my_new_sprite_Response; to_Event : in lace.Event.Item'Class)
is
the_Event : constant gel.Events.my_new_sprite_added_to_world_Event
:= gel.events.my_new_sprite_added_to_world_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);
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_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);
end;
end respond;
procedure define (Self : in out my_new_sprite_Response; World : in gel.World.view;
Models : access id_Maps_of_model.Map)
procedure define (Self : in out my_new_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.Models := Models;
Self.World := World;
Self.graphics_Models := Models;
Self.physics_Models := physics_Models;
end define;
overriding
function Name (Self : in my_new_sprite_Response) return String
is
@@ -286,40 +339,52 @@ is
type graphics_Model_iface_view is access all openGL.remote_Model.item'Class;
type physics_Model_iface_view is access all Standard.physics.remote.Model.item'Class;
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;
procedure is_a_Mirror (Self : access Item'Class; of_World : in remote.World.view)
is
begin
the_new_model_Response.World := Self.all'Access;
-- New graphics model response.
--
the_new_graphics_model_Response.World := Self.all'Access;
Self.add (the_new_model_Response'Access,
to_Kind (remote.World.new_model_Event'Tag),
of_World.Name);
Self.add (the_new_graphics_model_Response'Access,
to_Kind (remote.World.new_graphics_model_Event'Tag),
from_Subject => of_World.Name);
define (the_my_new_sprite_Response, World => Self.all'Access,
Models => Self.graphics_Models'Access);
-- New physics model response.
--
the_new_physics_model_Response.World := Self.all'Access;
Self.add (the_new_physics_model_Response'Access,
to_Kind (remote.World.new_physics_model_Event'Tag),
from_Subject => of_World.Name);
-- New sprite response.
--
define (the_my_new_sprite_Response, World => Self.all'Access,
Models => Self.graphics_Models'Access,
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),
of_World.Name);
from_Subject => of_World.Name);
-- Obtain and make a local copy of models, sprites and humans from the mirrored world.
-- Obtain and make a local copy of graphics_Models, sprites and humans from the mirrored world.
--
declare
use remote.World.id_Maps_of_model_plan;
use remote.World.id_Maps_of_graphics_model;
the_server_Models : constant remote.World.graphics_Model_Set := of_World.graphics_Models; -- Fetch graphics models from the server.
the_server_physics_Models : constant remote.World.physics_model_Set := of_World.physics_Models; -- Fetch physics models from the server.
the_server_graphics_Models : constant remote.World.id_Map_of_graphics_model := of_World.graphics_Models; -- Fetch graphics graphics_Models from the server.
the_server_physics_Models : constant remote.World. id_Map_of_physics_model := of_World. physics_Models; -- Fetch physics graphics_Models from the server.
begin
-- Create our local graphics models.
-- Create our local graphics graphics_Models.
--
declare
Cursor : remote.World.Id_Maps_of_Model_Plan.Cursor := the_server_Models.First;
Cursor : remote.World.id_Maps_of_graphics_model.Cursor := the_server_graphics_Models.First;
new_Model : graphics_Model_iFace_view;
begin
while has_Element (Cursor)
@@ -331,12 +396,12 @@ is
end loop;
end;
-- Create our local physics models.
-- Create our local physics graphics_Models.
--
declare
use remote.World.id_Maps_of_physics_model_plan;
use remote.World.id_Maps_of_physics_model;
Cursor : remote.World.id_Maps_of_physics_model_plan.Cursor := the_server_physics_Models.First;
Cursor : remote.World.id_Maps_of_physics_model.Cursor := the_server_physics_Models.First;
new_Model : physics_Model_iFace_view;
begin

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

@@ -90,10 +90,10 @@ is
function to_Sprite (the_Pair : in remote.World.sprite_model_Pair;
the_Models : in Id_Maps_of_Model .Map;
the_physics_Models : in Id_Maps_of_physics_Model.Map;
the_World : in gel.World.view) return gel.Sprite.view
function to_Sprite (the_Pair : in remote.World.sprite_model_Pair;
the_graphics_Models : in Id_Maps_of_graphics_Model.Map;
the_physics_Models : in Id_Maps_of_physics_Model .Map;
the_World : in gel.World.view) return gel.Sprite.view
is
the_graphics_Model : access openGL .Model.item'Class;
the_physics_Model : access physics.Model.item'Class;
@@ -101,7 +101,7 @@ is
use openGL;
begin
the_graphics_Model := openGL .Model.view (the_Models .Element (the_Pair.graphics_Model_Id));
the_graphics_Model := openGL .Model.view (the_graphics_Models .Element (the_Pair.graphics_Model_Id));
the_physics_Model := physics.Model.view (the_physics_Models.Element (the_Pair. physics_Model_Id));
the_Sprite := gel.Sprite.forge.new_Sprite ("Sprite" & the_Pair.sprite_Id'Image,
@@ -278,8 +278,9 @@ is
begin
Self.Clients.append (the_Mirror);
Self.register (Mirror_as_observer, to_Kind (remote.World. new_model_Event'Tag));
Self.register (Mirror_as_observer, to_Kind (gel.events. new_sprite_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 (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));
end register;

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

@@ -85,10 +85,10 @@ is
function to_Sprite (the_Pair : in remote.World.sprite_model_Pair;
the_Models : in Id_Maps_of_Model .Map;
the_physics_Models : in Id_Maps_of_physics_Model.Map;
the_World : in gel.World.view) return gel.Sprite.view
function to_Sprite (the_Pair : in remote.World.sprite_model_Pair;
the_graphics_Models : in id_Maps_of_graphics_model .Map;
the_physics_Models : in Id_Maps_of_physics_Model.Map;
the_World : in gel.World.view) return gel.Sprite.view
is
the_graphics_Model : access openGL .Model.item'Class;
the_physics_Model : access physics.Model.item'Class;
@@ -96,8 +96,8 @@ is
use openGL;
begin
the_graphics_Model := openGL .Model.view (the_Models .Element (the_Pair.graphics_Model_Id));
the_physics_Model := physics.Model.view (the_physics_Models.Element (the_Pair. physics_Model_Id));
the_graphics_Model := openGL .Model.view (the_graphics_Models.Element (the_Pair.graphics_Model_Id));
the_physics_Model := physics.Model.view ( the_physics_Models.Element (the_Pair. physics_Model_Id));
the_Sprite := gel.Sprite.forge.new_Sprite ("Sprite" & the_Pair.sprite_Id'Image,
sprite.World_view (the_World),
@@ -120,15 +120,16 @@ is
end to_Sprite;
--------------------------------
--- 'create_new_Sprite' Response
--
type create_new_Sprite is new lace.Response.item with
record
World : gel.World.view;
Models : access id_Maps_of_model .Map;
physics_Models : access id_Maps_of_physics_model.Map;
World : gel.World.view;
graphics_Models : access id_Maps_of_graphics_model.Map;
physics_Models : access id_Maps_of_physics_model .Map;
end record;
@@ -144,8 +145,8 @@ is
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.graphics_Models.all,
Self. physics_Models.all,
Self.World);
begin
Self.World.add (the_Sprite, and_children => False);
@@ -154,12 +155,12 @@ is
procedure define (Self : in out create_new_Sprite; World : in gel.World.view;
Models : access id_Maps_of_model.Map)
procedure define (Self : in out create_new_Sprite; World : in gel.World.view;
graphics_Models : access id_Maps_of_graphics_model.Map)
is
begin
Self.World := World;
Self.Models := Models;
Self.World := World;
Self.graphics_Models := graphics_Models;
end define;
@@ -177,10 +178,10 @@ is
--- Define
--
procedure define (Self : in out Item'Class; Name : in String;
Id : in world_Id;
space_Kind : in physics.space_Kind;
Renderer : access openGL.Renderer.lean.Item'Class)
procedure define (Self : in out Item'Class; Name : in String;
Id : in world_Id;
space_Kind : in physics.space_Kind;
Renderer : access openGL.Renderer.lean.Item'Class)
is
use lace.Subject_and_deferred_Observer.Forge;
begin
@@ -343,7 +344,7 @@ is
function local_graphics_Models (Self : in Item) return id_Maps_of_model.Map
function local_graphics_Models (Self : in Item) return id_Maps_of_graphics_model.Map
is
begin
return Self.graphics_Models;
@@ -760,6 +761,9 @@ is
procedure add (Self : in out Item; the_Model : in openGL.Model.view)
is
begin
log ("gel.World.add (the opengl Model) ~ the_Model.Id:" & the_Model.Id'Image);
if the_Model.Id = null_graphics_model_Id
then
Self.last_used_model_Id := Self.last_used_model_Id + 1;
@@ -772,8 +776,9 @@ is
-- Emit a new model event.
--
log ("gel.World.add ~ emit new graphics model event");
declare
the_Event : remote.World.new_model_Event;
the_Event : remote.World.new_graphics_model_Event;
begin
the_Event.Model := the_Model;
Self.emit (the_Event);
@@ -795,6 +800,16 @@ is
if not Self.physics_Models.contains (the_Model.Id)
then
Self.physics_Models.insert (the_Model.Id, the_Model);
-- Emit a new model event.
--
log ("gel.World.add ~ emit new physics model event");
declare
the_Event : remote.World.new_physics_model_Event;
begin
the_Event.Model := the_Model;
Self.emit (the_Event);
end;
end if;
end add;
@@ -948,12 +963,12 @@ is
overriding
function graphics_Models (Self : in Item) return remote.World.graphics_Model_Set
function graphics_Models (Self : in Item) return remote.World.id_Map_of_graphics_model
is
use id_Maps_of_model;
use id_Maps_of_graphics_model;
the_Models : remote.World.graphics_Model_Set;
Cursor : id_Maps_of_model.Cursor := Self.graphics_Models.First;
the_Models : remote.World.id_Map_of_graphics_model;
Cursor : id_Maps_of_graphics_model.Cursor := Self.graphics_Models.First;
begin
while has_Element (Cursor)
loop
@@ -968,11 +983,11 @@ is
overriding
function physics_Models (Self : in Item) return remote.World.physics_model_Set
function physics_Models (Self : in Item) return remote.World.id_Map_of_physics_model
is
use id_Maps_of_physics_model;
the_Models : remote.World.physics_model_Set;
the_Models : remote.World.id_Map_of_physics_model;
Cursor : id_Maps_of_physics_model.Cursor := Self.physics_Models.First;
begin
while has_Element (Cursor)
@@ -1118,7 +1133,8 @@ is
is
the_Sprite : constant gel.Sprite.view := Item'Class (Self).all_Sprites.fetch.Element (sprite_Id);
begin
the_Sprite.Speed_is ([0.0, 10.0, 0.0]);
log ("KICK");
the_Sprite.Speed_is ([0.0, 0.1, 0.0]);
end kick_Sprite;
@@ -1170,8 +1186,8 @@ end gel.World;
-- procedure free_graphics_Models
-- is
-- use id_Maps_of_model;
-- Cursor : id_Maps_of_model.Cursor := the_World.graphics_Models.First;
-- use id_Maps_of_graphics_model;
-- Cursor : id_Maps_of_graphics_model.Cursor := the_World.graphics_Models.First;
-- begin
-- while has_Element (Cursor)
-- loop

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

@@ -244,9 +244,9 @@ is
overriding
function graphics_Models (Self : in Item) return remote.World.graphics_Model_Set;
function graphics_Models (Self : in Item) return remote.World.id_Map_of_graphics_model;
overriding
function physics_Models (Self : in Item) return remote.World.physics_Model_Set;
function physics_Models (Self : in Item) return remote.World.id_Map_of_physics_model;
overriding
function Sprites (Self : in out Item) return remote.World.sprite_model_Pairs;
@@ -259,11 +259,11 @@ is
--
use type openGL.Model.view;
use type gel.graphics_model_Id;
function Hash is new ada.unchecked_Conversion (gel.graphics_model_Id, ada.Containers.Hash_type);
package id_Maps_of_model is new ada.Containers.hashed_Maps (gel.graphics_model_Id, openGL.Model.view,
Hash, "=");
function Hash is new ada.unchecked_Conversion (gel.graphics_model_Id, ada.Containers.Hash_type);
package id_Maps_of_graphics_model is new ada.Containers.hashed_Maps (gel.graphics_model_Id, openGL.Model.view,
Hash, "=");
function local_graphics_Models (Self : in Item) return id_Maps_of_model.Map;
function local_graphics_Models (Self : in Item) return id_Maps_of_graphics_model.Map;
-- Physics Models
@@ -401,7 +401,7 @@ private
-- Models
--
graphics_Models : aliased id_Maps_of_model .Map;
graphics_Models : aliased id_Maps_of_graphics_model .Map;
physics_Models : aliased id_Maps_of_physics_model.Map;
-- Ids