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; use lace.Event.utility;
procedure log (Message : in String := "")
renames ada.Text_IO.put_Line;
procedure my_context_Setter procedure my_context_Setter
is is
begin begin
@@ -56,6 +61,7 @@ is
the_Sprite : gel.Sprite.view; the_Sprite : gel.Sprite.view;
begin 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 := Self.Applet.World (the_Event.World_Id).fetch_Sprite (the_event.Sprite_Id);
the_Sprite.is_Visible (True); 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) procedure Speed_is (Self : in out Item; Now : in Vector_3)
is is
begin 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; 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; 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 is
begin begin
openGL.remote_Model.item'Class'Output (Stream, openGL.remote_Model.item'Class'Output (Stream,
@@ -174,7 +174,7 @@ is
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_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));

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

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

@@ -22,7 +22,6 @@ is
procedure log (Message : in String) procedure log (Message : in String)
renames ada.text_IO.put_Line; renames ada.text_IO.put_Line;
pragma Unreferenced (log);
--------- ---------
@@ -93,8 +92,8 @@ is
function to_Sprite (the_Pair : in remote.World.sprite_model_Pair; function to_Sprite (the_Pair : in remote.World.sprite_model_Pair;
the_Models : in Id_Maps_of_Model .Map; the_graphics_Models : in id_Maps_of_graphics_model.Map;
the_physics_Models : in Id_Maps_of_physics_Model.Map; the_physics_Models : in Id_Maps_of_physics_Model .Map;
the_World : in gel.World.view) return gel.Sprite.view the_World : in gel.World.view) return gel.Sprite.view
is is
the_graphics_Model : access openGL .Model.item'Class; the_graphics_Model : access openGL .Model.item'Class;
@@ -103,8 +102,13 @@ is
use openGL; use openGL;
begin begin
the_graphics_Model := openGL .Model.view (the_Models .Element (the_Pair.graphics_Model_Id)); log ("gel.world.client.to_Sprite ~ the_Pair.graphics_Model_Id:" & the_Pair.graphics_Model_Id'Image);
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));
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, the_Sprite := gel.Sprite.forge.new_Sprite ("Sprite" & the_Pair.sprite_Id'Image,
sprite.World_view (the_World), sprite.World_view (the_World),
@@ -140,7 +144,7 @@ is
type create_new_Sprite is new lace.Response.item with type create_new_Sprite is new lace.Response.item with
record record
World : gel.World.view; 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; physics_Models : access id_Maps_of_physics_model.Map;
end record; 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 record
World : gel.World.view; World : gel.World.view;
end record; end record;
overriding overriding
function Name (Self : in new_model_Response) return String; function Name (Self : in new_graphics_model_Response) return String;
overriding 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 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 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))); Self.World.add (new openGL.Model.item'Class' (openGL.Model.item'Class (the_Event.Model.all)));
end respond; end respond;
overriding overriding
function Name (Self : in new_model_Response) return String function Name (Self : in new_graphics_model_Response) return String
is is
pragma unreferenced (Self); pragma unreferenced (Self);
begin begin
return "new_model_Response"; return "new_graphics_model_Response";
end Name; 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 --- my_new_sprite_Response
-- --
type my_new_sprite_Response is new lace.Response.item with type my_new_sprite_Response is new lace.Response.item with
record record
World : gel.World.view; World : gel.World.view;
Models : access id_Maps_of_model .Map; graphics_Models : access id_Maps_of_graphics_model.Map;
physics_Models : access id_Maps_of_physics_model.Map; physics_Models : access id_Maps_of_physics_model .Map;
end record; end record;
@@ -251,29 +295,38 @@ is
overriding overriding
procedure respond (Self : in out my_new_sprite_Response; to_Event : in lace.Event.Item'Class) procedure respond (Self : in out my_new_sprite_Response; to_Event : in lace.Event.Item'Class)
is is
begin
log ("gel.world.client.my_new_Sprite.respond");
declare
the_Event : constant gel.Events.my_new_sprite_added_to_world_Event the_Event : constant gel.Events.my_new_sprite_added_to_world_Event
:= gel.events.my_new_sprite_added_to_world_Event (to_Event); := gel.events.my_new_sprite_added_to_world_Event (to_Event);
the_Sprite : constant gel.Sprite.view the_Sprite : constant gel.Sprite.view
:= to_Sprite (the_Event.Pair, := to_Sprite (the_Event.Pair,
Self.Models.all, Self.graphics_Models.all,
Self.physics_Models.all, Self.physics_Models.all,
Self.World); Self.World);
begin begin
Self.World.add (the_Sprite); Self.World.add (the_Sprite);
end;
end respond; end respond;
procedure define (Self : in out my_new_sprite_Response; World : in gel.World.view; procedure define (Self : in out my_new_sprite_Response; World : in 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)
is is
begin begin
Self.World := World; Self.World := World;
Self.Models := Models; Self.graphics_Models := Models;
Self.physics_Models := physics_Models;
end define; end define;
overriding overriding
function Name (Self : in my_new_sprite_Response) return String function Name (Self : in my_new_sprite_Response) return String
is is
@@ -286,40 +339,52 @@ is
type graphics_Model_iface_view is access all openGL.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;
type physics_Model_iface_view is access all Standard.physics.remote.Model.item'Class;
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)
is is
begin 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, Self.add (the_new_graphics_model_Response'Access,
to_Kind (remote.World.new_model_Event'Tag), to_Kind (remote.World.new_graphics_model_Event'Tag),
of_World.Name); from_Subject => of_World.Name);
-- 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, define (the_my_new_sprite_Response, World => Self.all'Access,
Models => Self.graphics_Models'Access); Models => Self.graphics_Models'Access,
physics_Models => Self. physics_Models'Access);
Self.add (the_my_new_sprite_Response'Access, Self.add (the_my_new_sprite_Response'Access,
to_Kind (gel.Events.my_new_sprite_added_to_world_Event'Tag), 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 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_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.physics_model_Set := of_World.physics_Models; -- Fetch physics 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 begin
-- Create our local graphics models. -- Create our local graphics graphics_Models.
-- --
declare 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; new_Model : graphics_Model_iFace_view;
begin begin
while has_Element (Cursor) while has_Element (Cursor)
@@ -331,12 +396,12 @@ is
end loop; end loop;
end; end;
-- Create our local physics models. -- Create our local physics graphics_Models.
-- --
declare 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; new_Model : physics_Model_iFace_view;
begin begin

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

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

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

@@ -86,7 +86,7 @@ is
function to_Sprite (the_Pair : in remote.World.sprite_model_Pair; function to_Sprite (the_Pair : in remote.World.sprite_model_Pair;
the_Models : in Id_Maps_of_Model .Map; the_graphics_Models : in id_Maps_of_graphics_model .Map;
the_physics_Models : in Id_Maps_of_physics_Model.Map; the_physics_Models : in Id_Maps_of_physics_Model.Map;
the_World : in gel.World.view) return gel.Sprite.view the_World : in gel.World.view) return gel.Sprite.view
is is
@@ -96,8 +96,8 @@ is
use openGL; use openGL;
begin 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_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, the_Sprite := gel.Sprite.forge.new_Sprite ("Sprite" & the_Pair.sprite_Id'Image,
sprite.World_view (the_World), sprite.World_view (the_World),
@@ -120,6 +120,7 @@ is
end to_Sprite; end to_Sprite;
-------------------------------- --------------------------------
--- 'create_new_Sprite' Response --- 'create_new_Sprite' Response
-- --
@@ -127,8 +128,8 @@ is
type create_new_Sprite is new lace.Response.item with type create_new_Sprite is new lace.Response.item with
record record
World : gel.World.view; World : gel.World.view;
Models : access id_Maps_of_model .Map; graphics_Models : access id_Maps_of_graphics_model.Map;
physics_Models : access id_Maps_of_physics_model.Map; physics_Models : access id_Maps_of_physics_model .Map;
end record; end record;
@@ -144,8 +145,8 @@ is
declare declare
the_Event : constant gel.Events.new_sprite_Event := gel.Events.new_sprite_Event (to_Event); 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, the_Sprite : constant gel.Sprite.view := to_Sprite (the_Event.Pair,
Self.Models.all, Self.graphics_Models.all,
Self.physics_Models.all, Self. physics_Models.all,
Self.World); Self.World);
begin begin
Self.World.add (the_Sprite, and_children => False); Self.World.add (the_Sprite, and_children => False);
@@ -155,11 +156,11 @@ is
procedure define (Self : in out create_new_Sprite; World : in gel.World.view; procedure define (Self : in out create_new_Sprite; World : in gel.World.view;
Models : access id_Maps_of_model.Map) graphics_Models : access id_Maps_of_graphics_model.Map)
is is
begin begin
Self.World := World; Self.World := World;
Self.Models := Models; Self.graphics_Models := graphics_Models;
end define; end define;
@@ -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 is
begin begin
return Self.graphics_Models; return Self.graphics_Models;
@@ -760,6 +761,9 @@ is
procedure add (Self : in out Item; the_Model : in openGL.Model.view) procedure add (Self : in out Item; the_Model : in openGL.Model.view)
is is
begin begin
log ("gel.World.add (the opengl Model) ~ the_Model.Id:" & the_Model.Id'Image);
if the_Model.Id = null_graphics_model_Id if the_Model.Id = null_graphics_model_Id
then then
Self.last_used_model_Id := Self.last_used_model_Id + 1; Self.last_used_model_Id := Self.last_used_model_Id + 1;
@@ -772,8 +776,9 @@ is
-- Emit a new model event. -- Emit a new model event.
-- --
log ("gel.World.add ~ emit new graphics model event");
declare declare
the_Event : remote.World.new_model_Event; the_Event : remote.World.new_graphics_model_Event;
begin begin
the_Event.Model := the_Model; the_Event.Model := the_Model;
Self.emit (the_Event); Self.emit (the_Event);
@@ -795,6 +800,16 @@ is
if not Self.physics_Models.contains (the_Model.Id) if not Self.physics_Models.contains (the_Model.Id)
then then
Self.physics_Models.insert (the_Model.Id, the_Model); 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 if;
end add; end add;
@@ -948,12 +963,12 @@ is
overriding 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 is
use id_Maps_of_model; use id_Maps_of_graphics_model;
the_Models : remote.World.graphics_Model_Set; the_Models : remote.World.id_Map_of_graphics_model;
Cursor : id_Maps_of_model.Cursor := Self.graphics_Models.First; Cursor : id_Maps_of_graphics_model.Cursor := Self.graphics_Models.First;
begin begin
while has_Element (Cursor) while has_Element (Cursor)
loop loop
@@ -968,11 +983,11 @@ is
overriding 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 is
use id_Maps_of_physics_model; 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; Cursor : id_Maps_of_physics_model.Cursor := Self.physics_Models.First;
begin begin
while has_Element (Cursor) while has_Element (Cursor)
@@ -1118,7 +1133,8 @@ is
is is
the_Sprite : constant gel.Sprite.view := Item'Class (Self).all_Sprites.fetch.Element (sprite_Id); the_Sprite : constant gel.Sprite.view := Item'Class (Self).all_Sprites.fetch.Element (sprite_Id);
begin 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; end kick_Sprite;
@@ -1170,8 +1186,8 @@ end gel.World;
-- procedure free_graphics_Models -- procedure free_graphics_Models
-- is -- is
-- use id_Maps_of_model; -- use id_Maps_of_graphics_model;
-- Cursor : id_Maps_of_model.Cursor := the_World.graphics_Models.First; -- Cursor : id_Maps_of_graphics_model.Cursor := the_World.graphics_Models.First;
-- begin -- begin
-- while has_Element (Cursor) -- while has_Element (Cursor)
-- loop -- loop

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

@@ -244,9 +244,9 @@ is
overriding 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 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 overriding
function Sprites (Self : in out Item) return remote.World.sprite_model_Pairs; function Sprites (Self : in out Item) return remote.World.sprite_model_Pairs;
@@ -260,10 +260,10 @@ is
use type openGL.Model.view; use type openGL.Model.view;
use type gel.graphics_model_Id; use type gel.graphics_model_Id;
function Hash is new ada.unchecked_Conversion (gel.graphics_model_Id, ada.Containers.Hash_type); 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, package id_Maps_of_graphics_model is new ada.Containers.hashed_Maps (gel.graphics_model_Id, openGL.Model.view,
Hash, "="); 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 -- Physics Models
@@ -401,7 +401,7 @@ private
-- Models -- 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; physics_Models : aliased id_Maps_of_physics_model.Map;
-- Ids -- Ids