lace_gel_0.1.0_2c333035/source/world/gel-world-server.ads

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
with
     gel.World,
     lace.Observer,
     ada.unchecked_Conversion,
     ada.Containers.Vectors;

limited
with
     openGL.Renderer.lean;


package gel.World.server
--
--  Provides a gel world server.
--
is
   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);

   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;
      end record;


   overriding
   function all_Sprites (Self : access Item) return access World.sprite_Map'Class;


end gel.World.server;