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

Add initial prototype.

Browse Source
This commit is contained in:
Rod Kay
2022-07-31 17:34:54 +10:00
commit 54a53b2ac0
1421 changed files with 358874 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

84
4-high/gel/source/applet/distributed/gel-applet-client_world.adb Normal file
View File

@@ -0,0 +1,84 @@
with
gel.Events,
gel.Camera.forge,
lace.Event.utility,
ada.unchecked_Deallocation;
package body gel.Applet.client_world
is
procedure define (Self : in gel.Applet.client_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.client.forge.new_World (Name,
client_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.client_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 client_World (Self : in Item) return gel.World.client.view
is
begin
return gel.World.client.view (Self.World (client_world_Id));
end client_World;
function client_Camera (Self : in Item) return gel.Camera.view
is
begin
return Self.Camera (client_world_Id,
client_camera_Id);
end client_Camera;
end gel.Applet.client_world;

40
4-high/gel/source/applet/distributed/gel-applet-client_world.ads Normal file
View File

@@ -0,0 +1,40 @@
with
gel.World.client,
gel.Camera,
gel.Window;
package gel.Applet.client_world
--
-- Provides a gel applet configured with a single window and a single client world.
--
is
type Item is new gel.Applet.item with private;
type View is access all Item'Class;
package Forge
is
function new_Applet (Name : in String;
use_Window : in gel.Window.view;
space_Kind : in physics.space_Kind) return gel.Applet.client_world.view;
end Forge;
procedure free (Self : in out View);
client_world_Id : constant world_Id := 1;
client_camera_Id : constant camera_Id := 1;
function client_World (Self : in Item) return gel.World.client.view;
function client_Camera (Self : in Item) return gel.Camera .view;
private
type Item is new gel.Applet.item with
record
null;
end record;
end gel.Applet.client_world;

84
4-high/gel/source/applet/distributed/gel-applet-server_world.adb Normal file
View File

@@ -0,0 +1,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;

41
4-high/gel/source/applet/distributed/gel-applet-server_world.ads Normal file
View File

@@ -0,0 +1,41 @@
with
gel.Camera,
gel.World.server,
gel.Window;
package gel.Applet.server_world
--
-- Provides a gel applet configured with a single window and a single server world.
--
is
type Item is new gel.Applet.item with private;
type View is access all Item'Class;
package 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;
end Forge;
procedure free (Self : in out View);
server_world_Id : constant world_Id := 1;
server_camera_Id : constant camera_Id := 1;
function server_World (Self : in Item) return gel.World.server.view;
function server_Camera (Self : in Item) return gel.Camera.view;
private
type Item is new gel.Applet.item with
record
null;
end record;
end gel.Applet.server_world;