168 lines
5.1 KiB
Ada
168 lines
5.1 KiB
Ada
with
|
|
physics.Space,
|
|
physics.Joint,
|
|
physics.Object,
|
|
|
|
lace.Observer,
|
|
lace.Any,
|
|
ada.Tags;
|
|
|
|
|
|
package physics.Engine
|
|
--
|
|
-- Provides a task which evolves a physical space.
|
|
--
|
|
is
|
|
type Item is tagged limited private;
|
|
type View is access all Item'Class;
|
|
|
|
-- procedure start (Self : access Item; space_Kind : in physics.space_Kind);
|
|
procedure start (Self : access Item; the_Space : in Space.view);
|
|
procedure stop (Self : access Item);
|
|
|
|
procedure add (Self : access Item; the_Object : in Object.view);
|
|
procedure rid (Self : in out Item; the_Object : in Object.view);
|
|
|
|
procedure add (Self : in out Item; the_Joint : in Joint.view);
|
|
procedure rid (Self : in out Item; the_Joint : in Joint.view);
|
|
|
|
procedure update_Scale (Self : in out Item; of_Object : in Object.view;
|
|
To : in math.Vector_3);
|
|
|
|
procedure apply_Force (Self : in out Item; to_Object : in Object.view;
|
|
Force : in math.Vector_3);
|
|
|
|
procedure update_Site (Self : in out Item; of_Object : in Object.view;
|
|
To : in math.Vector_3);
|
|
|
|
procedure set_Speed (Self : in out Item; of_Object : in Object.view;
|
|
To : in math.Vector_3);
|
|
|
|
procedure set_Gravity (Self : in out Item; To : in math.Vector_3);
|
|
|
|
procedure set_xy_Spin (Self : in out Item; of_Object : in Object.view;
|
|
To : in math.Radians);
|
|
|
|
procedure update_Bounds (Self : in out Item; of_Object : in Object.view);
|
|
|
|
procedure set_local_Anchor (Self : in out Item; for_Joint : in Joint.view;
|
|
To : in math.Vector_3;
|
|
is_Anchor_A : in Boolean);
|
|
|
|
|
|
private
|
|
|
|
task
|
|
type Evolver (Self : access Engine.item'Class)
|
|
is
|
|
-- entry start (space_Kind : in physics.space_Kind);
|
|
entry start (the_Space : in Space.view);
|
|
entry stop;
|
|
|
|
entry reset_Age;
|
|
|
|
pragma Storage_Size (20_000_000);
|
|
end Evolver;
|
|
|
|
|
|
-- Engine Commands
|
|
--
|
|
type Any_limited_view is access all lace.Any.limited_item'Class;
|
|
|
|
type command_Kind is (add_Object, rid_Object,
|
|
scale_Object, destroy_Object,
|
|
update_Bounds, update_Site,
|
|
set_Speed, apply_Force,
|
|
set_xy_Spin,
|
|
add_Joint, rid_Joint,
|
|
set_Joint_local_Anchor,
|
|
free_Joint,
|
|
cast_Ray,
|
|
-- new_impact_Response,
|
|
set_Gravity);
|
|
|
|
type Command (Kind : command_Kind := command_Kind'First) is
|
|
record
|
|
Object : physics.Object.view;
|
|
|
|
case Kind
|
|
is
|
|
when add_Object =>
|
|
add_Children : Boolean;
|
|
-- Model : physics.Model.view;
|
|
|
|
when rid_Object =>
|
|
rid_Children : Boolean;
|
|
|
|
when update_Site =>
|
|
Site : math.Vector_3;
|
|
|
|
when scale_Object =>
|
|
Scale : math.Vector_3;
|
|
|
|
when apply_Force =>
|
|
Force : math.Vector_3;
|
|
|
|
when set_Speed =>
|
|
Speed : math.Vector_3;
|
|
|
|
when set_Gravity =>
|
|
Gravity : math.Vector_3;
|
|
|
|
when set_xy_Spin =>
|
|
xy_Spin : math.Radians;
|
|
|
|
when add_Joint | rid_Joint | free_Joint =>
|
|
Joint : physics.Joint.view;
|
|
|
|
when set_Joint_local_Anchor =>
|
|
anchor_Joint : physics.Joint.view;
|
|
is_Anchor_A : Boolean; -- When false, is anchor B.
|
|
local_Anchor : math.Vector_3;
|
|
|
|
when cast_Ray =>
|
|
From, To : math.Vector_3;
|
|
Observer : lace.Observer.view;
|
|
Context : Any_limited_view;
|
|
event_Kind : ada.Tags.Tag;
|
|
|
|
-- when new_impact_Response =>
|
|
-- Filter : impact_Filter;
|
|
-- Response : impact_Response;
|
|
|
|
when others =>
|
|
null;
|
|
end case;
|
|
end record;
|
|
|
|
type Commands is array (Positive range 1 .. 200_000) of Command;
|
|
|
|
|
|
protected
|
|
type safe_command_Set
|
|
is
|
|
function is_Empty return Boolean;
|
|
|
|
procedure add (the_Command : in Command);
|
|
procedure Fetch (To : out Commands;
|
|
Count : out Natural);
|
|
private
|
|
Set : Commands;
|
|
the_Count : Natural := 0;
|
|
end safe_command_Set;
|
|
|
|
type safe_command_Set_view is access all safe_command_Set;
|
|
|
|
|
|
type Item is tagged limited
|
|
record
|
|
Age : Duration := 0.0;
|
|
|
|
Space : physics.Space.view;
|
|
Commands : safe_command_Set_view := new safe_command_Set;
|
|
Evolver : engine.Evolver (Item'Access);
|
|
end record;
|
|
|
|
|
|
end physics.Engine;
|