111 lines
2.7 KiB
Ada
111 lines
2.7 KiB
Ada
with
|
|
lace.Observer,
|
|
ada.Containers.Vectors;
|
|
|
|
limited
|
|
with
|
|
openGL.Renderer.lean;
|
|
|
|
|
|
package gel.World.server
|
|
--
|
|
-- Provides a gel world server.
|
|
--
|
|
is
|
|
pragma Suppress (Container_Checks); -- Suppress expensive tamper checks.
|
|
|
|
type Item is limited new gel.World.item
|
|
with private;
|
|
|
|
type View is access all Item'Class;
|
|
type Views is array (Positive range <>) of View;
|
|
|
|
|
|
---------
|
|
-- Forge
|
|
--
|
|
|
|
package Forge
|
|
is
|
|
function to_World (Name : in String;
|
|
Id : in world_Id;
|
|
space_Kind : in physics.space_Kind;
|
|
Renderer : access openGL.Renderer.lean.item'Class) return gel.World.server.item;
|
|
|
|
function new_World (Name : in String;
|
|
Id : in world_Id;
|
|
space_Kind : in physics.space_Kind;
|
|
Renderer : access openGL.Renderer.lean.item'Class) return gel.World.server.view;
|
|
end Forge;
|
|
|
|
overriding
|
|
procedure destroy (Self : in out Item);
|
|
procedure free (Self : in out View);
|
|
|
|
|
|
--------------
|
|
--- Operations
|
|
--
|
|
|
|
overriding
|
|
procedure register (Self : access Item; the_Mirror : in remote.World.view;
|
|
Mirror_as_observer : in lace.Observer.view);
|
|
overriding
|
|
procedure deregister (Self : access Item; the_Mirror : in remote.World.view;
|
|
Mirror_as_observer : in lace.Observer.view);
|
|
|
|
overriding
|
|
procedure evolve (Self : in out Item);
|
|
|
|
|
|
|
|
private
|
|
|
|
-----------
|
|
--- Clients
|
|
--
|
|
use type remote.World.view;
|
|
package world_Vectors is new ada.Containers.Vectors (Positive, remote.World.view);
|
|
subtype world_Vector is world_Vectors.Vector;
|
|
|
|
|
|
--------------
|
|
--- sprite_Map
|
|
--
|
|
type sprite_Map is limited new World.sprite_Map with
|
|
record
|
|
Map : id_Maps_of_sprite.Map;
|
|
end record;
|
|
|
|
overriding
|
|
function fetch (From : in sprite_Map) return id_Maps_of_sprite.Map;
|
|
|
|
overriding
|
|
procedure add (To : in out sprite_Map; the_Sprite : in Sprite.view);
|
|
|
|
overriding
|
|
procedure rid (From : in out sprite_Map; the_Sprite : in Sprite.view);
|
|
|
|
|
|
--------------
|
|
--- World Item
|
|
--
|
|
type Item is limited new gel.World.item with
|
|
record
|
|
Age_at_last_Clients_update : Duration := 0.0;
|
|
Clients : World_vector;
|
|
|
|
all_Sprites : aliased sprite_Map;
|
|
|
|
-- Motion Updates
|
|
--
|
|
seq_Id : remote.World.sequence_Id := 0;
|
|
end record;
|
|
|
|
|
|
overriding
|
|
function all_Sprites (Self : access Item) return access World.sprite_Map'Class;
|
|
|
|
|
|
end gel.World.server;
|