lace_gel_0.1.0_2c333035/source/applet/distributed/gel-applet-server_world.adb

 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
with
     gel.Events,
     gel.Camera.forge,
     lace.Event.utility,
     ada.unchecked_Deallocation;


package body gel.Applet.server_world
is

   procedure define (Self : in gel.Applet.server_world.view;   Name       : in String;
                                                               space_Kind : in physics.space_Kind)
   is
      use lace.Event.utility;

      the_world_Info : constant world_Info_view  := new world_Info;
      the_Camera     : constant gel.Camera.View  := gel.Camera.forge.new_Camera;
   begin
      the_world_Info.World := gel.World.server.forge.new_World (Name,
                                                                server_world_Id,
                                                                space_Kind,
                                                                Self.Renderer).all'Access;

      the_Camera.Viewport_is (Self.Window.Width, Self.Window.Height);
      the_Camera.Renderer_is (Self.Renderer);
      the_Camera.Site_is     ((0.0, 5.0, 50.0));

      the_world_Info.Cameras.append (the_Camera);

      Self.Worlds.append (the_world_Info);

      Self.local_Subject_and_Observer.add (the_add_new_sprite_Response'Access,
                                           to_Kind (gel.events.new_sprite_added_to_world_Event'Tag),
                                           the_world_Info.World.Name);
      the_world_Info.World.start;
   end define;



   package body Forge
   is

      function new_Applet (Name       : in String;
                           use_Window : in gel.Window.view;
                           space_Kind : in physics.space_Kind) return gel.Applet.server_world.view
      is
         Self : constant View := new Item' (gel.Applet.Forge.to_Applet (Name, use_Window)
                                            with null record);
      begin
         define (Self, Name, space_Kind);
         return Self;
      end new_Applet;

   end Forge;



   procedure free (Self : in out View)
   is
      procedure deallocate is new ada.unchecked_Deallocation (Item'Class, View);
   begin
      Self.destroy;
      deallocate (Self);
   end free;



   function server_World (Self : in Item) return gel.World.server.view
   is
   begin
      return gel.World.server.view (Self.World (server_world_Id));
   end server_World;



   function server_Camera (Self : in Item) return gel.Camera.view
   is
   begin
      return Self.Camera ( server_world_Id,
                          server_camera_Id);
   end server_Camera;


end gel.Applet.server_world;