250 lines
8.1 KiB
Ada
250 lines
8.1 KiB
Ada
with
|
|
gel.remote.World,
|
|
gel.World,
|
|
gel.Camera,
|
|
gel.Keyboard,
|
|
gel.Mouse,
|
|
gel.Sprite,
|
|
gel.Dolly,
|
|
gel.Window,
|
|
|
|
openGL.Renderer.lean,
|
|
openGL.Font,
|
|
|
|
lace.Event,
|
|
lace.Response,
|
|
lace.Subject,
|
|
lace.Observer,
|
|
lace.Subject_and_deferred_Observer,
|
|
|
|
ada.Containers.Vectors;
|
|
|
|
|
|
package gel.Applet
|
|
--
|
|
-- Provides an application model, configured with a single window.
|
|
--
|
|
is
|
|
type Item is limited new lace.Subject_and_deferred_Observer.item with private;
|
|
type View is access all Item'Class;
|
|
|
|
|
|
----------
|
|
--- Forge
|
|
--
|
|
|
|
package Forge
|
|
is
|
|
function to_Applet (Name : in String;
|
|
use_Window : in gel.Window.view) return Item;
|
|
|
|
function new_Applet (Name : in String;
|
|
use_Window : in gel.Window.view) return View;
|
|
end Forge;
|
|
|
|
overriding
|
|
procedure destroy (Self : in out Item);
|
|
procedure free (Self : in out View);
|
|
|
|
|
|
---------------
|
|
--- Attributes
|
|
--
|
|
|
|
function is_Open (Self : in Item) return Boolean;
|
|
|
|
function Window (Self : in Item) return gel.Window.view;
|
|
function Renderer (Self : in Item) return openGL.Renderer.lean.view;
|
|
function Keyboard (Self : in Item) return access gel.Keyboard.item'Class;
|
|
function Mouse (Self : in Item) return access gel.Mouse .item'Class;
|
|
function Dolly (Self : access Item) return gel.Dolly.view;
|
|
|
|
function last_Keypress (Self : access Item) return gel.Keyboard.Key;
|
|
|
|
|
|
function world_Count (Self : in Item) return Natural;
|
|
function Worlds (Self : in Item) return gel.World.views;
|
|
function World (Self : in Item; Id : in world_Id := 1) return gel.World.view;
|
|
function World_as_iFace (Self : in Item; Id : in world_Id := 1) return gel.remote.World.view;
|
|
|
|
function Camera (Self : in Item; world_Id : in gel.world_Id := 1;
|
|
camera_Id : in gel.camera_Id := 1) return gel.Camera.view;
|
|
|
|
function Font (Self : in Item) return opengl.Font.font_Id;
|
|
function titles_Font (Self : in Item) return opengl.Font.font_Id;
|
|
|
|
|
|
---------------------------------
|
|
--- Add a new world and camera(s)
|
|
--
|
|
|
|
use type gel.Camera.view;
|
|
package camera_Vectors is new ada.Containers.Vectors (Positive, gel.Camera.view);
|
|
subtype camera_Vector is camera_Vectors.Vector;
|
|
|
|
type world_Info is
|
|
record
|
|
World : gel.World.view;
|
|
Cameras : camera_Vector;
|
|
end record;
|
|
|
|
type world_Info_view is access all world_Info;
|
|
|
|
procedure add (Self : in out Item; the_World : in world_Info_view);
|
|
|
|
procedure add_new_World (Self : in out Item; Name : in String;
|
|
space_Kind : in physics.space_Kind);
|
|
|
|
function new_World (Self : access Item; Name : in String;
|
|
space_Kind : in physics.space_Kind) return gel.World.view;
|
|
|
|
---------------
|
|
--- Operations
|
|
--
|
|
|
|
use Math;
|
|
|
|
procedure evolve_all_Worlds (Self : in out Item; By : in Duration);
|
|
|
|
procedure add (Self : in out Item; the_Sprite : in gel.Sprite.view);
|
|
procedure add (Self : in out Item; the_Sprite : in gel.Sprite.view;
|
|
at_site : in Vector_3);
|
|
|
|
procedure Dolly_is (Self : access Item; Now : in gel.Dolly.view);
|
|
procedure enable_simple_Dolly (Self : access Item; in_World : in world_Id);
|
|
procedure enable_following_Dolly (Self : access Item; Follow : in gel.Sprite.view);
|
|
|
|
procedure enable_Mouse (Self : access Item; detect_Motion : in Boolean);
|
|
|
|
procedure prepare (Self : access Item) is null;
|
|
procedure freshen (Self : in out Item; evolve_World : in Boolean := True);
|
|
--
|
|
-- processes window events and then redraws the window.
|
|
|
|
procedure take_Screenshot (Self : in out Item; Filename : in String);
|
|
procedure request_Quit (Self : in out Item);
|
|
|
|
----------
|
|
--- Events
|
|
--
|
|
|
|
function local_Subject_and_Observer
|
|
(Self : access Item) return lace.Subject_and_deferred_Observer.view;
|
|
function local_Subject (Self : access Item) return lace.Subject.view;
|
|
function local_Observer (Self : access Item) return lace.Observer.view;
|
|
|
|
|
|
|
|
private
|
|
|
|
pragma Suppress (Container_Checks); -- Suppress expensive tamper checks.
|
|
|
|
use type Sprite.view;
|
|
package sprite_Vectors is new ada.containers.Vectors (Positive, Sprite.view);
|
|
|
|
|
|
-------------------
|
|
--- Event Responses
|
|
--
|
|
|
|
type applet_event_Response is abstract new lace.Response.item with
|
|
record
|
|
Applet : gel.Applet.view;
|
|
end record;
|
|
|
|
|
|
-- 'add_new_Sprite' Response
|
|
--
|
|
|
|
type add_new_Sprite is new applet_event_Response with null record;
|
|
|
|
overriding
|
|
function Name (Self : in add_new_Sprite) return String;
|
|
overriding
|
|
procedure respond (Self : in out add_new_Sprite; to_Event : in lace.Event.item'Class);
|
|
|
|
the_add_new_sprite_Response : aliased add_new_Sprite;
|
|
|
|
|
|
-- 'Keyboard' Responses
|
|
--
|
|
type key_press_Response is new applet_event_Response with null record;
|
|
overriding
|
|
procedure respond (Self : in out key_press_Response; to_Event : in lace.Event.item'Class);
|
|
|
|
|
|
type key_release_Response is new applet_event_Response with null record;
|
|
overriding
|
|
procedure respond (Self : in out key_release_Response; to_Event : in lace.Event.item'Class);
|
|
|
|
|
|
-- 'Mouse' Responses
|
|
--
|
|
type button_press_Response is new applet_event_Response with null record;
|
|
overriding
|
|
procedure respond (Self : in out button_press_Response; to_Event : in lace.Event.item'Class);
|
|
|
|
type button_release_Response is new applet_event_Response with null record;
|
|
overriding
|
|
procedure respond (Self : in out button_release_Response; to_Event : in lace.Event.item'Class);
|
|
|
|
|
|
type mouse_motion_Response is new applet_event_Response with null record;
|
|
overriding
|
|
procedure respond (Self : in out mouse_motion_Response; to_Event : in lace.Event.item'Class);
|
|
|
|
|
|
-- 'Screen' Resize Response
|
|
--
|
|
type resize_event_Response is new applet_event_Response with null record;
|
|
overriding
|
|
procedure respond (Self : in out resize_event_Response; to_Event : in lace.Event.Item'Class);
|
|
|
|
|
|
|
|
----------------
|
|
--- world_Vector
|
|
--
|
|
use type gel.World.view;
|
|
package world_Vectors is new ada.Containers.Vectors (Positive, world_Info_view);
|
|
subtype world_Vector is world_Vectors.Vector;
|
|
|
|
|
|
--------------
|
|
-- Applet Item
|
|
--
|
|
type Item is limited new lace.Subject_and_deferred_Observer.item with
|
|
record
|
|
local_Subject_and_Observer : lace.Subject_and_deferred_Observer.view := new lace.Subject_and_deferred_Observer.item;
|
|
|
|
Worlds : World_Vector;
|
|
|
|
Window : gel.Window.view;
|
|
resize_Response : aliased applet.resize_event_Response;
|
|
|
|
Keyboard : access gel.Keyboard.item'Class;
|
|
key_press_Response : aliased applet.key_press_Response;
|
|
key_release_Response : aliased applet.key_release_Response;
|
|
|
|
Mouse : access gel.Mouse.item'Class;
|
|
button_press_Response : aliased applet.button_press_Response;
|
|
button_release_Response : aliased applet.button_release_Response;
|
|
mouse_motion_Response : aliased applet.mouse_motion_Response;
|
|
|
|
Renderer : openGL.Renderer.lean.view;
|
|
Font : opengl.Font.font_Id := (openGL.to_Asset ("assets/opengl/font/LiberationMono-Regular.ttf"), 30);
|
|
titles_Font : opengl.Font.font_Id := (openGL.to_Asset ("assets/opengl/font/LiberationMono-Regular.ttf"), 40);
|
|
is_capturing_Video : Boolean := False;
|
|
Dolly : gel.Dolly.view;
|
|
|
|
last_pressed_Key : gel.Keyboard.Key := gel.Keyboard.Nil;
|
|
key_Focus : gel.Sprite.view;
|
|
|
|
quit_Requested : Boolean := False;
|
|
end record;
|
|
|
|
global_Window : gel.Window.view;
|
|
|
|
|
|
end gel.Applet;
|