Add initial prototype.

3-mid/physics/interface/source/physics-engine.ads

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