Add initial prototype.

3-mid/physics/interface/source/motor/physics-motor-spring-angular.adb

@@ -0,0 +1,266 @@
+with physics.Conversion,
+     math.Algebra.linear.d3;
+with physics.Vector_3;
+with Ada.Text_IO; use Ada.Text_IO;
+
+
+
+
+package body physics.Motor.spring.angular is
+
+
+   -- nb: based on PAL physics abstraction layer
+   --
+
+
+
+   procedure update (Self : in out Item)
+   is
+      use math.Algebra.linear.d3, physics.Conversion;
+   begin
+      --nb: this only applies to global position and orientation.
+
+      if self.is_Enabled then
+         -- find cross products of actual and desired forward, up,  and right vectors; these represent the orientation error.
+
+         declare
+            use math.real_Arrays, math.Algebra.linear;
+
+            transform     : math.Matrix_3x3 := +self.Rigid.Spin;
+
+            actualForward : math.Vector_3   := forward_Direction (transform);
+            actualUp      : math.Vector_3   := up_Direction      (transform);
+            actualRight   : math.Vector_3   := right_Direction   (transform);
+         begin
+            if Norm_squared (actualForward) /= 0.0 then   actualForward := normalised (actualForward);   end if;
+            if Norm_squared (actualUp)      /= 0.0 then   actualUp      := normalised (actualUp);        end if;
+            if Norm_squared (actualRight)   /= 0.0 then   actualRight   := normalised (actualRight);     end if;
+
+            declare
+               forwardError : math.Vector_3 :=  self.desiredForward * actualForward;
+               upError      : math.Vector_3 :=  self.desiredUp      * actualUp;
+               rightError   : math.Vector_3 :=  self.desiredRight   * actualRight;
+            begin
+               if Norm_squared (forwardError) /= 0.0 then   forwardError := normalised (forwardError);   end if;
+               if Norm_squared (upError)      /= 0.0 then   upError      := normalised (upError);        end if;
+               if Norm_squared (rightError)   /= 0.0 then   rightError   := normalised (rightError);     end if;
+
+               -- scale error vectors by the magnitude of the angles.
+               declare
+                  use Math;
+
+                  function to_Degrees (Self : in math.Vector_3) return math.Vector_3
+                  is
+                  begin
+                     return Self * (180.0 / Pi);
+--                       return Self;
+                  end;
+
+                  f_angle : math.Real := math.Real (to_Degrees (angle_between_preNorm (self.desiredForward, actualForward)));
+                  u_angle : math.Real := math.Real (to_Degrees (angle_between_preNorm (self.desiredUp,      actualUp)));
+                  r_angle : math.Real := math.Real (to_Degrees (angle_between_preNorm (self.desiredRight,   actualRight)));
+--                    f_angle : math.Real := math.Real ( -(angle_between_preNorm (self.desiredForward, actualForward)));
+--                    u_angle : math.Real := math.Real ( -(angle_between_preNorm (self.desiredUp,      actualUp)));
+--                    r_angle : math.Real := math.Real ( -(angle_between_preNorm (self.desiredRight,   actualRight)));
+               begin
+                  forwardError := forwardError * (-f_angle);
+                  upError      := upError      * (-u_angle);
+                  rightError   := rightError   * (-r_angle);
+
+--                    put_Line (math.Image (+self.Rigid.InvInertiaTensorWorld));
+
+                  declare  -- use the error vector to calculate torque.
+                     one_Third  : constant      := 1.0 / 3.0;
+                     error_Axis : math.Vector_3 := (forwardError + upError + rightError) * one_Third;   -- average the vectors into one.
+                     error_Term : math.Vector_3 := self.angularKs * error_Axis;
+                     vel_Term   : math.Vector_3 := self.angularKd * to_Degrees (+self.Rigid.Gyre);
+--                       the_Torque : math.Vector_3 := self.Rigid.inertia_Tensor * (error_Term - vel_Term);   -- scale the torque vector by the Rigid's inertia tensor.
+
+                     the_inv_Tensor : math.Matrix_3x3 := +self.Rigid.InvInertiaTensorWorld;
+                     the_Torque     : math.Vector_3   :=  (Inverse (the_inv_Tensor)) * (error_Term - vel_Term);   -- scale the torque vector by the Rigid's inertia tensor.
+--                       the_Torque     : math.Vector_3   := (error_Term - vel_Term) * Inverse (the_inv_Tensor);   -- scale the torque vector by the Rigid's inertia tensor.
+
+                     raw_Torque : aliased physics.Vector_3.item := +(20.0 * 256.0 * the_Torque * 180.0 / math.Pi);
+                  begin
+--                       put_Line ("applying torque");
+                     self.Rigid.apply_Torque (raw_Torque'unchecked_access);   -- tbd: check this 'scale' factor
+                  end;
+               end;
+            end;
+         end;
+
+      end if;
+
+   end;
+
+
+
+
+--     procedure update (Self : in out Item)
+--     is
+--        use math.Algebra.linear.d3, physics.Conversion;
+--     begin
+--        --nb: this only applies to global position and orientation.
+--
+--        if self.is_Enabled then
+--           -- find cross products of actual and desired forward, up,  and right vectors; these represent the orientation error.
+--
+--           declare
+--              use math.real_Arrays, math.Algebra.linear;
+--
+--              transform     : math.Matrix_3x3 := +self.Rigid.Spin;
+--
+--              actualForward : math.Vector_3   := forward_Direction (transform);
+--              actualUp      : math.Vector_3   := up_Direction      (transform);
+--              actualRight   : math.Vector_3   := right_Direction   (transform);
+--           begin
+--              if Norm_squared (actualForward) /= 0.0 then   actualForward := normalised (actualForward);   end if;
+--              if Norm_squared (actualUp)      /= 0.0 then   actualUp      := normalised (actualUp);        end if;
+--              if Norm_squared (actualRight)   /= 0.0 then   actualRight   := normalised (actualRight);     end if;
+--
+--              declare
+--                 forwardError : math.Vector_3 :=  self.desiredForward * actualForward;
+--                 upError      : math.Vector_3 :=  self.desiredUp      * actualUp;
+--                 rightError   : math.Vector_3 :=  self.desiredRight   * actualRight;
+--              begin
+--                 if Norm_squared (forwardError) /= 0.0 then   forwardError := normalised (forwardError);   end if;
+--                 if Norm_squared (upError)      /= 0.0 then   upError      := normalised (upError);        end if;
+--                 if Norm_squared (rightError)   /= 0.0 then   rightError   := normalised (rightError);     end if;
+--
+--                 -- scale error vectors by the magnitude of the angles.
+--                 declare
+--                    use Math;
+--
+--                    function to_Degrees (Self : in math.Vector_3) return math.Vector_3
+--                    is
+--                    begin
+--                       return Self * (180.0 / Pi);
+--  --                       return Self;
+--                    end;
+--
+--                    f_angle : math.Real := math.Real (to_Degrees (angle_between_preNorm (self.desiredForward, actualForward)));
+--                    u_angle : math.Real := math.Real (to_Degrees (angle_between_preNorm (self.desiredUp,      actualUp)));
+--                    r_angle : math.Real := math.Real (to_Degrees (angle_between_preNorm (self.desiredRight,   actualRight)));
+--                 begin
+--                    forwardError := forwardError * (-f_angle);
+--                    upError      := upError      * (-u_angle);
+--                    rightError   := rightError   * (-r_angle);
+--
+--  --                    put_Line (Image (+self.Rigid.InvInertiaTensorWorld));
+--
+--                    declare  -- use the error vector to calculate torque.
+--                       one_Third  : constant      := 1.0 / 3.0;
+--                       error_Axis : math.Vector_3 := (forwardError + upError + rightError) * one_Third;   -- average the vectors into one.
+--                       error_Term : math.Vector_3 := self.angularKs * error_Axis;
+--                       vel_Term   : math.Vector_3 := self.angularKd * to_Degrees (+self.Rigid.Gyre);
+--  --                       the_Torque : math.Vector_3 := self.Rigid.inertia_Tensor * (error_Term - vel_Term);   -- scale the torque vector by the Rigid's inertia tensor.
+--
+--                       the_inv_Tensor : math.Matrix_3x3 := +self.Rigid.InvInertiaTensorWorld;
+--                       the_Torque     : math.Vector_3   := Inverse (the_inv_Tensor) * (error_Term - vel_Term);   -- scale the torque vector by the Rigid's inertia tensor.
+--  --                       the_Torque     : math.Vector_3   := (error_Term - vel_Term) * Inverse (the_inv_Tensor);   -- scale the torque vector by the Rigid's inertia tensor.
+--
+--                       raw_Torque : aliased physics.Vector_3.item := +(the_Torque * 180.0 / math.Pi);
+--                    begin
+--  --                       put_Line ("applying torque");
+--                       self.Rigid.apply_Torque (raw_Torque'unchecked_access);   -- tbd: check this 'scale' factor
+--                    end;
+--                 end;
+--              end;
+--           end;
+--
+--        end if;
+--
+--     end;
+
+
+
+
+
+
+--
+--
+--  	void SpringMotor::setGlobalAttachPoint(const Point3r& p)
+--  	{
+--  		if (!mData.solid)
+--  		{
+--  			OPAL_LOGGER("warning") <<
+--  				"opal::SpringMotor::setGlobalAttachPoint: Solid pointer is \
+--  invalid.  Ignoring request." << std::endl;
+--  			return;
+--  		}
+--
+--  		// Convert the global point to a local point offset from the Solid's
+--  		// transform.
+--  		Matrix44r inv = mData.solid->getTransform();
+--  		inv.invert();
+--  		mData.attachOffset = inv * p;
+--  	}
+--
+--  	Point3r SpringMotor::getGlobalAttachPoint()const
+--  	{
+--  		if (!mData.solid)
+--  		{
+--  			OPAL_LOGGER("warning") <<
+--  				"opal::SpringMotor::getGlobalAttachPoint: Solid pointer is \
+--  invalid.  Returning (0,0,0)." << std::endl;
+--  			return Point3r();
+--  		}
+--
+--  		// The global position is a combination of the Solid's global
+--  		// transform and the spring's local offset from the Solid's
+--  		// transform.
+--  		Point3r localPos(mData.attachOffset[0], mData.attachOffset[1],
+--  			mData.attachOffset[2]);
+--  		Point3r globalPos = mData.solid->getTransform() * localPos;
+--
+--  		return globalPos;
+--  	}
+--
+--  	void SpringMotor::setDesiredTransform(const Matrix44r& transform)
+--  	{
+--  		mData.desiredPos = transform.getPosition();
+--
+--  		mData.desiredForward = transform.getForward();
+--  		if (0 != mData.desiredForward.lengthSquared())
+--  		{
+--  			mData.desiredForward.normalize();
+--  		}
+--
+--  		mData.desiredUp = transform.getUp();
+--  		if (0 != mData.desiredUp.lengthSquared())
+--  		{
+--  			mData.desiredUp.normalize();
+--  		}
+--
+--  		mData.desiredRight = transform.getRight();
+--  		if (0 != mData.desiredRight.lengthSquared())
+--  		{
+--  			mData.desiredRight.normalize();
+--  		}
+--  	}
+--
+--
+--  	void SpringMotor::setDesiredOrientation(const Vec3r& forward,
+--  		const Vec3r& up, const Vec3r& right)
+--  	{
+--  		mData.desiredForward = forward;
+--  		if (0 != mData.desiredForward.lengthSquared())
+--  		{
+--  			mData.desiredForward.normalize();
+--  		}
+--
+--  		mData.desiredUp = up;
+--  		if (0 != mData.desiredUp.lengthSquared())
+--  		{
+--  			mData.desiredUp.normalize();
+--  		}
+--
+--  		mData.desiredRight = right;
+--  		if (0 != mData.desiredRight.lengthSquared())
+--  		{
+--  			mData.desiredRight.normalize();
+--  		}
+--  	}
+--
+
+end physics.Motor.spring.angular;

3-mid/physics/interface/source/motor/physics-motor-spring-angular.ads

@@ -0,0 +1,29 @@
+
+with Math;
+
+
+
+package physics.Motor.spring.angular is
+
+   -- a spring which operates in 3 degrees of rotational motion to keep a Solid in a desired attitude.
+
+
+   use type math.Real;
+
+   type Item is new physics.Motor.spring.item with
+      record
+         desiredForward : math.Vector_3 := (0.0, 0.0, -1.0);   -- the Motor's desired forward direction, part of the desired orientation.
+         desiredUp      : math.Vector_3 := (0.0, 1.0,  0.0);   -- the Motor's desired up      direction.
+         desiredRight   : math.Vector_3 := (1.0, 0.0,  0.0);   -- the Motor's desired right   direction.
+
+         angularKd      : math.Real := 0.000_1;    -- the damping constant for angular mode.
+         angularKs      : math.Real := 1.0;        -- the spring  constant for angular mode.
+      end record;
+
+
+
+
+   procedure update (Self : in out Item);
+
+
+end physics.Motor.spring.angular;

3-mid/physics/interface/source/motor/physics-motor-spring.adb

@@ -0,0 +1,15 @@
+
+
+
+
+package body physics.Motor.spring is
+
+   -- child packages are based on 'open physics abstraction layer' spring motors.
+
+
+
+   procedure dummy is begin null; end;
+
+
+end physics.Motor.spring;
+

3-mid/physics/interface/source/motor/physics-motor-spring.ads

@@ -0,0 +1,35 @@
+
+with physics.Rigid;
+with Math;
+
+
+
+
+package physics.Motor.spring is
+
+   -- a motor which acts as a spring to bring a target solid to a desired site or attitude.
+
+
+   type Item is abstract new physics.Motor.item with
+      record
+         Rigid : physics.Rigid.pointer;                -- access to the Solid affected by this Motor.
+      end record;
+
+
+
+
+   procedure update (Self : in out Item) is abstract;
+
+
+
+
+
+
+private
+
+   procedure dummy;
+
+
+
+end physics.Motor.spring;
+

3-mid/physics/interface/source/motor/physics-motor.adb

@@ -0,0 +1,22 @@
+
+
+
+package body physics.Motor is
+
+
+   procedure dummy is begin null; end;
+
+
+
+--  	bool Motor::internal_dependsOnSolid(Solid* s)
+--  	{
+--  		return false;
+--  	}
+--
+--  	bool Motor::internal_dependsOnJoint(Joint* j)
+--  	{
+--  		return false;
+--  	}
+--
+
+end physics.Motor;

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

@@ -0,0 +1,41 @@
+
+--  with i.physics.Object;
+--  with i.physics.Joint;
+
+with ada.strings.unbounded;
+
+
+
+package physics.Motor is
+
+
+   type Item is abstract tagged
+      record
+         Name       : ada.strings.unbounded.unbounded_String;
+         is_Enabled : Boolean                               := False;
+      end record;
+
+
+
+   procedure update (Self : in out Item) is abstract;
+
+
+--  	class Motor
+--  	{
+--  	public:
+--
+--  		/// Returns true if this Motor depends on the given Solid.
+--  		virtual bool internal_dependsOnSolid(Solid* s);
+--
+--  		/// Returns true if this Motor depends on the given Joint.
+--  		virtual bool internal_dependsOnJoint(Joint* j);
+--  }
+--
+--  #endif
+
+   procedure dummy;
+
+
+end physics.Motor;
+
+

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

@@ -0,0 +1,644 @@
+with
+     ada.unchecked_Deallocation,
+     ada.Containers,
+     ada.Calendar,
+     ada.Text_IO,
+     ada.Exceptions;
+
+package body physics.Engine
+is
+   use ada.Text_IO;
+
+
+   protected body safe_command_Set
+   is
+      function is_Empty return Boolean
+      is
+      begin
+         return the_Count = 0;
+      end is_Empty;
+
+
+      procedure add (the_Command : in Command)
+      is
+      begin
+         the_Count       := the_Count + 1;
+         Set (the_Count) := the_Command;
+      end add;
+
+
+      procedure Fetch (To    : out Commands;
+                       Count : out Natural)
+      is
+      begin
+         To (1 .. the_Count) := Set (1 .. the_Count);
+         Count               := the_Count;
+         the_Count           := 0;
+      end Fetch;
+   end safe_command_Set;
+
+
+
+   task body Evolver
+   is
+      use type physics.Joint.view,
+               ada.Containers.Count_type;
+
+      Stopped          : Boolean                   := True;
+      Cycle            : ada.Containers.Count_type := 0;
+      next_render_Time : ada.Calendar.Time;
+
+      --  max_joint_Force,
+      --  max_joint_Torque : Real := 0.0;
+
+
+      procedure free_Objects
+      is
+--           the_free_Objects : gel.Object.views := the_World.free_Object_Set;
+      begin
+--           for Each in the_free_Objects'Range
+--           loop
+--              log ("Engine is Freeing Object id: " & Object_Id'Image (the_free_Objects (Each).Id));
+--
+--              if the_free_Objects (Each).owns_Graphics
+--              then
+--                 the_World.Renderer.free (the_free_Objects (Each).Visual.Model);
+--              end if;
+--
+--              gel.Object.free (the_free_Objects (Each));
+--           end loop;
+         null;
+
+      end free_Objects;
+
+
+
+      procedure evolve
+      is
+      begin
+         Cycle := Cycle + 1;
+
+         do_engine_Commands:
+         declare
+            the_Commands  : Commands;
+            Count         : Natural;
+
+            command_Count : array (command_Kind) of Natural := [others => 0];
+
+         begin
+            Self.Commands.fetch (the_Commands, Count);
+
+            for Each in 1 .. Count
+            loop
+               declare
+                  the_Command : Command renames the_Commands (Each);
+               begin
+                  command_Count (the_Command.Kind) := command_Count (the_Command.Kind) + 1;
+
+                  case the_Command.Kind
+                  is
+                     when scale_Object =>
+                        the_Command.Object.activate;
+                        the_Command.Object.Shape.Scale_is (the_Command.Scale);
+                        the_Command.Object      .Scale_is (the_Command.Scale);
+
+                        Self.Space.update_Bounds (the_Command.Object);
+
+
+                     when update_Bounds =>
+                        Self.Space.update_Bounds (the_Command.Object);
+
+
+                     when update_Site =>
+                        the_Command.Object.Site_is (the_Command.Site);
+
+
+                     when set_Speed =>
+                        the_Command.Object.Speed_is (the_Command.Speed);
+
+
+                     when set_xy_Spin =>
+                        the_Command.Object.xy_Spin_is (the_Command.xy_Spin);
+
+
+                     when add_Object =>
+                        declare
+--                             procedure rebuild_Shape (the_Object : in Object.view)
+--                             is
+--                                use type physics.Model.shape_Kind,
+--                                         physics.Model.View;
+--
+--                                the_Scale : aliased Vector_3;
+--
+--                             begin
+--                                if the_Object.physics_Model = null then
+--                                   return;
+--                                end if;
+--
+--                                the_Scale := Self.physics_Model.Scale;
+--
+--                                case Self.physics_Model.shape_Info.Kind
+--                                is
+--                                when physics.Model.Cube =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics.        new_box_Shape (Self.physics_Model.shape_Info.half_Extents));
+--
+--                                when physics.Model.a_Sphere =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics.     new_sphere_Shape (Self.physics_Model.shape_Info.sphere_Radius));
+--
+--                                when physics.Model.multi_Sphere =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics.new_multisphere_Shape (Self.physics_Model.shape_Info.Sites.all,
+--                                                                     Self.physics_Model.shape_Info.Radii.all));
+--                                when physics.Model.Cone =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics.       new_cone_Shape (radius => Real (Self.physics_Model.Scale (1) / 2.0),
+--                                                                                                               height => Real (Self.physics_Model.Scale (2))));
+--                                when physics.Model.a_Capsule =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics.    new_capsule_Shape (Self.physics_Model.shape_Info.lower_Radius,
+--                                                                     Self.physics_Model.shape_Info.Height));
+--                                when physics.Model.Cylinder =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics.   new_cylinder_Shape (Self.physics_Model.shape_Info.half_Extents));
+--
+--                                when physics.Model.Hull =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics.new_convex_hull_Shape (Self.physics_Model.shape_Info.Points.all));
+--
+--                                when physics.Model.Mesh =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics       .new_mesh_Shape (Self.physics_Model.shape_Info.Model));
+--
+--                                when physics.Model.Plane =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics.      new_plane_Shape (Self.physics_Model.Shape_Info.plane_Normal,
+--                                                                     Self.physics_Model.Shape_Info.plane_Offset));
+--                                when physics.Model.Heightfield =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics.new_heightfield_Shape (Self.physics_Model.shape_Info.Heights.all,
+--                                                                     Self.physics_Model.Scale));
+--                                when physics.Model.Circle =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics.     new_circle_Shape (Self.physics_Model.shape_Info.circle_Radius));
+--
+--                                when physics.Model.Polygon =>
+--                                   Self.Shape := physics_Shape_view (Self.World.Physics.    new_polygon_Shape (physics.space.polygon_Vertices (Self.physics_Model.shape_Info.Vertices (1 .. Self.physics_Model.shape_Info.vertex_Count))));
+--                                end case;
+--
+--                             end rebuild_Shape;
+
+
+                           procedure add (the_Object : in Object.view)
+                           is
+                           begin
+--                                the_World.add (the_Object. physics_Model.all'Access);
+
+--                                if the_Object.physics_Model.is_Tangible
+--                                then
+
+                              --                                rebuild_Shape  (the_Object);
+                              the_Object.Shape.define;
+                              --  the_Object.define (Shape       => the_Object.Shape,
+                              --                     Mass        => the_Object.Model.Mass,
+                              --                     Friction    => the_Object.Model.Friction,
+                              --                     Restitution => the_Object.Model.Restitution,
+                              --                     at_Site     => the_Object.Model.Site);
+
+                              Self.Space.add (the_Object);
+--                                end if;
+
+--                                begin
+--                                   the_Object_Transforms.insert  (the_Object, Identity_4x4);
+--                                   the_Object.Solid.user_Data_is (the_Object);
+--                                end;
+
+--                                the_World.Object_Count                     := the_World.Object_Count + 1;
+--                                the_World.Objects (the_World.Object_Count) := the_Object;
+                           end add;
+
+                        begin
+                           add (the_Command.Object);
+                        end;
+
+
+                     when rid_Object =>
+                        declare
+                           function find (the_Object : in Object.view) return Index
+                           is
+                           begin
+--                                for Each in 1 .. the_World.Object_Count
+--                                loop
+--                                   if the_World.Objects (Each) = the_Object
+--                                   then
+--                                      return Each;
+--                                   end if;
+--                                end loop;
+
+                              raise constraint_Error with "no such Object in world";
+                              return 0;
+                           end find;
+
+
+                           procedure rid (the_Object : in Object.view)
+                           is
+                              use type Object.view;
+                           begin
+                              if the_Object /= null
+                              then
+--                                   if the_Object.physics_Model.is_Tangible
+--                                   then
+                                    Self.Space.rid (the_Object);
+--                                   end if;
+
+--                                   if the_Object_Transforms.contains (the_Object) then
+--                                      the_Object_Transforms.delete   (the_Object);
+--                                   end if;
+
+                              else
+                                 raise program_Error;
+                              end if;
+
+
+                              declare
+                                 Id : Index;
+                                 pragma Unreferenced (Id);
+                              begin
+                                 Id := find (the_Object);
+
+--                                   if Id <= the_World.Object_Count
+--                                   then
+--                                      the_World.Objects (1 .. the_World.Object_Count - 1)
+--                                        :=   the_World.Objects (     1 .. Id - 1)
+--                                           & the_World.Objects (Id + 1 .. the_World.Object_Count);
+--                                   end if;
+
+--                                   the_World.Object_Count := the_World.Object_Count - 1;
+                              end;
+                           end rid;
+
+                        begin
+                           rid (the_Command.Object);
+                        end;
+
+
+                     when apply_Force =>
+                        the_Command.Object.apply_Force (the_Command.Force);
+
+
+                     when destroy_Object =>
+                        declare
+--                             the_free_Set : free_Set renames the_World.free_Sets (the_World.current_free_Set);
+                        begin
+                           raise Program_Error with "destroy_Object ~ TODO";
+--                             the_free_Set.Count                        := the_free_Set.Count + 1;
+--                             the_free_Set.Objects (the_free_Set.Count) := the_Command.Object;
+                        end;
+
+
+                     when add_Joint =>
+                        Self.Space.add                 (the_Command.Joint.all'Access);
+                        the_Command.Joint.user_Data_is (the_Command.Joint);
+
+
+                     when rid_Joint =>
+                        Self.Space.rid (the_Command.Joint.all'Access);
+
+
+                     when set_Joint_local_Anchor =>
+                        Self.Space.set_Joint_local_Anchor (the_Command.anchor_Joint.all'Access,
+                                                           the_Command.is_Anchor_A,
+                                                           the_Command.local_Anchor);
+
+                     when free_Joint =>
+--                          Joint.free (the_Command.Joint);
+                        null;
+
+
+                     when cast_Ray =>
+                        null;
+--                          declare
+--                             function cast_Ray (Self : in Item'Class;   From, To : in math.Vector_3) return ray_Collision
+--                             is
+--                                use type std_physics.Object.view;
+--
+--                                physics_Collision : constant standard.physics.Space.ray_Collision := Self.physics.cast_Ray (From, To);
+--                             begin
+--                                if physics_Collision.near_Object = null
+--                                then
+--                                   return ray_Collision' (near_Object => null,
+--                                                          others      => <>);
+--                                else
+--                                   return ray_Collision' (to_GEL (physics_Collision.near_Object),
+--                                                          physics_Collision.hit_Fraction,
+--                                                          physics_Collision.Normal_world,
+--                                                          physics_Collision.Site_world);
+--                                end if;
+--                             end cast_Ray;
+--
+--                             the_Collision : constant ray_Collision := cast_Ray (the_World.all,
+--                                                                                 the_Command.From,
+--                                                                                 the_Command.To);
+--                          begin
+--                             if        the_Collision.near_Object = null
+--                               or else the_Collision.near_Object.is_Destroyed
+--                             then
+--                                free (the_Command.Context);
+--
+--                             else
+--                                declare
+--                                   no_Params : aliased no_Parameters;
+--                                   the_Event :         raycast_collision_Event'Class
+--                                     := raycast_collision_Event_dispatching_Constructor (the_Command.event_Kind,
+--                                                                                         no_Params'Access);
+--                                begin
+--                                   the_Event.near_Object := the_Collision.near_Object;
+--                                   the_Event.Context     := the_Command.Context;
+--                                   the_Event.Site_world  := the_Collision.Site_world;
+--
+--                                   the_Command.Observer.receive (the_Event, from_subject => the_World.Name);
+--                                end;
+--                             end if;
+--                          end;
+
+
+                     when set_Gravity =>
+                        Self.Space.Gravity_is (the_Command.Gravity);
+                  end case;
+               end;
+            end loop;
+         end do_engine_Commands;
+
+         Self.Space.evolve (by => 1.0 / 60.0);     -- Evolve the world.
+--           free_Objects;
+
+      end evolve;
+
+      use ada.Calendar;
+
+   begin
+--        accept start (space_Kind : in physics.space_Kind)
+      accept start (the_Space : in Space.view)
+      do
+         Stopped    := False;
+
+--           Self.Space := physics.Forge.new_Space (space_Kind);
+         Self.Space := the_Space;
+      end start;
+
+
+      next_render_Time := ada.Calendar.Clock;
+
+      loop
+         select
+            accept stop
+            do
+               Stopped := True;
+
+
+               -- Add 'destroy' commands for all Objects.
+               --
+--                 declare
+--                    the_Objects : Object.views renames the_World.Objects;
+--                 begin
+--                    for i in 1 .. the_World.Object_Count
+--                    loop
+--                       the_Objects (i).destroy (and_Children => False);
+--                    end loop;
+--                 end;
+
+               -- Evolve the world til there are no commands left.
+               --
+               while not Self.Commands.is_Empty
+               loop
+                  evolve;
+               end loop;
+
+               -- Free both sets of freeable Objects.
+               --
+               free_Objects;
+               free_Objects;
+            end stop;
+
+            exit when Stopped;
+
+         or
+            accept reset_Age
+            do
+               Self.Age := 0.0;
+            end reset_Age;
+
+         else
+            null;
+         end select;
+
+
+         evolve;
+
+
+--           the_World.new_Object_transforms_Available.signal;
+--           the_World.evolver_Done                   .signal;
+
+
+         -- Check for joint breakage.
+         --
+--           if the_World.broken_joints_Allowed
+--           then
+--              declare
+--                 use gel.Joint,
+--                     standard.physics.Space;
+--
+--                 the_Joint       : gel.Joint.view;
+--                 reaction_Force,
+--                 reaction_Torque : math.Real;
+--
+--                 Cursor          : standard.physics.Space.joint_Cursor'Class := the_World.Physics.first_Joint;
+--              begin
+--                 while has_Element (Cursor)
+--                 loop
+--                    the_Joint := to_GEL (Element (Cursor));
+--
+--                    if the_Joint /= null
+--                    then
+--                       reaction_Force  := abs (the_Joint.reaction_Force);
+--                       reaction_Torque := abs (the_Joint.reaction_Torque);
+--
+--                       if   reaction_Force  >  50.0 / 8.0
+--                         or reaction_Torque > 100.0 / 8.0
+--                       then
+--                          begin
+--                             the_World.Physics      .rid (the_Joint.Physics.all'Access);
+--                             the_World.broken_Joints.add (the_Joint);
+--
+--                          exception
+--                             when no_such_Child =>
+--                                put_Line ("Error when breaking joint due to reaction Force:  no_such_Child !");
+--                          end;
+--                       end if;
+--
+--                       if reaction_Force > max_joint_Force
+--                       then
+--                          max_joint_Force := reaction_Force;
+--                       end if;
+--
+--                       if reaction_Torque > max_joint_Torque
+--                       then
+--                          max_joint_Torque := reaction_Torque;
+--                       end if;
+--                    end if;
+--
+--                    next (Cursor);
+--                 end loop;
+--              end;
+--           end if;
+
+         next_render_Time := next_render_Time + Duration (1.0 / 60.0);
+      end loop;
+
+   exception
+      when E : others =>
+         new_Line (2);
+         put_Line ("Error in physics.Engine.evolver task !");
+         new_Line;
+         put_Line (Ada.Exceptions.Exception_Information (E));
+         put_Line ("Evolver has terminated !");
+         new_Line (2);
+   end Evolver;
+
+
+
+--     procedure start (Self : access Item;   space_Kind : in physics.space_Kind)
+   procedure start (Self : access Item;   the_Space : in Space.view)
+   is
+   begin
+      Self.Evolver.start (the_Space);
+   end start;
+
+
+   procedure stop (Self : access Item)
+   is
+      procedure free is new ada.unchecked_Deallocation (safe_command_Set, safe_command_Set_view);
+   begin
+      Self.Evolver.stop;
+      free (Self.Commands);
+   end stop;
+
+
+
+   procedure add (Self : access Item;   the_Object : in Object.view)
+   is
+   begin
+      put_Line ("physics engine: add Object");
+      Self.Commands.add ((Kind         => add_Object,
+                          Object       => the_Object,
+                          add_Children => False));
+   end add;
+
+
+   procedure rid (Self : in out Item;   the_Object : in Object.view)
+   is
+   begin
+      Self.Commands.add ((Kind         => rid_Object,
+                          Object       => the_Object,
+                          rid_Children => False));
+   end rid;
+
+
+
+   procedure add (Self : in out Item;   the_Joint : in Joint.view)
+   is
+   begin
+      Self.Commands.add ((Kind   => add_Joint,
+                          Object => null,
+                          Joint  => the_Joint));
+   end add;
+
+
+   procedure rid (Self : in out Item;   the_Joint : in Joint.view)
+   is
+   begin
+      Self.Commands.add ((Kind   => rid_Joint,
+                          Object => null,
+                          Joint  => the_Joint));
+   end rid;
+
+
+
+   procedure update_Scale (Self : in out Item;   of_Object : in Object.view;
+                                                 To        : in math.Vector_3)
+   is
+   begin
+      Self.Commands.add ((Kind   => scale_Object,
+                          Object => of_Object,
+                          Scale  => To));
+   end update_Scale;
+
+
+
+   procedure apply_Force (Self : in out Item;   to_Object : in Object.view;
+                                                Force     : in math.Vector_3)
+   is
+   begin
+      Self.Commands.add ((Kind   => apply_Force,
+                          Object => to_Object,
+                          Force  => Force));
+   end apply_Force;
+
+
+
+   procedure update_Site (Self : in out Item;   of_Object : in Object.view;
+                                                To        : in math.Vector_3)
+   is
+   begin
+      put_Line ("physics engine: update_Site");
+      Self.Commands.add ((Kind   => update_Site,
+                          Object => of_Object,
+                          Site   => To));
+   end update_Site;
+
+
+
+   procedure set_Speed (Self : in out Item;   of_Object : in Object.view;
+                                              To        : in math.Vector_3)
+   is
+   begin
+      Self.Commands.add ((Kind   => set_Speed,
+                          Object => of_Object,
+                          Speed  => To));
+   end set_Speed;
+
+
+
+   procedure set_Gravity (Self : in out Item;   To : in math.Vector_3)
+   is
+   begin
+      Self.Commands.add ((Kind    => set_Gravity,
+                          Object  => null,
+                          Gravity => To));
+   end set_Gravity;
+
+
+
+   procedure set_xy_Spin (Self : in out Item;   of_Object : in Object.view;
+                                                To        : in math.Radians)
+   is
+   begin
+      Self.Commands.add ((Kind    => set_xy_Spin,
+                          Object  => of_Object,
+                          xy_Spin => To));
+   end set_xy_Spin;
+
+
+
+   procedure update_Bounds (Self : in out Item;   of_Object : in Object.view)
+   is
+   begin
+      Self.Commands.add ((Kind   => update_Bounds,
+                          Object => of_Object));
+   end update_Bounds;
+
+
+
+   procedure set_local_Anchor (Self : in out Item;   for_Joint : in Joint.view;
+                                                     To        : in math.Vector_3;
+                                                     is_Anchor_A : in Boolean)
+   is
+   begin
+      Self.Commands.add ((Kind         => set_Joint_local_Anchor,
+                          Object       => null,
+                          anchor_Joint => for_Joint,
+                          local_Anchor => To,
+                          is_Anchor_A  => is_Anchor_A));
+   end set_local_Anchor;
+
+end physics.Engine;

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;

3-mid/physics/interface/source/physics-forge.adb

@@ -0,0 +1,28 @@
+with
+     bullet_physics.Space,
+     box2d_physics .Space;
+
+package body physics.Forge
+is
+   ----------
+   --- Space
+   --
+
+   function new_Space (Kind : in space_Kind) return Space.view
+   is
+      Self : Space.view;
+   begin
+      case Kind
+      is
+         when Bullet =>
+            Self := Space.view' (new bullet_physics.Space.item' (bullet_physics.Space.to_Space));
+
+         when Box2d =>
+            Self := Space.view' (new  box2d_physics.Space.item' (box2d_physics.Space.to_Space));
+      end case;
+
+      return Self;
+   end new_Space;
+
+
+end physics.Forge;

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

@@ -0,0 +1,19 @@
+with
+     physics.Space;
+
+package physics.Forge
+--
+-- Provides constructors for physics classes.
+--
+is
+   type Real_view is access all math.Real;
+
+
+   ----------
+   --- Space
+   --
+
+   function new_Space (Kind : in space_Kind)  return Space.view;
+
+
+end physics.Forge;

3-mid/physics/interface/source/physics-joint-ball.ads

@@ -0,0 +1,22 @@
+package physics.Joint.ball
+--
+--   An interface to a ball/socket joint.
+--
+is
+   type Item is  limited interface
+             and Joint.item;
+
+   type View is access all Item'Class;
+
+
+   function  lower_Limit    (Self : in     Item;   DoF : in Degree_of_freedom) return Real    is abstract;
+   function  upper_Limit    (Self : in     Item;   DoF : in Degree_of_freedom) return Real    is abstract;
+
+
+   procedure lower_Limit_is (Self : in out Item;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)   is abstract;
+
+   procedure upper_Limit_is (Self : in out Item;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)   is abstract;
+
+end physics.Joint.ball;

3-mid/physics/interface/source/physics-joint-cone_twist.ads

@@ -0,0 +1,22 @@
+package physics.Joint.cone_Twist
+--
+-- An interface to a cone-twist joint.
+--
+is
+   type Item is  limited interface
+             and Joint.item;
+
+   type View is access all Item'Class;
+
+
+   function  lower_Limit    (Self : in     Item;   DoF : in Degree_of_freedom) return Real    is abstract;
+   function  upper_Limit    (Self : in     Item;   DoF : in Degree_of_freedom) return Real    is abstract;
+
+
+   procedure lower_Limit_is (Self : in out Item;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)   is abstract;
+
+   procedure upper_Limit_is (Self : in out Item;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)   is abstract;
+
+end physics.Joint.cone_Twist;

3-mid/physics/interface/source/physics-joint-dof6.ads

@@ -0,0 +1,22 @@
+package physics.Joint.DoF6
+--
+--   An interface to a general 'six degrees of freedom' joint.
+--
+is
+   type Item is  limited interface
+             and Joint.item;
+
+   type View is access all Item'Class;
+
+
+   function  lower_Limit    (Self : in     Item;   DoF : in Degree_of_freedom) return Real    is abstract;
+   function  upper_Limit    (Self : in     Item;   DoF : in Degree_of_freedom) return Real    is abstract;
+
+
+   procedure lower_Limit_is (Self : in out Item;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)   is abstract;
+
+   procedure upper_Limit_is (Self : in out Item;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)   is abstract;
+
+end physics.Joint.DoF6;

3-mid/physics/interface/source/physics-joint-hinge.ads

@@ -0,0 +1,23 @@
+package physics.Joint.hinge
+--
+-- An interface to a hinge joint.
+--
+is
+   type Item is  limited interface
+             and Joint.item;
+
+   type View is access all Item'Class;
+
+
+
+   procedure Limits_are  (Self : in out Item;   Low, High        : in Real;
+                                                Softness         : in Real := 0.9;
+                                                biasFactor       : in Real := 0.3;
+                                                relaxationFactor : in Real := 1.0)   is abstract;
+
+   function  lower_Limit (Self : in     Item)   return Real                          is abstract;
+   function  upper_Limit (Self : in     Item)   return Real                          is abstract;
+
+   function  Angle       (Self : in     Item)   return Real                          is abstract;
+
+end physics.Joint.hinge;

3-mid/physics/interface/source/physics-joint-slider.ads

@@ -0,0 +1,22 @@
+package physics.Joint.Slider
+--
+-- An interface to a slider joint.
+--
+is
+   type Item is  limited interface
+             and Joint.item;
+
+   type View is access all Item'Class;
+
+
+   function  lower_Limit    (Self : in     Item;   DoF : in Degree_of_freedom) return Real    is abstract;
+   function  upper_Limit    (Self : in     Item;   DoF : in Degree_of_freedom) return Real    is abstract;
+
+
+   procedure lower_Limit_is (Self : in out Item;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)   is abstract;
+
+   procedure upper_Limit_is (Self : in out Item;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)   is abstract;
+
+end physics.Joint.Slider;

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

@@ -0,0 +1,59 @@
+with
+     physics.Object,
+     lace.Any;
+
+package physics.Joint
+--
+-- Provides an interface for physics joints.
+--
+is
+   type Item is limited interface
+                and lace.Any.limited_item;
+
+   type View is access all Item'Class;
+
+
+   type Degree_of_freedom is range 1 .. 6;
+
+   procedure destruct    (Self : in out Item)                            is abstract;
+
+   function  Object_A    (Self : in     Item) return physics.Object.view is abstract;
+   function  Object_B    (Self : in     Item) return physics.Object.view is abstract;
+
+
+   function  Frame_A     (Self : in     Item) return Matrix_4x4          is abstract;
+   function  Frame_B     (Self : in     Item) return Matrix_4x4          is abstract;
+
+   procedure Frame_A_is  (Self : in out Item;   Now : in Matrix_4x4)     is abstract;
+   procedure Frame_B_is  (Self : in out Item;   Now : in Matrix_4x4)     is abstract;
+
+
+   function  is_Limited  (Self : in     Item;   DoF : Degree_of_freedom) return Boolean is abstract;
+
+
+   procedure Velocity_is (Self : in out Item;   Now : in Real;
+                                                DoF : in Degree_of_freedom)             is abstract;
+   --
+   --  Sets the spatial or angular velocity for the specified DoF.
+
+
+   function  Extent      (Self : in     Item;   DoF : Degree_of_freedom) return Real    is abstract;
+   --
+   --  Returns the current distance or angle (for a spatial or angular DoF, respectively).
+
+
+   procedure desired_Extent_is (Self : in out Item;   Now : in Real;
+                                                      DoF : in Degree_of_freedom)       is abstract;
+   --
+   --  Sets the desired spacial or angular extent for a given degree of freedom (DoF).
+
+
+   function  reaction_Force  (Self : in     Item) return Vector_3 is abstract;
+   function  reaction_Torque (Self : in     Item) return Real     is abstract;
+
+
+   procedure user_Data_is    (Self : in out Item;   Now : access lace.Any.limited_item'Class) is abstract;
+   function  user_Data       (Self : in     Item)  return access lace.Any.limited_item'Class  is abstract;
+
+
+end physics.Joint;

3-mid/physics/interface/source/physics-model.adb

@@ -0,0 +1,84 @@
+with
+     ada.unchecked_Deallocation;
+
+package body physics.Model
+is
+   ----------
+   --- Forge
+   --
+
+   package body Forge
+   is
+      function new_physics_Model (Id          : in model_Id := null_model_Id;
+                                  shape_Info  : in a_Shape;
+                                  Scale       : in Vector_3 := [1.0, 1.0, 1.0];
+                                  Mass        : in Real     := 0.0;
+                                  Friction    : in Real     := 0.1;
+                                  Restitution : in Real     := 0.1;
+                                  --  Site        : in Vector_3 := Origin_3D;
+                                  is_Tangible : in Boolean  := True) return View
+      is
+      begin
+         return new Item' (Id          => Id,
+                           Scale       => Scale,
+                           shape_Info  => shape_Info,
+                           Shape       => null,
+                           Mass        => Mass,
+                           Friction    => Friction,
+                           Restitution => Restitution,
+                           --  Site        => Site,
+                           is_Tangible => is_Tangible);
+      end new_physics_Model;
+   end Forge;
+
+
+   procedure define (Self : in out Item;   Scale : in Vector_3)
+   is
+   begin
+      Self.Scale := Scale;
+   end define;
+
+
+   procedure destroy (Self : in out Item)
+   is
+   begin
+      null;
+   end destroy;
+
+
+   procedure free (Self : in out View)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (Item'Class,
+                                                              View);
+   begin
+      Self.destroy;
+      deallocate (Self);
+   end free;
+
+
+   ---------------
+   --- Attributes
+   --
+
+   function Id (Self : in Item'Class) return model_Id
+   is
+   begin
+      return Self.Id;
+   end Id;
+
+
+   procedure Id_is (Self : in out Item'Class;   Now : in model_Id)
+   is
+   begin
+      Self.Id := Now;
+   end Id_is;
+
+
+   procedure Scale_is (Self : in out Item'Class;   Now : in Vector_3)
+   is
+   begin
+      Self.Scale := Now;
+   end Scale_is;
+
+
+end physics.Model;

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

@@ -0,0 +1,112 @@
+with
+     physics.remote.Model,
+     physics.Shape;
+
+package physics.Model
+--
+--  Provides a model describing physical properties.
+--
+is
+   type Heightfield_view    is access physics.Heightfield;
+   type Vector_3_array_view is access physics.Vector_3_array;
+   type Vector_view         is access Vector;
+
+
+   type shape_Kind is (Cylinder,  Cone,    Cube,  a_Sphere,  a_Capsule,  Heightfield,  Hull,  Mesh,  multi_Sphere, Plane,     -- 3D
+                       Circle,    Polygon);                                                                                   -- 2D
+
+   type a_Shape (Kind : shape_Kind := Cube) is
+      record
+         case Kind
+         is
+            when Cube | Cylinder =>
+               half_Extents  :        Vector_3;
+
+            when a_Capsule =>
+               lower_Radius,
+               upper_Radius  :        Real;
+               Height        :        Real;
+
+            when Heightfield =>
+               Heights       :        Heightfield_view;
+               height_Range  :        Vector_2;
+
+            when a_Sphere =>
+               sphere_Radius :        Real;
+
+            when Circle =>
+               circle_Radius :        Real;
+
+            when Hull =>
+               Points        :        Vector_3_array_view;
+
+            when Mesh =>
+               Model         : access Geometry_3D.a_Model;
+
+            when multi_Sphere =>
+               Sites         :        Vector_3_array_view;
+               Radii         :        Vector_view;
+
+            when Plane =>
+               plane_Normal  :        Vector_3;
+               plane_Offset  :        Real;
+
+            when Polygon =>
+               Vertices      :        Geometry_2d.Sites (1 .. 8);
+               vertex_Count  :        Natural := 0;
+
+            when others =>
+               null;
+         end case;
+      end record;
+
+
+   type Item is new physics.remote.Model.item with
+      record
+         shape_Info  : a_Shape;
+         Shape       : physics.Shape.view;
+
+         Mass        : Real;
+         Friction    : Real;
+         Restitution : Real;     -- Bounce
+         --  Site        : Vector_3;
+
+         is_Tangible : Boolean := True;
+      end record;
+
+   type View is access all Item'Class;
+
+
+   ----------
+   --- Forge
+   --
+
+   package Forge
+   is
+      function new_physics_Model (Id          : in model_Id := null_model_Id;
+                                  shape_Info  : in a_Shape;
+                                  Scale       : in Vector_3 := [1.0, 1.0, 1.0];
+                                  Mass        : in Real     := 0.0;
+                                  Friction    : in Real     := 0.1;
+                                  Restitution : in Real     := 0.1;
+                                  --  Site        : in Vector_3 := Origin_3d;
+                                  is_Tangible : in Boolean  := True) return View;
+   end Forge;
+
+   procedure define  (Self : in out Item;   Scale : in Vector_3);
+   procedure destroy (Self : in out Item);
+   procedure free    (Self : in out View);
+
+
+   ---------------
+   --- Attributes
+   --
+
+   function  Id       (Self : in     Item'Class)     return model_Id;
+   procedure Id_is    (Self : in out Item'Class;   Now : in model_Id);
+
+
+   procedure Scale_is (Self : in out Item'Class;   Now : in Vector_3);
+
+
+end physics.Model;

3-mid/physics/interface/source/physics-object.adb

@@ -0,0 +1,67 @@
+with
+     ada.unchecked_Deallocation;
+
+package body physics.Object
+is
+
+   procedure free (Self : in out View)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (Item'Class, View);
+   begin
+      if Self /= null then
+         Self.destruct;
+      end if;
+
+      deallocate (Self);
+   end free;
+
+
+
+   protected
+   body safe_Dynamics
+   is
+
+      procedure set (To : in Matrix_4x4)
+      is
+      begin
+         Dynamics := To;
+      end set;
+
+      function get return Matrix_4x4
+      is
+      begin
+         return Dynamics;
+      end get;
+
+      procedure set_Spin (To : in Matrix_3x3)
+      is
+         use linear_Algebra_3D;
+      begin
+         set_Rotation (Dynamics, To);
+      end set_Spin;
+
+      function get_Spin return Matrix_3x3
+      is
+         use linear_Algebra_3D;
+      begin
+         return get_Rotation (Dynamics);
+      end get_Spin;
+
+      procedure set_Site (To : in Vector_3)
+      is
+         use linear_Algebra_3D;
+      begin
+         set_Translation (Dynamics, To);
+      end set_Site;
+
+      function get_Site return Vector_3
+      is
+         use linear_Algebra_3D;
+      begin
+         return get_Translation (Dynamics);
+      end get_Site;
+
+   end safe_Dynamics;
+
+
+end physics.Object;

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

@@ -0,0 +1,112 @@
+with
+     physics.Shape,
+     physics.Model,
+     lace.Any;
+
+package physics.Object
+--
+-- Provide an interface for physics objects.
+--
+is
+   type Item is  limited interface
+             and lace.Any.limited_item;
+
+   type View  is access all Item'Class;
+   type Views is array (Positive range <>) of View;
+
+
+   ----------
+   --- Forge
+   --
+   procedure define (Self : access Item;   Shape       : in physics.Shape.view;
+                                           Mass        : in Real;
+                                           Friction    : in Real;
+                                           Restitution : in Real;
+                                           at_Site     : in Vector_3) is abstract;
+
+   procedure destruct (Self : in out Item)   is abstract;
+   procedure free     (Self : in out View);
+
+
+   ---------------
+   --- Attributes
+   --
+
+   procedure user_Data_is (Self : in out Item;   Now : access lace.Any.limited_item'Class)   is abstract;
+   function  user_Data    (Self : in     Item)  return access lace.Any.limited_item'Class    is abstract;
+
+   function  Mass         (Self : in     Item)  return Real                                  is abstract;
+
+   function  Model        (Self : in     Item)     return physics.Model.view   is abstract;
+   procedure Model_is     (Self : in out Item;   Now : in physics.Model.view)  is abstract;
+
+   function  Shape        (Self : in     Item)     return physics.Shape.view   is abstract;
+
+   function  Scale        (Self : in     Item)     return Vector_3             is abstract;
+   procedure Scale_is     (Self : in out Item;   Now : in Vector_3)            is abstract;
+
+
+   --- Dynamics
+   --
+
+   protected
+   type safe_Dynamics
+   is
+      procedure set (To : in Matrix_4x4);
+      function  get   return Matrix_4x4;
+
+      procedure set_Spin (To : in Matrix_3x3);
+      function  get_Spin   return Matrix_3x3;
+
+      procedure set_Site (To : in Vector_3);
+      function  get_Site   return Vector_3;
+
+   private
+      Dynamics : Matrix_4x4 := Identity_4x4;
+   end safe_Dynamics;
+
+
+   procedure update_Dynamics (Self : in out Item)                     is abstract;
+   function     get_Dynamics (Self : in     Item) return Matrix_4x4   is abstract;
+
+   procedure activate        (Self : in out Item;   force_Activation : in Boolean := False)   is abstract;
+
+
+   function  Site            (Self : in     Item)     return Vector_3      is abstract;
+   procedure Site_is         (Self : in out Item;   Now : in Vector_3)     is abstract;
+
+   function  Spin            (Self : in     Item)     return Matrix_3x3    is abstract;
+   procedure Spin_is         (Self : in out Item;   Now : in Matrix_3x3)   is abstract;
+
+   function  xy_Spin         (Self : in     Item)     return Radians       is abstract;
+   procedure xy_Spin_is      (Self : in out Item;   Now : in Radians)      is abstract;
+
+   function  Transform       (Self : in     Item)     return Matrix_4x4    is abstract;
+   procedure Transform_is    (Self : in out Item;   Now : in Matrix_4x4)   is abstract;
+
+   function  Speed           (Self : in     Item)     return Vector_3      is abstract;
+   procedure Speed_is        (Self : in out Item;   Now : in Vector_3)     is abstract;
+
+   function  Gyre            (Self : in     Item)     return Vector_3      is abstract;
+   procedure Gyre_is         (Self : in out Item;   Now : in Vector_3)     is abstract;
+
+   function  is_Active       (Self : in     Item)     return Boolean       is abstract;
+
+   procedure Friction_is     (Self : in out Item;   Now : in Real)         is abstract;
+   procedure Restitution_is  (Self : in out Item;   Now : in Real)         is abstract;
+
+
+   ---------------
+   --- Operations
+   --
+
+   --- Forces
+   --
+
+   procedure apply_Torque         (Self : in out Item;   Torque : in Vector_3)   is abstract;
+   procedure apply_Torque_impulse (Self : in out Item;   Torque : in Vector_3)   is abstract;
+
+   procedure apply_Force          (Self : in out Item;   Force  : in Vector_3)   is abstract;
+
+
+end physics.Object;

3-mid/physics/interface/source/physics-remote-model.ads

@@ -0,0 +1,16 @@
+package physics.remote.Model
+--
+--  A model describing physical properties, usable with DSA.
+--
+is
+   pragma remote_Types;
+
+   type Item is abstract tagged
+      record
+         Id    : model_Id := null_model_Id;
+         Scale : Vector_3 := [1.0, 1.0, 1.0];
+      end record;
+
+end physics.remote.Model;
+
+

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

@@ -0,0 +1,8 @@
+package physics.Remote
+--
+-- Provide a namespace for remote (DSA) physics classes.
+--
+is
+   pragma Pure;
+
+end physics.Remote;

3-mid/physics/interface/source/physics-shape.adb

@@ -0,0 +1,18 @@
+with
+     ada.unchecked_Deallocation;
+
+package body physics.Shape
+is
+
+   procedure free (Self : in out View)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (Item'Class, View);
+   begin
+      if Self /= null then
+         Self.destruct;
+      end if;
+
+      deallocate (Self);
+   end free;
+
+end physics.Shape;

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

@@ -0,0 +1,17 @@
+package physics.Shape
+--
+-- Models a physical shape.
+--
+is
+   type Item is limited interface;
+   type View is access all Item'Class;
+
+   procedure define (Self : in out Item) is abstract;
+
+   procedure free     (Self : in out View);
+
+   procedure Scale_is (Self : in out Item;   Now : in math.Vector_3) is abstract;
+   procedure evolve   (Self : in out Item;   By  : in Duration)      is null;
+   procedure destruct (Self : in out Item)                           is abstract;
+
+end physics.Shape;

3-mid/physics/interface/source/physics-space.adb

@@ -0,0 +1,15 @@
+with
+     ada.unchecked_Deallocation;
+
+package body physics.Space
+is
+
+   procedure free (Self : in out View)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (Item'Class, View);
+   begin
+      Self.destruct;
+      deallocate (Self);
+   end free;
+
+end physics.Space;

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

@@ -0,0 +1,207 @@
+with
+     physics.Model,
+     physics.Shape,
+     physics.Object,
+     physics.Joint.DoF6,
+     physics.Joint.hinge,
+     physics.Joint.cone_twist,
+     physics.Joint.slider,
+     physics.Joint.ball;
+
+package physics.Space
+--
+-- Models a static/dynamic physics space.
+--
+is
+   type Item is limited interface;
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   procedure free     (Self : in out View);
+   procedure destruct (Self : in out Item)  is abstract;
+
+
+   --------------
+   --- Attributes
+   --
+
+   procedure add    (Self : in out Item;   the_Object : in Object.view)   is abstract;
+   procedure rid    (Self : in out Item;   the_Object : in Object.view)   is abstract;
+   procedure evolve (Self : in out Item;   By         : in Duration)      is abstract;
+
+
+   type Real_view is access all Real;
+
+
+   --- Contacts
+   --
+
+   type a_Contact is
+      record
+         Site : Vector_3;
+      end record;
+
+   type Contacts is array (Positive range 1 .. 4) of a_Contact;
+
+
+   --- Manifolds
+   --
+
+   type a_Manifold is
+      record
+         Objects       : Object.views (1 .. 2);
+         Contact       : a_Contact;
+      end record;
+
+   function manifold_Count (Self : in     Item) return Natural                             is abstract;
+   function Manifold       (Self : access Item;   Index : in Positive) return a_Manifold   is abstract;
+
+
+   --- Ray Casting
+   --
+
+   type ray_Collision is
+      record
+         near_Object  : Object.view;
+         hit_Fraction : Real;
+         Normal_world : Vector_3;
+         Site_world   : Vector_3;
+      end record;
+
+   function  cast_Ray (Self : access Item;    From, To : in Vector_3) return ray_Collision   is abstract;
+
+
+   --- Bounds
+   --
+
+   procedure update_Bounds (Self : in out Item;   of_Obect : in Object.view)   is abstract;
+
+
+   -----------
+   --- Factory
+   --
+
+   unsupported_Shape : exception;
+
+
+   --- Physical Objects
+   --
+
+   function new_Object   (Self : access Item;   of_Shape      : in Shape.view;
+                                                 of_Mass      : in Real;
+                                                 Friction     : in Real;
+                                                 Restitution  : in Real;
+                                                 at_Site      : in Vector_3;
+                                                 is_Kinematic : in Boolean) return Object.view   is abstract;
+
+   function object_Count (Self : in     Item) return Natural   is abstract;
+
+
+   --- 3D
+   --
+
+   --  Shapes
+   --
+
+   function              new_Shape (Self : access Item;   from_Model : in Model.view)                        return Shape.view   is abstract;
+
+   function          new_box_Shape (Self : access Item;   half_Extents : in     Vector_3 := [0.5, 0.5, 0.5]) return Shape.view   is abstract;
+   function       new_sphere_Shape (Self : access Item;   Radius       : in     Real     :=  0.5)            return Shape.view   is abstract;
+   function      new_capsule_Shape (Self : access Item;   Radius       : in     Real     :=  0.5;
+                                                          Height       : in     Real)                        return Shape.view   is abstract;
+   function         new_cone_Shape (Self : access Item;   Radius       : in     Real     :=  0.5;
+                                                          Height       : in     Real     :=  1.0)            return Shape.view   is abstract;
+   function     new_cylinder_Shape (Self : access Item;   half_Extents : in     Vector_3 := [0.5, 0.5, 0.5]) return Shape.view   is abstract;
+   function  new_heightfield_Shape (Self : access Item;   Heightfield  : in out physics.Heightfield;
+                                                          Scale        : in     Vector_3)                    return Shape.view   is abstract;
+   function  new_multisphere_Shape (Self : access Item;   Sites        : in     Vector_3_array;
+                                                          Radii        : in     Vector)                      return Shape.view   is abstract;
+   function        new_plane_Shape (Self : access Item;   Normal       : in     Vector_3 := [0.0, 1.0, 0.0];
+                                                          Offset       : in     Real     :=  0.0)            return Shape.view   is abstract;
+   function  new_convex_hull_Shape (Self : access Item;   Points       : in     Vector_3_array)              return Shape.view   is abstract;
+   function         new_mesh_Shape (Self : access Item;   Points       : access Geometry_3D.a_Model)         return Shape.view   is abstract;
+
+
+   --  Joints
+   --
+
+   function new_hinge_Joint      (Self : access Item;   Object_A,
+                                                        Object_B     : in Object.view;
+                                                        Anchor_in_A,
+                                                        Anchor_in_B  : in Vector_3;
+                                                        pivot_Axis   : in Vector_3;
+                                                        low_Limit,
+                                                        high_Limit        : in Real;
+                                                        collide_Connected : in Boolean) return Joint.hinge.view is abstract;
+
+   function new_hinge_Joint      (Self : access Item;   Object_A,
+                                                        Object_B     : in Object.view;
+                                                        Frame_A,
+                                                        Frame_B      : in Matrix_4x4;
+                                                        low_Limit,
+                                                        high_Limit   : in Real;
+                                                        collide_Connected : in Boolean) return Joint.hinge.view is abstract;
+
+   function new_hinge_Joint      (Self : access Item;   Object_A     : in Object.view;
+                                                        Frame_A      : in Matrix_4x4)   return Joint.hinge.view is abstract;
+
+   function new_DoF6_Joint       (Self : access Item;   Object_A,
+                                                        Object_B     : in Object.view;
+                                                        Frame_A,
+                                                        Frame_B      : in Matrix_4x4)   return Joint.DoF6.view  is abstract;
+
+   function new_ball_Joint       (Self : access Item;   Object_A,
+                                                        Object_B     : in Object.view;
+                                                        Pivot_in_A,
+                                                        Pivot_in_B   : in Vector_3)     return Joint.ball.view  is abstract;
+
+   function new_slider_Joint     (Self : access Item;   Object_A,
+                                                        Object_B     : in Object.view;
+                                                        Frame_A,
+                                                        Frame_B      : in Matrix_4x4)  return Joint.slider.view is abstract;
+
+   function new_cone_twist_Joint (Self : access Item;   Object_A,
+                                                        Object_B     : in Object.view;
+                                                        Frame_A,
+                                                        Frame_B      : in Matrix_4x4)  return Joint.cone_twist.view is abstract;
+   type joint_Cursor is interface;
+
+   procedure next        (Cursor : in out joint_Cursor)                             is abstract;
+   function  has_Element (Cursor : in     joint_Cursor) return Boolean              is abstract;
+   function  Element     (Cursor : in     joint_Cursor) return Joint.view           is abstract;
+
+   function  first_Joint (Self   : in     Item)         return joint_Cursor'Class   is abstract;
+
+
+   --- 2D
+   --
+
+   --- Shapes
+   --
+
+   type polygon_Vertices is array (Positive range <>) of aliased Vector_2;
+
+   function new_circle_Shape  (Self : access Item;   Radius   : in Real := 0.5)      return Shape.view is abstract;
+   function new_polygon_Shape (Self : access Item;   Vertices : in polygon_Vertices) return Shape.view is abstract;
+
+
+   ------------
+   --  Dynamics
+   --
+
+   function  Gravity    (Self : in     Item)     return Vector_3             is abstract;
+   procedure Gravity_is (Self : in out Item;   Now : in Vector_3)            is abstract;
+
+   procedure add        (Self : in out Item;   the_Joint    : in Joint.view) is abstract;
+   procedure rid        (Self : in out Item;   the_Joint    : in Joint.view) is abstract;
+
+   procedure set_Joint_local_Anchor
+                        (Self : in out Item;   the_Joint    : in Joint.view;
+                                               is_Anchor_A  : in Boolean;
+                                               local_Anchor : in Vector_3)   is abstract;
+
+end physics.Space;

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

@@ -0,0 +1,44 @@
+with
+     float_Math.Geometry.D2,
+     float_Math.Geometry.D3,
+     float_Math.Algebra.linear.D3;
+
+package Physics
+--
+--  Provides a physics interface for 2D/3D simulations.
+--
+is
+   pragma Pure;
+
+   package Math              renames float_Math;
+   package Geometry_2D       renames math.Geometry.d2;
+   package Geometry_3D       renames math.Geometry.d3;
+   package linear_Algebra_3D renames math.Algebra.linear.d3;
+
+   use Math;
+
+   type Vector_2_array is array (Positive range <>) of Vector_2;
+   type Vector_3_array is array (Positive range <>) of Vector_3;
+
+   type Heightfield    is array (Positive range <>,
+                                 Positive range <>) of aliased Real;
+
+
+   type space_Kind is (Bullet, Box2D);
+
+   max_Models : constant := 2**32 - 1;
+   type model_Id is range 0 .. max_Models;
+
+   null_model_Id : constant physics.model_Id;
+
+
+   unsupported_Error : exception;
+   --
+   -- Raised when a shape or joint is not supported in a space.
+
+
+private
+
+   null_model_Id : constant physics.model_Id := 0;
+
+end Physics;

3-mid/physics/interface/source/private/box2d/box2d_physics-joint.adb

@@ -0,0 +1,993 @@
+with
+     box2d_c.Binding,
+     box2d_physics.Object,
+
+     c_math_c.Vector_3,
+     c_math_c.Matrix_4x4,
+     c_math_c.Conversion,
+     Swig,
+     interfaces.C,
+
+     ada.unchecked_Deallocation,
+     ada.unchecked_Conversion;
+
+package body box2d_Physics.Joint
+is
+   use c_math_c.Conversion,
+       box2d_c.Binding,
+       Interfaces;
+
+
+   type Any_limited_view is access all lace.Any.limited_item'Class;
+
+   function to_Any_view    is new ada.unchecked_Conversion (Swig.void_ptr, Any_limited_view);
+   function to_Object_view is new ada.unchecked_Conversion (swig.void_ptr, physics.Object.view);
+   pragma Unreferenced (to_Object_view);
+
+
+   --  procedure set_b2d_user_Data (Self : in View)
+   --  is
+   --     function to_void_ptr is new ada.Unchecked_Conversion (Any_limited_view, Swig.void_ptr);
+   --     Self_as_any : constant Any_limited_view := Any_limited_view (Self);
+   --  begin
+   --     b2d_Joint_user_Data_is (Self.C, to_void_ptr (Self_as_any));
+   --  end set_b2d_user_Data;
+
+
+   overriding
+   function reaction_Force (Self : in Item) return Vector_3
+   is
+   begin
+      return +b2d_Joint_reaction_Force (Self.C);
+   end reaction_Force;
+
+
+   overriding
+   function reaction_Torque (Self : in Item) return Real
+   is
+   begin
+      return +b2d_Joint_reaction_Torque (Self.C);
+   end reaction_Torque;
+
+
+   overriding
+   procedure user_Data_is (Self : in out Item;   Now : access lace.Any.limited_item'Class)
+   is
+   begin
+      Self.user_Data := Now;
+   end user_Data_is;
+
+
+   overriding
+   function user_Data (Self : in Item) return access lace.Any.limited_item'Class
+   is
+   begin
+      return Self.user_Data;
+   end user_Data;
+
+
+   --------
+   --  DoF6
+   --
+
+   function new_Dof6_Joint (Object_A, Object_B : in physics.Object.view;
+                            Frame_A,  Frame_B  : in Matrix_4x4) return physics.Joint.DoF6.view
+   is
+      Self       : constant DoF6_view := new DoF6;
+      pragma Unreferenced (Self);
+
+      c_Object_A : box2d_C.Pointers.Object_Pointer := box2d_physics.Object.view (Object_A).C;
+      c_Object_B : box2d_C.Pointers.Object_Pointer := box2d_physics.Object.view (Object_B).C;
+
+      c_Frame_A  : aliased c_math_c.Matrix_4x4.item := +Frame_A;
+      c_Frame_B  : aliased c_math_c.Matrix_4x4.item := +Frame_B;
+   begin
+      return null;
+   end new_Dof6_Joint;
+
+
+   overriding
+   procedure destruct (Self : in out DoF6)
+   is
+   begin
+      raise Program_Error with "TBD";
+   end destruct;
+
+
+   overriding
+   function Object_A (Self : in DoF6) return physics.Object.view
+   is
+      c_Object_A : constant box2d_c.Pointers.Object_Pointer := b2d_Joint_Object_A (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b2d_Object_user_Data (c_Object_A)));
+   end Object_A;
+
+
+   overriding
+   function Object_B (Self : in DoF6) return physics.Object.view
+   is
+      c_Object_B : constant box2d_c.Pointers.Object_Pointer := b2d_Joint_Object_B (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b2d_Object_user_Data (c_Object_B)));
+   end Object_B;
+
+
+   overriding
+   function Frame_A (Self : in DoF6) return Matrix_4x4
+   is
+   begin
+      return +b2d_Joint_Frame_A (Self.C);
+   end Frame_A;
+
+
+   overriding
+   function Frame_B (Self : in DoF6) return Matrix_4x4
+   is
+   begin
+      return +b2d_Joint_Frame_B (Self.C);
+   end Frame_B;
+
+
+   overriding
+   procedure Frame_A_is (Self : in out DoF6;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b2d_Joint_Frame_A_is (Self.C, c_Now'unchecked_Access);
+   end Frame_A_is;
+
+
+   overriding
+   procedure Frame_B_is (Self : in out DoF6;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b2d_Joint_Frame_B_is (Self.C, c_Now'unchecked_Access);
+   end Frame_B_is;
+
+
+   overriding
+   function is_Limited (Self : in DoF6;   DoF : Degree_of_freedom) return Boolean
+   is
+      use type Swig.bool;
+   begin
+      return b2d_Joint_is_Limited (Self.C, Degree_of_freedom'Pos (DoF)) /= 0;
+   end is_Limited;
+
+
+   overriding
+   procedure Velocity_is (Self : in out DoF6;   Now : in Real;
+                                                DoF : in Degree_of_freedom)
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & Degree_of_freedom'Image (DoF);
+      end if;
+
+      b2d_Joint_Velocity_is (Self.C, C.int (Now),
+                                     c_math_c.Real (DoF));
+   end Velocity_is;
+
+
+   overriding
+   function Extent (Self : in DoF6;   DoF : Degree_of_freedom) return Real
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & Degree_of_freedom'Image (DoF);
+      end if;
+
+      return Real (b2d_Joint_Extent (Self.C, C.int (DoF)));
+   end Extent;
+
+
+   overriding
+   procedure desired_Extent_is (Self : in out DoF6;   Now : in Real;
+                                                      DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end desired_Extent_is;
+
+
+   overriding
+   function lower_Limit (Self : in DoF6;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end lower_Limit;
+
+
+   overriding
+   function upper_Limit (Self : in DoF6;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end upper_Limit;
+
+
+   overriding
+   procedure lower_Limit_is (Self : in out DoF6;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end lower_Limit_is;
+
+
+   overriding
+   procedure upper_Limit_is (Self : in out DoF6;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end upper_Limit_is;
+
+
+   --------
+   --  Ball
+   --
+
+   function new_Ball_Joint (Object_A,   Object_B   : in physics.Object.view;
+                            Pivot_in_A, Pivot_in_B : in Vector_3) return physics.Joint.ball.view
+   is
+      Self         : constant Ball_view := new Ball;
+
+      c_Object_A   : constant box2d_C.Pointers.Object_Pointer := box2d_physics.Object.view (Object_A).C;
+      c_Object_B   : constant box2d_C.Pointers.Object_Pointer := box2d_physics.Object.view (Object_B).C;
+
+      c_Pivot_in_A : aliased c_math_c.Vector_3.item := +Pivot_in_A;
+      c_Pivot_in_B : aliased c_math_c.Vector_3.item := +Pivot_in_B;
+   begin
+      Self.C := b2d_new_ball_Joint (c_Object_A,
+                                    c_Object_B,
+                                    c_Pivot_in_A'unchecked_Access,
+                                    c_Pivot_in_B'unchecked_Access);
+      return Self;
+   end new_Ball_Joint;
+
+
+   overriding
+   procedure destruct (Self : in out Ball)
+   is
+   begin
+      raise Error with "TODO";
+   end destruct;
+
+
+   overriding
+   function Object_A (Self : in Ball) return physics.Object.view
+   is
+      c_Object_A : constant box2d_c.Pointers.Object_Pointer := b2d_Joint_Object_A (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b2d_Object_user_Data (c_Object_A)));
+   end Object_A;
+
+
+   overriding
+   function Object_B (Self : in Ball) return physics.Object.view
+   is
+      c_Object_B : constant box2d_c.Pointers.Object_Pointer := b2d_Joint_Object_B (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b2d_Object_user_Data (c_Object_B)));
+   end Object_B;
+
+
+   overriding
+   function Frame_A (Self : in Ball) return Matrix_4x4
+   is
+   begin
+      return +b2d_Joint_Frame_A (Self.C);
+   end Frame_A;
+
+
+   overriding
+   function Frame_B (Self : in Ball) return Matrix_4x4
+   is
+   begin
+      return +b2d_Joint_Frame_B (Self.C);
+   end Frame_B;
+
+
+   overriding
+   procedure Frame_A_is (Self : in out Ball;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b2d_Joint_Frame_A_is (Self.C, c_Now'unchecked_Access);
+   end Frame_A_is;
+
+
+   overriding
+   procedure Frame_B_is (Self : in out Ball;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b2d_Joint_Frame_B_is (Self.C, c_Now'unchecked_Access);
+   end Frame_B_is;
+
+
+   overriding
+   function is_Limited (Self : in Ball;   DoF : Degree_of_freedom) return Boolean
+   is
+      use type Swig.bool;
+   begin
+      return b2d_Joint_is_Limited (Self.C, Degree_of_freedom'Pos (DoF))  /=  0;
+   end is_Limited;
+
+
+   overriding
+   procedure Velocity_is (Self : in out Ball;   Now : in Real;
+                                                DoF : in Degree_of_freedom)
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & Degree_of_freedom'Image (DoF);
+      end if;
+
+      b2d_Joint_Velocity_is (Self.C, C.int (Now),
+                                     c_math_c.Real (DoF));
+   end Velocity_is;
+
+
+   overriding
+   function Extent (Self : in Ball;   DoF : Degree_of_freedom) return Real
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & Degree_of_freedom'Image (DoF);
+      end if;
+
+      return Real (b2d_Joint_Extent (Self.C, C.int (DoF)));
+   end Extent;
+
+
+   overriding
+   procedure desired_Extent_is (Self : in out Ball;   Now : in Real;
+                                                      DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end desired_Extent_is;
+
+
+   overriding
+   function lower_Limit (Self : in Ball;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end lower_Limit;
+
+
+   overriding
+   function upper_Limit (Self : in Ball;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end upper_Limit;
+
+
+   overriding
+   procedure lower_Limit_is (Self : in out Ball;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end lower_Limit_is;
+
+
+   overriding
+   procedure upper_Limit_is (Self : in out Ball;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end upper_Limit_is;
+
+
+   ----------
+   --  Slider
+   --
+
+   function new_Slider_Joint (Object_A, Object_B : in physics.Object.view;
+                              Frame_A,  Frame_B  : in Matrix_4x4) return physics.Joint.slider.view
+   is
+      Self       : constant Slider_view := new Slider;
+
+      c_Object_A : constant box2d_C.Pointers.Object_Pointer := box2d_physics.Object.view (Object_A).C;
+      c_Object_B : constant box2d_C.Pointers.Object_Pointer := box2d_physics.Object.view (Object_B).C;
+
+      c_Frame_A  : aliased  c_math_c.Matrix_4x4.item := +Frame_A;
+      c_Frame_B  : aliased  c_math_c.Matrix_4x4.item := +Frame_B;
+   begin
+      Self.C := b2d_new_slider_Joint (c_Object_A,
+                                      c_Object_B,
+                                      c_Frame_A'unchecked_Access,
+                                      c_Frame_B'unchecked_Access);
+      return Self;
+   end new_Slider_Joint;
+
+
+   overriding
+   procedure destruct (Self : in out Slider)
+   is
+   begin
+      raise Error with "TODO";
+   end destruct;
+
+
+   overriding
+   function Object_A (Self : in Slider) return physics.Object.view
+   is
+      c_Object_A : constant box2d_c.Pointers.Object_Pointer := b2d_Joint_Object_A (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b2d_Object_user_Data (c_Object_A)));
+   end Object_A;
+
+
+   overriding
+   function Object_B (Self : in Slider) return physics.Object.view
+   is
+      c_Object_B : constant box2d_c.Pointers.Object_Pointer := b2d_Joint_Object_B (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b2d_Object_user_Data (c_Object_B)));
+   end Object_B;
+
+
+   overriding
+   function Frame_A (Self : in Slider) return Matrix_4x4
+   is
+   begin
+      return +b2d_Joint_Frame_A (Self.C);
+   end Frame_A;
+
+
+   overriding
+   function Frame_B (Self : in Slider) return Matrix_4x4
+   is
+   begin
+      return +b2d_Joint_Frame_B (Self.C);
+   end Frame_B;
+
+
+   overriding
+   procedure Frame_A_is (Self : in out Slider;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b2d_Joint_Frame_A_is (Self.C, c_Now'unchecked_Access);
+   end Frame_A_is;
+
+
+   overriding
+   procedure Frame_B_is (Self : in out Slider;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b2d_Joint_Frame_B_is (Self.C, c_Now'unchecked_Access);
+   end Frame_B_is;
+
+
+   overriding
+   function is_Limited (Self : in Slider;   DoF : Degree_of_freedom) return Boolean
+   is
+      use type Swig.bool;
+   begin
+      return b2d_Joint_is_Limited (Self.C, Degree_of_freedom'Pos (DoF)) /= 0;
+   end is_Limited;
+
+
+   overriding
+   procedure Velocity_is (Self : in out Slider;   Now : in Real;
+                                                  DoF : in Degree_of_freedom)
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & Degree_of_freedom'Image (DoF);
+      end if;
+
+      b2d_Joint_Velocity_is (Self.C, C.int (Now),
+                                     c_math_c.Real (DoF));
+   end Velocity_is;
+
+
+   overriding
+   function Extent (Self : in Slider;   DoF : Degree_of_freedom) return Real
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & Degree_of_freedom'Image (DoF);
+      end if;
+
+      return Real (b2d_Joint_Extent (Self.C, C.int (DoF)));
+   end Extent;
+
+
+   overriding
+   procedure desired_Extent_is (Self : in out Slider;   Now : in Real;
+                                                        DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end desired_Extent_is;
+
+
+   overriding
+   function lower_Limit (Self : in Slider;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end lower_Limit;
+
+
+   overriding
+   function upper_Limit (Self : in Slider;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end upper_Limit;
+
+
+   overriding
+   procedure lower_Limit_is (Self : in out Slider;   Now : in Real;
+                                                     DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end lower_Limit_is;
+
+
+   overriding
+   procedure upper_Limit_is (Self : in out Slider;   Now : in Real;
+                                                     DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end upper_Limit_is;
+
+
+   --------------
+   --  cone_Twist
+   --
+
+   function new_cone_Twist_Joint (Object_A, Object_B : in physics.Object.view;
+                                  Frame_A,  Frame_B  : in Matrix_4x4) return physics.Joint.cone_twist.view
+   is
+      Self       : constant cone_Twist_view := new cone_Twist;
+
+      c_Object_A : constant box2d_C.Pointers.Object_Pointer := box2d_physics.Object.view (Object_A).C;
+      c_Object_B : constant box2d_C.Pointers.Object_Pointer := box2d_physics.Object.view (Object_B).C;
+
+      c_Frame_A  : aliased c_math_c.Matrix_4x4.item := +Frame_A;
+      c_Frame_B  : aliased c_math_c.Matrix_4x4.item := +Frame_B;
+   begin
+      Self.C := b2d_new_DoF6_Joint (c_Object_A,
+                                    c_Object_B,
+                                    c_Frame_A'unchecked_Access,
+                                    c_Frame_B'unchecked_Access);
+      return Self;
+   end new_cone_Twist_Joint;
+
+
+   overriding
+   procedure destruct (Self : in out cone_Twist)
+   is
+   begin
+      raise Error with "TODO";
+   end destruct;
+
+
+   overriding
+   function Object_A (Self : in cone_Twist) return physics.Object.view
+   is
+      c_Object_A : constant box2d_c.Pointers.Object_Pointer := b2d_Joint_Object_A (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b2d_Object_user_Data (c_Object_A)));
+   end Object_A;
+
+
+   overriding
+   function Object_B (Self : in cone_Twist) return physics.Object.view
+   is
+      c_Object_B : constant box2d_c.Pointers.Object_Pointer := b2d_Joint_Object_B (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b2d_Object_user_Data (c_Object_B)));
+   end Object_B;
+
+
+   overriding
+   function Frame_A (Self : in cone_Twist) return Matrix_4x4
+   is
+   begin
+      return +b2d_Joint_Frame_A (Self.C);
+   end Frame_A;
+
+
+   overriding
+   function Frame_B (Self : in cone_Twist) return Matrix_4x4
+   is
+   begin
+      return +b2d_Joint_Frame_B (Self.C);
+   end Frame_B;
+
+
+   overriding
+   procedure Frame_A_is (Self : in out cone_Twist;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b2d_Joint_Frame_A_is (Self.C, c_Now'unchecked_Access);
+   end Frame_A_is;
+
+
+   overriding
+   procedure Frame_B_is (Self : in out cone_Twist;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b2d_Joint_Frame_B_is (Self.C, c_Now'unchecked_Access);
+   end Frame_B_is;
+
+
+   overriding
+   function is_Limited (Self : in cone_Twist;   DoF : Degree_of_freedom) return Boolean
+   is
+      use type Swig.bool;
+   begin
+      return b2d_Joint_is_Limited (Self.C, Degree_of_freedom'Pos (DoF))  /=  0;
+   end is_Limited;
+
+
+   overriding
+   procedure Velocity_is (Self : in out cone_Twist;   Now : in Real;
+                                                      DoF : in Degree_of_freedom)
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & Degree_of_freedom'Image (DoF);
+      end if;
+
+      b2d_Joint_Velocity_is (Self.C, C.int (Now),
+                                     c_math_c.Real (DoF));
+   end Velocity_is;
+
+
+   overriding
+   function Extent (Self : in cone_Twist;   DoF : Degree_of_freedom) return Real
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & Degree_of_freedom'Image (DoF);
+      end if;
+
+      return Real (b2d_Joint_Extent (Self.C, C.int (DoF)));
+   end Extent;
+
+
+   overriding
+   procedure desired_Extent_is (Self : in out cone_Twist;   Now : in Real;
+                                                            DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end desired_Extent_is;
+
+
+   overriding
+   function lower_Limit (Self : in cone_Twist;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end lower_Limit;
+
+
+   overriding
+   function upper_Limit (Self : in cone_Twist;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end upper_Limit;
+
+
+   overriding
+   procedure lower_Limit_is (Self : in out cone_Twist;   Now : in Real;
+                                                         DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end lower_Limit_is;
+
+
+   overriding
+   procedure upper_Limit_is (Self : in out cone_Twist;   Now : in Real;
+                                                         DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end upper_Limit_is;
+
+
+   ---------
+   --  Hinge
+   --
+
+   function new_hinge_Joint (in_Space                 : in box2d_c.Pointers.Space_Pointer;
+                             Object_A,    Object_B    : in physics.Object.view;
+                             Anchor_in_A, Anchor_in_B : in Vector_3;
+                             low_Limit,   high_Limit  : in math.Real;
+                             collide_Conected         : in Boolean) return physics.Joint.hinge.view
+   is
+      use type box2d_physics.Object.view,
+               physics.Object.view;
+
+      Self           : constant Hinge_view := new Hinge;
+
+      c_Object_A     : box2d_C.Pointers.Object_Pointer;
+      c_Object_B     : box2d_C.Pointers.Object_Pointer;
+
+      c_Anchor_in_A  : aliased c_math_c.Vector_3.item := +Anchor_in_A;
+      c_Anchor_in_B  : aliased c_math_c.Vector_3.item := +Anchor_in_B;
+
+   begin
+      if   Object_A = null
+        or Object_B = null
+      then
+         raise Error with "Null object detected.";
+      end if;
+
+      if box2d_physics.Object.view (Object_A) /= null
+      then
+         c_Object_A := box2d_physics.Object.view (Object_A).C;
+      end if;
+
+      if box2d_physics.Object.view (Object_B) /= null
+      then
+         c_Object_B := box2d_physics.Object.view (Object_B).C;
+      end if;
+
+      Self.C := b2d_new_hinge_Joint_with_local_anchors (in_Space,
+                                                        c_Object_A,
+                                                        c_Object_B,
+                                                        c_Anchor_in_A'unchecked_Access,
+                                                        c_Anchor_in_B'unchecked_Access,
+                                                        c_math_c.Real (low_Limit),
+                                                        c_math_c.Real (high_Limit),
+                                                        Boolean'Pos (collide_Conected));
+      return Self;
+   end new_hinge_Joint;
+
+
+   function new_hinge_Joint (Object_A : in physics.Object.view;
+                             Frame_A  : in Matrix_4x4) return physics.Joint.hinge.view
+   is
+      use type box2d_physics.Object.view;
+
+      Self : constant Hinge_view := new Hinge;
+
+      c_Object_A : constant box2d_C.Pointers.Object_Pointer := box2d_physics.Object.view (Object_A).C;
+      c_Frame_A  : aliased  c_math_c.Matrix_4x4.item        := +Frame_A;
+   begin
+      Self.C := b2d_new_space_hinge_Joint (c_Object_A,
+                                           c_Frame_A'unchecked_Access);
+      return Self;
+   end new_hinge_Joint;
+
+
+   function new_hinge_Joint (in_Space              : in box2d_c.Pointers.Space_Pointer;
+                             Object_A,  Object_B   : in physics.Object.view;
+                             Frame_A,   Frame_B    : in Matrix_4x4;
+                             low_Limit, high_Limit : in math.Real;
+                             collide_Conected      : in Boolean) return physics.Joint.hinge.view
+   is
+      use type box2d_physics.Object.view,
+               physics.Object.view;
+
+      Self : constant Hinge_view := new Hinge;
+
+      c_Object_A : box2d_C.Pointers.Object_Pointer;
+      c_Object_B : box2d_C.Pointers.Object_Pointer;
+
+      c_Frame_A  : aliased c_math_c.Matrix_4x4.item := +Frame_A;
+      c_Frame_B  : aliased c_math_c.Matrix_4x4.item := +Frame_B;
+   begin
+      if   Object_A = null
+        or Object_B = null
+      then
+         raise Error with "Null object detected.";
+      end if;
+
+      if box2d_physics.Object.view (Object_A) /= null
+      then
+         c_Object_A := box2d_physics.Object.view (Object_A).C;
+      end if;
+
+      if box2d_physics.Object.view (Object_B) /= null
+      then
+         c_Object_B := box2d_physics.Object.view (Object_B).C;
+      end if;
+
+      Self.C := b2d_new_hinge_Joint (in_Space,
+                                     c_Object_A,
+                                     c_Object_B,
+                                     c_Frame_A'unchecked_Access,
+                                     c_Frame_B'unchecked_Access,
+                                     c_math_c.Real (low_Limit),
+                                     c_math_c.Real (high_Limit),
+                                     Boolean'Pos (collide_Conected));
+      return Self;
+   end new_hinge_Joint;
+
+
+   overriding
+   procedure destruct (Self : in out Hinge)
+   is
+   begin
+      b2d_free_hinge_Joint (Self.C);
+      Self.C := null;
+   end destruct;
+
+
+   overriding
+   procedure Limits_are (Self : in out Hinge;   Low, High        : in Real;
+                                                Softness         : in Real := 0.9;
+                                                biasFactor       : in Real := 0.3;
+                                                relaxationFactor : in Real := 1.0)
+   is
+   begin
+      b2d_Joint_hinge_Limits_are (Self.C, c_math_c.Real (Low),
+                                          c_math_c.Real (High));
+   end Limits_are;
+
+
+   overriding
+   function lower_Limit (Self : in Hinge) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end lower_Limit;
+
+
+   overriding
+   function upper_Limit (Self : in Hinge) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end upper_Limit;
+
+
+   overriding
+   function Angle (Self : in Hinge) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end Angle;
+
+
+   overriding
+   function Object_A (Self : in Hinge) return physics.Object.view
+   is
+   begin
+      raise Error with "TODO";
+      return null;
+   end Object_A;
+
+
+   overriding
+   function Object_B (Self : in Hinge) return physics.Object.view
+   is
+   begin
+      raise Error with "TODO";
+      return null;
+   end Object_B;
+
+
+   overriding
+   function Frame_A (Self : in Hinge) return Matrix_4x4
+   is
+      c_Frame : aliased c_math_c.Matrix_4x4.item;
+   begin
+      raise Error with "TODO";
+      return +c_Frame;
+   end Frame_A;
+
+
+   overriding
+   function Frame_B (Self : in Hinge) return Matrix_4x4
+   is
+      c_Frame : aliased c_math_c.Matrix_4x4.item;
+   begin
+      raise Error with "TODO";
+      return +c_Frame;
+   end Frame_B;
+
+
+   overriding
+   procedure Frame_A_is (Self : in out Hinge;   Now : in Matrix_4x4)
+   is
+      c_Frame : aliased constant c_math_c.Matrix_4x4.item := +Now;
+      pragma Unreferenced (c_Frame);
+   begin
+      raise Error with "TODO";
+   end Frame_A_is;
+
+
+   overriding
+   procedure Frame_B_is (Self : in out Hinge;   Now : in Matrix_4x4)
+   is
+      c_Frame : aliased constant c_math_c.Matrix_4x4.item := +Now;
+      pragma Unreferenced (c_Frame);
+   begin
+      raise Error with "TODO";
+   end Frame_B_is;
+
+
+   overriding
+   function is_Limited (Self : in Hinge;   DoF : Degree_of_freedom) return Boolean
+   is
+      pragma unreferenced (Self);
+   begin
+      return DoF = 1;
+   end is_Limited;
+
+
+   overriding
+   procedure Velocity_is (Self : in out Hinge;   Now : in Real;
+                                                 DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+
+      if DoF /= 1 then
+         raise Error with "Illegal degree of freedom:" & Degree_of_freedom'Image (DoF);
+      end if;
+   end Velocity_is;
+
+
+   overriding
+   function Extent (Self : in Hinge;   DoF : Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+
+      if DoF /= 1 then
+         raise Error with "Illegal degree of freedom:" & Degree_of_freedom'Image (DoF);
+      end if;
+
+      return 0.0;
+   end Extent;
+
+
+   overriding
+   procedure desired_Extent_is (Self : in out Hinge;   Now : in Real;
+                                                       DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end desired_Extent_is;
+
+
+   --------
+   --- Free
+   --
+
+   procedure free (the_Joint : in out physics.Joint.view)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (physics.Joint.item'Class,
+                                                              physics.Joint.view);
+   begin
+      deallocate (the_Joint);
+   end free;
+
+
+end box2d_Physics.Joint;

3-mid/physics/interface/source/private/box2d/box2d_physics-joint.ads

@@ -0,0 +1,350 @@
+with
+     physics.Joint.DoF6,
+     physics.Joint.cone_twist,
+     physics.Joint.slider,
+     physics.Joint.hinge,
+     physics.Joint.ball,
+
+     physics.Object,
+
+     box2d_C.Pointers,
+
+     lace.Any;
+
+package box2d_Physics.Joint
+--
+--  Provides glue between a physics joint and a Box2D joint.
+--
+is
+   type Item is abstract limited new physics.Joint.item with     -- TODO: Make private.
+      record
+         C         :        box2d_c.Pointers.Joint_Pointer;
+         user_Data : access lace.Any.limited_item'Class;
+      end record;
+
+   type View is access all Item'Class;
+
+
+   use Math;
+
+   function new_Dof6_Joint       (Object_A,   Object_B     : in physics.Object.view;
+                                  Frame_A,    Frame_B      : in Matrix_4x4) return physics.Joint.DoF6.view;
+
+   function new_ball_Joint       (Object_A,   Object_B     : in physics.Object.view;
+                                  Pivot_in_A, Pivot_in_B   : in Vector_3) return physics.Joint.ball.view;
+
+   function new_slider_Joint     (Object_A,   Object_B     : in physics.Object.view;
+                                  Frame_A,    Frame_B      : in Matrix_4x4) return physics.Joint.slider.view;
+
+   function new_cone_twist_Joint (Object_A,   Object_B     : in physics.Object.view;
+                                  Frame_A,    Frame_B      : in Matrix_4x4) return physics.Joint.cone_twist.view;
+
+   function new_hinge_Joint      (in_Space                 : in box2d_c.Pointers.Space_Pointer;
+                                  Object_A,    Object_B    : in physics.Object.view;
+                                  Anchor_in_A, Anchor_in_B : in Vector_3;
+                                  low_Limit,   high_Limit  : in math.Real;
+                                  collide_Conected         : in Boolean) return physics.Joint.hinge.view;
+
+   function new_hinge_Joint      (in_Space                 : in box2d_c.Pointers.Space_Pointer;
+                                  Object_A,   Object_B     : in physics.Object.view;
+                                  Frame_A,    Frame_B      : in Matrix_4x4;
+                                  low_Limit,  high_Limit   : in math.Real;
+                                  collide_Conected         : in Boolean) return physics.Joint.hinge.view;
+
+   function new_hinge_Joint      (Object_A                 : in physics.Object.view;
+                                  Frame_A                  : in Matrix_4x4) return physics.Joint.hinge.view;
+
+
+   procedure free (the_Joint : in out physics.Joint.view);
+
+   --  procedure set_b2d_user_Data (Self : in View);
+
+
+
+private
+
+   overriding
+   function  reaction_Force  (Self : in     Item) return Vector_3;
+
+   overriding
+   function  reaction_Torque (Self : in     Item) return Real;
+
+
+   overriding
+   procedure user_Data_is    (Self : in out Item;   Now : access lace.Any.limited_Item'Class);
+
+   overriding
+   function  user_Data       (Self : in     Item)  return access lace.Any.limited_Item'Class;
+
+
+   use physics.Joint;
+
+   --------
+   --  DoF6
+   --
+   type DoF6 is new Item
+                and physics.Joint.DoF6.item with
+      record
+         null;
+      end record;
+
+   type DoF6_view is access DoF6;
+
+
+   overriding
+   procedure destruct    (Self : in out DoF6);
+
+   overriding
+   function  Object_A    (Self : in     DoF6) return physics.Object.view;
+   overriding
+   function  Object_B    (Self : in     DoF6) return physics.Object.view;
+
+   overriding
+   function  Frame_A     (Self : in     DoF6) return Matrix_4x4;
+   overriding
+   function  Frame_B     (Self : in     DoF6) return Matrix_4x4;
+
+   overriding
+   procedure Frame_A_is  (Self : in out DoF6;   Now : in Matrix_4x4);
+   overriding
+   procedure Frame_B_is  (Self : in out DoF6;   Now : in Matrix_4x4);
+
+   overriding
+   function  is_Limited  (Self : in     DoF6;   DoF : Degree_of_freedom) return Boolean;
+
+   overriding
+   procedure Velocity_is (Self : in out DoF6;   Now : in Real;
+                                                DoF : in Degree_of_freedom);
+   overriding
+   function  Extent      (Self : in     DoF6;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   procedure desired_Extent_is (Self : in out DoF6;   Now : in Real;
+                                                      DoF : in Degree_of_freedom);
+   overriding
+   function  lower_Limit (Self : in     DoF6;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   function  upper_Limit (Self : in     DoF6;   DoF : in Degree_of_freedom) return Real;
+
+   overriding
+   procedure lower_Limit_is (Self : in out DoF6;   Now : in Real;
+                                                   DoF : in Degree_of_freedom);
+   overriding
+   procedure upper_Limit_is (Self : in out DoF6;   Now : in Real;
+                                                   DoF : in Degree_of_freedom);
+
+   ----------
+   --  Slider
+   --
+   type Slider is new Item
+                  and physics.Joint.Slider.item with
+      record
+         null;
+      end record;
+
+   type Slider_view is access Slider;
+
+
+   overriding
+   procedure destruct    (Self : in out Slider);
+
+   overriding
+   function  Object_A    (Self : in     Slider) return physics.Object.view;
+   overriding
+   function  Object_B    (Self : in     Slider) return physics.Object.view;
+
+   overriding
+   function  Frame_A     (Self : in     Slider) return Matrix_4x4;
+   overriding
+   function  Frame_B     (Self : in     Slider) return Matrix_4x4;
+
+   overriding
+   procedure Frame_A_is  (Self : in out Slider;   Now : in Matrix_4x4);
+   overriding
+   procedure Frame_B_is  (Self : in out Slider;   Now : in Matrix_4x4);
+
+   overriding
+   function  is_Limited  (Self : in     Slider;   DoF : Degree_of_freedom) return Boolean;
+
+   overriding
+   procedure Velocity_is (Self : in out Slider;   Now : in Real;
+                                                  DoF : in Degree_of_freedom);
+   overriding
+   function  Extent      (Self : in     Slider;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   procedure desired_Extent_is (Self : in out Slider;   Now : in Real;
+                                                        DoF : in Degree_of_freedom);
+   overriding
+   function  lower_Limit (Self : in     Slider;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   function  upper_Limit (Self : in     Slider;   DoF : in Degree_of_freedom) return Real;
+
+   overriding
+   procedure lower_Limit_is (Self : in out Slider;   Now : in Real;
+                                                     DoF : in Degree_of_freedom);
+   overriding
+   procedure upper_Limit_is (Self : in out Slider;   Now : in Real;
+                                                     DoF : in Degree_of_freedom);
+
+   --------------
+   --  cone_Twist
+   --
+   type cone_Twist is new Item
+                      and physics.Joint.cone_Twist.item with
+      record
+         null;
+      end record;
+
+   type cone_Twist_view is access cone_Twist;
+
+
+   overriding
+   procedure destruct    (Self : in out cone_Twist);
+
+   overriding
+   function  Object_A    (Self : in     cone_Twist) return physics.Object.view;
+   overriding
+   function  Object_B    (Self : in     cone_Twist) return physics.Object.view;
+
+   overriding
+   function  Frame_A     (Self : in     cone_Twist) return Matrix_4x4;
+   overriding
+   function  Frame_B     (Self : in     cone_Twist) return Matrix_4x4;
+
+   overriding
+   procedure Frame_A_is  (Self : in out cone_Twist;   Now : in Matrix_4x4);
+   overriding
+   procedure Frame_B_is  (Self : in out cone_Twist;   Now : in Matrix_4x4);
+
+   overriding
+   function  is_Limited  (Self : in     cone_Twist;   DoF : Degree_of_freedom) return Boolean;
+
+   overriding
+   procedure Velocity_is (Self : in out cone_Twist;   Now : in Real;
+                                                      DoF : in Degree_of_freedom);
+   overriding
+   function  Extent      (Self : in     cone_Twist;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   procedure desired_Extent_is (Self : in out cone_Twist;   Now : in Real;
+                                                            DoF : in Degree_of_freedom);
+   overriding
+   function  lower_Limit (Self : in     cone_Twist;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   function  upper_Limit (Self : in     cone_Twist;   DoF : in Degree_of_freedom) return Real;
+
+   overriding
+   procedure lower_Limit_is (Self : in out cone_Twist;   Now : in Real;
+                                                         DoF : in Degree_of_freedom);
+   overriding
+   procedure upper_Limit_is (Self : in out cone_Twist;   Now : in Real;
+                                                         DoF : in Degree_of_freedom);
+
+   --------
+   --  Ball
+   --
+   type Ball is new Item
+                and physics.Joint.Ball.item with
+      record
+         null;
+      end record;
+
+   type Ball_view is access Ball;
+
+
+   overriding
+   procedure destruct    (Self : in out Ball);
+
+   overriding
+   function  Object_A    (Self : in     Ball) return physics.Object.view;
+   overriding
+   function  Object_B    (Self : in     Ball) return physics.Object.view;
+
+   overriding
+   function  Frame_A     (Self : in     Ball) return Matrix_4x4;
+   overriding
+   function  Frame_B     (Self : in     Ball) return Matrix_4x4;
+
+   overriding
+   procedure Frame_A_is  (Self : in out Ball;   Now : in Matrix_4x4);
+   overriding
+   procedure Frame_B_is  (Self : in out Ball;   Now : in Matrix_4x4);
+
+   overriding
+   function  is_Limited  (Self : in     Ball;   DoF : Degree_of_freedom) return Boolean;
+
+   overriding
+   procedure Velocity_is (Self : in out Ball;   Now : in Real;
+                                                DoF : in Degree_of_freedom);
+   overriding
+   function  Extent      (Self : in     Ball;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   procedure desired_Extent_is (Self : in out Ball;   Now : in Real;
+                                                      DoF : in Degree_of_freedom);
+   overriding
+   function  lower_Limit (Self : in     Ball;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   function  upper_Limit (Self : in     Ball;   DoF : in Degree_of_freedom) return Real;
+
+   overriding
+   procedure lower_Limit_is (Self : in out Ball;   Now : in Real;
+                                                   DoF : in Degree_of_freedom);
+   overriding
+   procedure upper_Limit_is (Self : in out Ball;   Now : in Real;
+                                                   DoF : in Degree_of_freedom);
+
+
+   ---------
+   --  Hinge
+   --
+   type Hinge is new Item
+                 and physics.Joint.hinge.item with
+      record
+         null;
+      end record;
+
+   type Hinge_view is access Hinge;
+
+
+   overriding
+   procedure destruct    (Self : in out Hinge);
+
+   overriding
+   function  Object_A    (Self : in     Hinge) return physics.Object.view;
+   overriding
+   function  Object_B    (Self : in     Hinge) return physics.Object.view;
+
+   overriding
+   function  Frame_A     (Self : in     Hinge) return Matrix_4x4;
+   overriding
+   function  Frame_B     (Self : in     Hinge) return Matrix_4x4;
+
+   overriding
+   procedure Frame_A_is  (Self : in out Hinge;   Now : in Matrix_4x4);
+   overriding
+   procedure Frame_B_is  (Self : in out Hinge;   Now : in Matrix_4x4);
+
+   overriding
+   function  is_Limited  (Self : in     Hinge;   DoF : Degree_of_freedom) return Boolean;
+
+   overriding
+   procedure Velocity_is (Self : in out Hinge;   Now : in Real;
+                                                 DoF : in Degree_of_freedom);
+   overriding
+   function  Extent      (Self : in     Hinge;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   procedure desired_Extent_is (Self : in out Hinge;   Now : in Real;
+                                                       DoF : in Degree_of_freedom);
+   overriding
+   procedure Limits_are  (Self : in out Hinge;   Low, High        : in Real;
+                                                 Softness         : in Real := 0.9;
+                                                 biasFactor       : in Real := 0.3;
+                                                 relaxationFactor : in Real := 1.0);
+   overriding
+   function  lower_Limit (Self : in     Hinge)   return Real;
+   overriding
+   function  upper_Limit (Self : in     Hinge)   return Real;
+
+   overriding
+   function  Angle       (Self : in     Hinge)   return Real;
+
+
+end box2d_Physics.Joint;

3-mid/physics/interface/source/private/box2d/box2d_physics-object.adb

@@ -0,0 +1,357 @@
+with
+     box2d_c.Binding,
+     box2d_c.Pointers,
+
+     box2d_physics.Shape,
+
+     c_math_c.Vector_2,
+     c_math_c.Vector_3,
+     c_math_c.Matrix_3x3,
+     c_math_c.Matrix_4x4,
+     c_math_c.Conversion,
+
+     Swig,
+
+     ada.unchecked_Deallocation,
+     ada.Unchecked_Conversion;
+
+package body box2d_Physics.Object
+is
+   use
+       box2d_c.Binding,
+       c_math_c.Conversion;
+
+   type Any_limited_view is access all lace.Any.limited_item'Class;
+
+   function to_void_ptr is new ada.unchecked_Conversion (Any_limited_view, Swig.void_ptr);
+
+
+   function new_Object (Shape       : in physics.Shape.view;
+                        Mass        : in Real;
+                        Friction    : in Real;
+                        Restitution : in Real;
+                        at_Site     : in Vector_3) return Object.view
+   is
+      Self : constant View := new Item;
+   begin
+      Self.define (Shape, Mass, Friction, Restitution, at_Site);
+      return Self;
+   end new_Object;
+
+
+   overriding
+   procedure define (Self : access Item;   Shape       : in physics.Shape.view;
+                                           Mass        : in Real;
+                                           Friction    : in Real;
+                                           Restitution : in Real;
+                                           at_Site     : in Vector_3)
+   is
+      Self_as_any : constant Any_limited_view       := Any_limited_view (Self);
+      c_Site      : aliased  c_math_c.Vector_2.item := (c_math_c.Real (at_Site (1)),
+                                                        c_math_c.Real (at_Site (2)));
+   begin
+      Self.C := b2d_new_Object (c_Site'unchecked_Access,
+                                c_math_c.Real (Mass),
+                                c_math_c.Real (Friction),
+                                c_math_c.Real (Restitution),
+                                box2d_physics.Shape.view (Shape).C);
+      Self.Shape := Shape;
+      b2d_Object_user_Data_is (box2d_c.Pointers.Object_pointer (Self.C),
+                               to_void_ptr (Self_as_any));
+      Self.Site_is (at_Site);
+      Self.update_Dynamics;
+   end define;
+
+
+   overriding
+   procedure destruct (Self : in out Item)
+   is
+   begin
+      b2d_free_Object (Self.C);
+   end destruct;
+
+
+   procedure free (the_Object : in out physics.Object.view)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (physics.Object.item'Class,
+                                                              physics.Object.view);
+   begin
+      the_Object.destruct;
+      deallocate (the_Object);
+   end free;
+
+
+   function C (Self : in Item) return access box2d_C.Object
+   is
+   begin
+      return Self.C;
+   end C;
+
+
+   overriding
+   function Model (Self : in Item) return physics.Model.view
+   is
+   begin
+      return Self.Model;
+   end Model;
+
+
+   overriding
+   procedure Model_is (Self : in out Item;   Now : in physics.Model.view)
+   is
+   begin
+      Self.Model := Now;
+   end Model_is;
+
+
+   overriding
+   function Shape (Self : in Item) return physics.Shape.view
+   is
+   begin
+      return Self.Shape;
+   end Shape;
+
+
+   procedure Shape_is (Self : in out Item;   Now : in physics.Shape.view)
+   is
+   begin
+      Self.Shape := Now;
+   end Shape_is;
+
+
+   overriding
+   function Scale (Self : in Item) return Vector_3
+   is
+   begin
+      raise Error with "TODO";
+      return math.Origin_3D;
+   end Scale;
+
+
+   overriding
+   procedure Scale_is (Self : in out Item;   Now : in Vector_3)
+   is
+      c_Now : aliased c_math_c.Vector_2.item := (c_math_c.Real (Now (1)),
+                                                 c_math_c.Real (Now (2)));
+   begin
+      Self.Shape.Scale_is (Now);
+      b2d_object_Scale_is (Self.C, c_Now'unchecked_Access);
+   end Scale_is;
+
+
+   overriding
+   function is_Active (Self : in Item) return Boolean
+   is
+   begin
+      return True;     -- TODO: Finish this and 'activate' below.
+   end is_Active;
+
+
+   overriding
+   procedure activate (Self : in out Item;   forceActivation : in Boolean := False)
+   is
+      pragma unreferenced (forceActivation);
+   begin
+      null;
+   end activate;
+
+
+   overriding
+   procedure update_Dynamics (Self : in out Item)
+   is
+      Dynamics : constant Matrix_4x4 := Self.Transform;
+   begin
+      Self.Dynamics.set (Dynamics);
+   end update_Dynamics;
+
+
+   overriding
+   function get_Dynamics (Self : in Item) return Matrix_4x4
+   is
+   begin
+      return Self.Dynamics.get;
+   end get_Dynamics;
+
+
+   overriding
+   function Mass (Self : in Item) return Real
+   is
+   begin
+      return Real (b2d_Object_Mass (Self.C));
+   end Mass;
+
+
+   overriding
+   function Site (Self : in Item) return Vector_3
+   is
+      the_Site : constant c_math_c.Vector_3.item := b2d_Object_Site (Self.C);
+   begin
+      return +the_Site;
+   end Site;
+
+
+   overriding
+   procedure Site_is (Self : in out Item;   Now : in Vector_3)
+   is
+      c_Now : aliased c_math_c.Vector_3.item := +Now;
+   begin
+      b2d_Object_Site_is (Self.C, c_Now'unchecked_Access);
+   end Site_is;
+
+
+   overriding
+   function Spin (Self : in Item) return Matrix_3x3
+   is
+      the_Spin : constant c_math_c.Matrix_3x3.item := b2d_Object_Spin (Self.C);
+   begin
+      return +the_Spin;
+   end Spin;
+
+
+   overriding
+   procedure Spin_is (Self : in out Item;   Now : in Matrix_3x3)
+   is
+      c_Now : aliased c_math_c.Matrix_3x3.item := +Now;
+   begin
+      b2d_Object_Spin_is (Self.C, c_Now'unchecked_Access);
+   end Spin_is;
+
+
+   overriding
+   function xy_Spin (Self : in Item) return Radians
+   is
+      the_Spin : constant c_math_c.Real := b2d_Object_xy_Spin (Self.C);
+   begin
+      return +the_Spin;
+   end xy_Spin;
+
+
+   overriding
+   procedure xy_Spin_is (Self : in out Item;   Now : in Radians)
+   is
+      c_Now : constant c_math_c.Real := +Now;
+   begin
+      b2d_Object_xy_Spin_is (Self.C, c_Now);
+   end xy_Spin_is;
+
+
+   overriding
+   function Transform (Self : in Item) return Matrix_4x4
+   is
+      the_Transform : constant c_math_c.Matrix_4x4.item := b2d_Object_Transform (Self.C);
+   begin
+      return +the_Transform;
+   end Transform;
+
+
+   overriding
+   procedure Transform_is (Self : in out Item;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b2d_Object_Transform_is (Self.C, c_Now'Unchecked_Access);
+   end Transform_is;
+
+
+   overriding
+   function Speed (Self : in Item) return Vector_3
+   is
+      the_Speed : constant c_math_c.Vector_3.item := b2d_Object_Speed (Self.C);
+   begin
+      return +the_Speed;
+   end Speed;
+
+
+   overriding
+   procedure Speed_is (Self : in out Item;   Now : in Vector_3)
+   is
+      c_Now : aliased c_math_c.Vector_3.item := +Now;
+   begin
+      b2d_Object_Speed_is (Self.C, c_Now'unchecked_Access);
+   end Speed_is;
+
+
+   overriding
+   function Gyre (Self : in Item) return Vector_3
+   is
+      the_Gyre : constant c_math_c.Vector_3.item := b2d_Object_Gyre (Self.C);
+   begin
+      return +the_Gyre;
+   end Gyre;
+
+
+   overriding
+   procedure Gyre_is (Self : in out Item;   Now : in Vector_3)
+   is
+      c_Now : aliased c_math_c.Vector_3.item := +Now;
+   begin
+      b2d_Object_Gyre_is (Self.C, c_Now'unchecked_Access);
+   end Gyre_is;
+
+
+   overriding
+   procedure Friction_is (Self : in out Item;   Now : in Real)
+   is
+   begin
+      b2d_Object_Friction_is (Self.C, +Now);
+   end Friction_is;
+
+
+   overriding
+   procedure Restitution_is (Self : in out Item;   Now : in Real)
+   is
+   begin
+      b2d_Object_Restitution_is (Self.C, +Now);
+   end Restitution_is;
+
+
+   --- Forces
+   --
+
+   overriding
+   procedure apply_Torque (Self : in out Item;   Torque : in Vector_3)
+   is
+      c_Torque : aliased c_math_c.Vector_3.item := +Torque;
+   begin
+      b2d_Object_apply_Torque (Self.C, c_Torque'unchecked_Access);
+   end apply_Torque;
+
+
+   overriding
+   procedure apply_Torque_impulse (Self : in out Item;   Torque : in Vector_3)
+   is
+      c_Torque : aliased c_math_c.Vector_3.item := +Torque;
+   begin
+      b2d_Object_apply_Torque_impulse (Self.C, c_Torque'unchecked_Access);
+   end apply_Torque_impulse;
+
+
+   overriding
+   procedure apply_Force (Self : in out Item;   Force : in Vector_3)
+   is
+      c_Force : aliased c_math_c.Vector_3.item := +Force;
+   begin
+      b2d_Object_apply_Force (Self.C, c_Force'unchecked_Access);
+   end apply_Force;
+
+
+   --- User Data
+   --
+
+   overriding
+   procedure user_Data_is (Self : in out Item;   Now : access lace.Any.limited_item'Class)
+   is
+   begin
+      Self.user_Data := Now.all'unchecked_Access;
+   end user_Data_is;
+
+
+   overriding
+   function user_Data (Self : in Item)  return access lace.Any.limited_item'Class
+   is
+   begin
+      return Self.user_Data;
+   end user_Data;
+
+
+end box2d_Physics.Object;

3-mid/physics/interface/source/private/box2d/box2d_physics-object.ads

@@ -0,0 +1,145 @@
+with
+     physics.Object,
+     physics.Shape,
+     physics.Model,
+     box2d_C;
+
+private
+with
+     lace.Any;
+
+package box2d_Physics.Object
+--
+--  Provides glue between a physics object and a Box2D object.
+--
+is
+   type Item is limited new physics.Object.item with private;
+   type View is access all Item'Class;
+
+   use Math;
+
+
+   overriding
+   procedure define (Self : access Item;   Shape       : in physics.Shape.view;
+                                           Mass        : in Real;
+                                           Friction    : in Real;
+                                           Restitution : in Real;
+                                           at_Site     : in Vector_3);
+
+   function  new_Object (Shape       : in physics.Shape.view;
+                         Mass        : in Real;
+                         Friction    : in Real;
+                         Restitution : in Real;
+                         at_Site     : in Vector_3) return Object.view;
+
+   procedure free (the_Object : in out physics.Object.view);
+
+
+   function C                (Self : in     Item) return access box2d_C.Object;
+
+   procedure Shape_is        (Self : in out Item;   Now : in Physics.Shape.view);
+
+   overriding
+   function  Model           (Self : in     Item)     return physics.Model.view;
+   overriding
+   procedure Model_is        (Self : in out Item;   Now : in physics.Model.view);
+
+   overriding
+   procedure update_Dynamics (Self : in out Item);
+   overriding
+   function     get_Dynamics (Self : in     Item) return Matrix_4x4;
+
+
+
+private
+
+   type Item is limited new physics.Object.item with
+      record
+         C         : access box2d_C.Object;
+         Shape     :        physics.Shape.view;
+         Model     :        physics.Model.view;
+         user_Data : access lace.Any.limited_item'Class;
+
+         Dynamics  : physics.Object.safe_Dynamics;
+      end record;
+
+
+   overriding
+   procedure destruct       (Self : in out Item);
+
+   overriding
+   function  Shape          (Self : in     Item)     return physics.Shape.view;
+
+   overriding
+   function  Scale          (Self : in     Item)     return Vector_3;
+   overriding
+   procedure Scale_is       (Self : in out Item;   Now : in Vector_3);
+
+   overriding
+   procedure activate       (Self : in out Item;   forceActivation : in Boolean := False);
+   overriding
+   function  is_Active      (Self : in     Item)     return Boolean;
+
+   overriding
+   function  Mass           (Self : in     Item)     return Real;
+
+   overriding
+   function  Site           (Self : in     Item)     return Vector_3;
+   overriding
+   procedure Site_is        (Self : in out Item;   Now : in Vector_3);
+
+   overriding
+   function  Spin           (Self : in     Item)     return Matrix_3x3;
+   overriding
+   procedure Spin_is        (Self : in out Item;   Now : in Matrix_3x3);
+
+   overriding
+   function  xy_Spin        (Self : in     Item)     return Radians;
+   overriding
+   procedure xy_Spin_is     (Self : in out Item;   Now : in Radians);
+
+   overriding
+   function  Transform      (Self : in     Item)     return Matrix_4x4;
+   overriding
+   procedure Transform_is   (Self : in out Item;   Now : in Matrix_4x4);
+
+   overriding
+   function  Speed          (Self : in     Item)     return Vector_3;
+   overriding
+   procedure Speed_is       (Self : in out Item;   Now : in Vector_3);
+
+   overriding
+   function  Gyre           (Self : in     Item)     return Vector_3;
+   overriding
+   procedure Gyre_is        (Self : in out Item;   Now : in Vector_3);
+
+   overriding
+   procedure Friction_is    (Self : in out Item;   Now : in Real);
+
+   overriding
+   procedure Restitution_is (Self : in out Item;   Now : in Real);
+
+
+   --- Forces
+   --
+
+   overriding
+   procedure apply_Torque         (Self : in out Item;   Torque : in Vector_3);
+
+   overriding
+   procedure apply_Torque_impulse (Self : in out Item;   Torque : in Vector_3);
+
+   overriding
+   procedure apply_Force          (Self : in out Item;   Force  : in Vector_3);
+
+
+   --- User data
+   --
+
+   overriding
+   procedure user_Data_is (Self : in out Item;   Now : access lace.Any.limited_item'Class);
+   overriding
+   function  user_Data    (Self : in     Item)  return access lace.Any.limited_item'Class;
+
+
+end box2d_Physics.Object;

3-mid/physics/interface/source/private/box2d/box2d_physics-shape.adb

@@ -0,0 +1,208 @@
+with
+     box2d_c.Binding,
+
+     c_math_c.Vector_2,
+     c_math_c.Conversion,
+
+     ada.unchecked_Deallocation,
+     ada.unchecked_Conversion;
+
+package body box2d_Physics.Shape
+is
+   use c_math_c.Conversion,
+       box2d_c .Binding;
+
+
+   --  Base Shape
+   --
+
+   overriding
+   procedure define (Self : in out Item)
+   is
+   begin
+      raise Error with "Shape not supported.";
+   end define;
+
+
+   overriding
+   procedure destruct (Self : in out Item)
+   is
+   begin
+      b2d_free_Shape (Self.C);
+   end destruct;
+
+
+   overriding
+   procedure Scale_is (Self : in out Item;   Now : Vector_3)
+   is
+   begin
+      b2d_shape_Scale_is (Self.C, (c_math_c.Real (Now (1)),
+                                   c_math_c.Real (Now (2))));
+   end Scale_is;
+
+
+   -----------
+   --  Forge
+   --
+
+   --  2D
+   --
+
+   type Circle_view is access Circle;
+
+   function new_circle_Shape (Radius : in Real) return physics.Shape.view
+   is
+      Self : constant Circle_view := new Circle;
+      --  Self : constant access Circle := new Circle;
+--        c_Radius : aliased constant c_math_c.Real := +Radius;
+   begin
+      --        Self.C := b2d_new_Circle (c_Radius);
+      Self.Radius := Radius;
+      Self.define;
+      return physics.Shape.view (Self);
+   end new_circle_Shape;
+
+
+   overriding
+   procedure define (Self : in out Circle)
+   is
+      c_Radius : aliased constant c_math_c.Real := +Self.Radius;
+   begin
+      Self.C := b2d_new_Circle (c_Radius);
+   end define;
+
+
+
+   type Polygon_view is access Polygon;
+
+   function new_polygon_Shape (Vertices : in physics.Space.polygon_Vertices) return physics.Shape.view
+   is
+      --  P : Polygon (vertex_Count => Vertices'Length);
+      --  Self : constant Polygon_view := new Polygon' (P);
+      Self : constant Polygon_view := new Polygon (vertex_Count => Vertices'Length);
+--        c_Verts : array (1 .. Vertices'Length) of aliased c_math_c.Vector_2.item;
+   begin
+         Self.Vertices := Vertices;
+--        for i in c_Verts'Range
+--        loop
+--           c_Verts (i) := +Vertices (i);
+--        end loop;
+--
+--        Self.C := b2d_new_Polygon (c_Verts (1)'Unchecked_Access,
+--                                   c_Verts'Length);
+      Self.define;
+      return physics.Shape.view (Self);
+   end new_polygon_Shape;
+
+
+   overriding
+   procedure define (Self : in out Polygon)
+   is
+      c_Verts : array (1 .. Self.vertex_Count) of aliased c_math_c.Vector_2.item;
+   begin
+      for i in c_Verts'Range
+      loop
+         c_Verts (i) := +Self.Vertices (i);
+      end loop;
+
+      Self.C := b2d_new_Polygon (c_Verts (1)'unchecked_Access,
+                                 c_Verts'Length);
+   end define;
+
+
+   -- 3D
+   --
+
+   function new_box_Shape (half_Extents : in Vector_3) return physics.Shape.view
+   is
+      pragma unreferenced (half_Extents);
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_box_Shape;
+
+
+   function new_capsule_Shape (Radii  : in Vector_2;
+                               Height : in Real) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_capsule_Shape;
+
+
+   function new_cone_Shape (Radius,
+                            Height : in Real) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_cone_Shape;
+
+
+   function new_convex_hull_Shape (Points : in physics.Vector_3_array) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_convex_hull_Shape;
+
+
+   function new_cylinder_Shape (half_Extents : in Vector_3) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_cylinder_Shape;
+
+
+   function new_heightfield_Shape (Width,
+                                   Depth       : in Positive;
+                                   Heights     : access constant Real;
+                                   min_Height,
+                                   max_Height  : in Real;
+                                   Scale       : in Vector_3) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_heightfield_Shape;
+
+
+   function new_multiSphere_Shape (Positions : in physics.Vector_3_array;
+                                   Radii     : in Vector) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_multiSphere_Shape;
+
+
+   function new_plane_Shape (Normal : in Vector_3;
+                             Offset : in Real) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_plane_Shape;
+
+
+   function new_sphere_Shape (Radius : in math.Real) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_sphere_Shape;
+
+
+   procedure free (the_Shape : in out physics.Shape.view)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (physics.Shape.item'Class,
+                                                              physics.Shape.view);
+   begin
+      the_Shape.destruct;
+      deallocate (the_Shape);
+   end free;
+
+
+end box2d_Physics.Shape;

3-mid/physics/interface/source/private/box2d/box2d_physics-shape.ads

@@ -0,0 +1,99 @@
+with
+     physics.Shape,
+     box2d_c.Pointers,
+     physics.Space;
+
+package box2d_Physics.Shape
+--
+--  Provides glue between a physics shape and a Box2D shape.
+--
+is
+   type Item is abstract new physics.Shape.item with     -- TODO: Make private.
+      record
+         C : box2d_c.Pointers.Shape_pointer;
+      end record;
+
+   type View is access all Item'Class;
+
+
+   use Math;
+
+   overriding
+   procedure define   (Self : in out Item);
+
+   overriding
+   procedure destruct (Self : in out Item);
+
+   overriding
+   procedure Scale_is (Self : in out Item;   Now : Vector_3);
+
+
+   ---------
+   --  Forge
+   --
+
+   --  Shapes
+
+   procedure free (the_Shape : in out physics.Shape.view);
+
+   --  3D
+
+   function new_box_Shape         (half_Extents : in Vector_3)    return physics.Shape.view;
+   function new_capsule_Shape     (Radii        : in Vector_2;
+                                   Height       : in Real)        return physics.Shape.view;
+   function new_cone_Shape        (Radius,
+                                   Height       : in Real)        return physics.Shape.view;
+   function new_convex_hull_Shape (Points       : in physics.Vector_3_array)
+                                                                  return physics.Shape.view;
+   function new_cylinder_Shape    (half_Extents : in Vector_3)    return physics.Shape.view;
+   function new_heightfield_Shape (Width,
+                                   Depth        : in Positive;
+                                   Heights      : access constant Real;
+                                   min_Height,
+                                   max_Height   : in Real;
+                                   Scale        : in Vector_3)    return physics.Shape.view;
+   function new_multiSphere_Shape (Positions    : in physics.Vector_3_array;
+                                   Radii        : in Vector)      return physics.Shape.view;
+   function new_plane_Shape       (Normal       : in Vector_3;
+                                   Offset       : in Real)        return physics.Shape.view;
+   function new_sphere_Shape      (Radius       : in Real)        return physics.Shape.view;
+
+
+   --  2D
+
+   function  new_circle_Shape (Radius   : in Real)                           return physics.Shape.view;
+   function new_polygon_Shape (Vertices : in physics.Space.polygon_Vertices) return physics.Shape.view;
+
+
+
+private
+
+   type Circle is new Item with
+      record
+         Radius : Real;
+      end record;
+
+   overriding
+   procedure define (Self : in out Circle);
+
+
+   type Polygon (vertex_Count : Positive) is new Item with
+      record
+         Vertices : physics.Space.polygon_Vertices (1 .. vertex_Count);
+      end record;
+
+   overriding
+   procedure define (Self : in out Polygon);
+
+
+   type Box         is new Item with null record;
+   type Capsule     is new Item with null record;
+   type Cone        is new Item with null record;
+   type Cylinder    is new Item with null record;
+   type Heightfield is new Item with null record;
+   type multiSphere is new Item with null record;
+   type Plane       is new Item with null record;
+   type Sphere      is new Item with null record;
+   type convex_Hull is new Item with null record;
+
+end box2d_Physics.Shape;

3-mid/physics/interface/source/private/box2d/box2d_physics-space.adb

@@ -0,0 +1,606 @@
+with
+     box2d_c.Binding,
+     box2d_c.b2d_Contact,
+     box2d_c.b2d_ray_Collision,
+
+     box2d_physics.Shape,
+     box2d_physics.Joint,
+
+     c_math_c.Vector_3,
+     c_math_c.Conversion,
+
+     Swig,
+     lace.Any,
+     interfaces.C,
+
+     ada.unchecked_Conversion;
+
+package body box2d_Physics.Space
+is
+   use box2d_c.Binding,
+       box2d_c.Pointers,
+       c_math_c.Conversion,
+       Interfaces;
+
+   use type c_math_c.Real;
+
+
+   type Any_limited_view is access all lace.Any.limited_item'Class;
+
+   function to_Any_view    is new ada.unchecked_Conversion (Swig.void_ptr, Any_limited_view);
+   function to_Object_view is new ada.unchecked_Conversion (swig.void_ptr, physics.Object.view);
+
+
+   ----------
+   --- Forge
+   --
+
+   function to_Space return Item
+   is
+   begin
+      return Self : Item
+      do
+         Self.C := box2d_c.Binding.b2d_new_Space;
+      end return;
+   end to_Space;
+
+
+   overriding
+   procedure destruct (Self : in out Item)
+   is
+   begin
+      b2d_free_Space (Self.C);
+   end destruct;
+
+
+   -----------
+   --- Factory
+   --
+
+   overriding
+   function new_Shape (Self : access Item;   Model : in physics.Model.view) return physics.Shape.view
+   is
+
+   begin
+      raise Error with "TODO";
+      return null;
+   end new_Shape;
+
+
+   --  2d
+   --
+
+   overriding
+   function new_circle_Shape (Self : access Item;   Radius : in Real := 0.5) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+      the_Circle : constant physics.Shape.view := box2d_physics.Shape.new_circle_Shape (Radius);
+   begin
+      return the_Circle;
+   end new_circle_Shape;
+
+
+   overriding
+   function new_polygon_Shape (Self : access Item;   Vertices : in physics.Space.polygon_Vertices) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+      the_Polygon : constant physics.Shape.view := box2d_physics.Shape.new_polygon_Shape (Vertices);
+   begin
+      return the_Polygon;
+   end new_polygon_Shape;
+
+
+   -- 3d
+
+   overriding
+   function new_sphere_Shape (Self : access Item;   Radius : in Real := 0.5) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+   begin
+      raise physics.Space.unsupported_Shape with "Sphere shape not allowed in box2d physics.";
+      return null;
+   end new_sphere_Shape;
+
+
+   overriding
+   function new_box_Shape (Self : access Item;   half_Extents : in Vector_3 := [0.5, 0.5, 0.5]) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+   begin
+      raise physics.Space.unsupported_Shape with "Box shape not allowed in box2d physics.";
+      return null;
+   end new_box_Shape;
+
+
+   overriding
+   function new_capsule_Shape (Self : access Item;   Radius : in Real :=  0.5;
+                                                     Height : in Real) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+   begin
+      raise physics.Space.unsupported_Shape with "Capsule shape not allowed in box2d physics.";
+      return null;
+   end new_capsule_Shape;
+
+
+   overriding
+   function new_cone_Shape (Self : access Item;   Radius : in Real := 0.5;
+                                                  Height : in Real := 1.0) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+   begin
+      raise physics.Space.unsupported_Shape with "Cone shape not allowed in box2d physics.";
+      return null;
+   end new_cone_Shape;
+
+
+   overriding
+   function new_cylinder_Shape (Self : access Item;   half_Extents : in Vector_3 := [0.5, 0.5, 0.5]) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+   begin
+      raise physics.Space.unsupported_Shape with "Cylinder shape not allowed in box2d physics.";
+      return null;
+   end New_Cylinder_Shape;
+
+
+   overriding
+   function new_heightfield_Shape (Self : access Item;   Heightfield  : in out physics.Heightfield;
+                                                         Scale        : in     Vector_3) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+   begin
+      raise physics.Space.unsupported_Shape with "Heightfield shape not allowed in box2d physics.";
+      return null;
+   end new_heightfield_Shape;
+
+
+   overriding
+   function new_multisphere_Shape (Self : access Item;   Sites : in physics.vector_3_array;
+                                                         Radii : in math.Vector) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+   begin
+      raise physics.Space.unsupported_Shape with "multiSphere shape not allowed in box2d physics.";
+      return null;
+   end new_multisphere_Shape;
+
+
+
+   overriding
+   function new_plane_Shape (Self : access Item;   Normal : in Vector_3 := [0.0, 1.0, 0.0];
+                                                   Offset : in Real     :=  0.0) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+   begin
+      raise physics.Space.unsupported_Shape with "Plane shape not allowed in box2d physics.";
+      return null;
+   end new_plane_Shape;
+
+
+   overriding
+   function new_convex_hull_Shape (Self : access Item;   Points : in physics.Vector_3_array) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+   begin
+      raise physics.Space.unsupported_Shape with "Convex hull shape not allowed in box2d physics.";
+      return null;
+   end new_convex_hull_Shape;
+
+
+   overriding
+   function new_mesh_Shape (Self : access Item;   Points : access physics.Geometry_3D.a_Model) return physics.Shape.view
+   is
+      pragma unreferenced (Self, Points);
+   begin
+      raise physics.Space.unsupported_Shape with "Mesh shape not allowed in box2d physics.";
+      return null;
+   end new_mesh_Shape;
+
+
+   --  Objects
+   --
+
+   function Hash (the_C_Object : in box2d_c.Pointers.Object_pointer) return ada.Containers.Hash_type
+   is
+      function convert is new ada.unchecked_Conversion (box2d_c.Pointers.Object_pointer,
+                                                        ada.Containers.Hash_type);
+   begin
+      return convert (the_C_Object);
+   end Hash;
+
+
+   overriding
+   function new_Object (Self : access Item;   of_Shape     : in physics.Shape.view;
+                                              of_Mass      : in Real;
+                                              Friction     : in Real;
+                                              Restitution  : in Real;
+                                              at_Site      : in Vector_3;
+                                              is_Kinematic : in Boolean) return physics.Object.view
+   is
+      pragma unreferenced (Self, is_Kinematic);
+      the_box2d_Object : constant box2d_Physics.Object.view := box2d_physics.Object.new_Object (of_Shape,
+                                                                                                of_Mass,
+                                                                                                Friction,
+                                                                                                Restitution,
+                                                                                                at_Site);
+      the_Object       : constant physics.Object.view       := physics.Object.view (the_box2d_Object);
+   begin
+      return the_Object;
+   end new_Object;
+
+
+   overriding
+   function object_Count (Self : in Item) return Natural
+   is
+   begin
+      return Natural (Self.object_Map.Length);
+   end object_Count;
+
+
+   --  Joints
+   --
+
+   overriding
+   function new_hinge_Joint (Self : access Item;   Object_A,
+                                                   Object_B         : in physics.Object.view;
+                                                   Anchor_in_A,
+                                                   Anchor_in_B      : in Vector_3;
+                                                   pivot_Axis       : in Vector_3;
+                                                   low_Limit,
+                                                   high_Limit       : in Real;
+                                                   collide_Conected : in Boolean) return physics.Joint.hinge.view
+   is
+      the_Joint : constant physics.Joint.hinge.view := box2d_physics.Joint.new_hinge_Joint (Self.C,
+                                                                                            Object_A,    Object_B,
+                                                                                            Anchor_in_A, Anchor_in_B,
+                                                                                            low_Limit,   high_Limit,
+                                                                                            collide_Conected);
+   begin
+      return the_Joint;
+   end new_hinge_Joint;
+
+
+   overriding
+   function new_hinge_Joint (Self : access Item;   Object_A : in physics.Object.view;
+                                                   Frame_A  : in Matrix_4x4) return physics.Joint.hinge.view
+   is
+      pragma unreferenced (Self);
+      the_Joint : constant physics.Joint.hinge.view := box2d_physics.Joint.new_hinge_Joint (Object_A, Frame_A);
+   begin
+      return the_Joint;
+   end new_hinge_Joint;
+
+
+   overriding
+   function new_hinge_Joint (Self : access Item;   Object_A,
+                                                   Object_B         : in physics.Object.view;
+                                                   Frame_A,
+                                                   Frame_B          : in Matrix_4x4;
+                                                   low_Limit,
+                                                   high_Limit       : in Real;
+                                                   collide_Conected : in Boolean) return physics.Joint.hinge.view
+   is
+      the_Joint : constant physics.Joint.hinge.view := box2d_physics.Joint.new_hinge_Joint (Self.C,
+                                                                                            Object_A,  Object_B,
+                                                                                            Frame_A,   Frame_B,
+                                                                                            low_Limit, high_Limit,
+                                                                                            collide_Conected);
+   begin
+      return the_Joint;
+   end new_hinge_Joint;
+
+
+   overriding
+   function new_DoF6_Joint (Self : access Item;   Object_A,
+                                                  Object_B  : in physics.Object.view;
+                                                  Frame_A,
+                                                  Frame_B   : in Matrix_4x4) return physics.Joint.DoF6.view
+   is
+      pragma unreferenced (Self);
+      the_Joint : constant physics.Joint.DoF6.view := box2d_physics.Joint.new_DoF6_Joint (Object_A, Object_B,
+                                                                                          Frame_A,  Frame_B);
+   begin
+      return the_Joint;
+   end new_DoF6_Joint;
+
+
+   overriding
+   function new_ball_Joint (Self : access Item;   Object_A,
+                                                  Object_B     : in physics.Object.view;
+                                                  Pivot_in_A,
+                                                  Pivot_in_B   : in math.Vector_3) return physics.Joint.ball.view
+   is
+      pragma unreferenced (Self);
+      the_Joint : constant physics.Joint.ball.view := Standard.box2d_physics.Joint.new_ball_Joint (Object_A,   Object_B,
+                                                                                                   Pivot_in_A, Pivot_in_B);
+   begin
+      return the_Joint;
+   end new_ball_Joint;
+
+
+   overriding
+   function new_slider_Joint (Self : access Item;   Object_A,
+                                                    Object_B : in physics.Object.view;
+                                                    Frame_A,
+                                                    Frame_B  : in Matrix_4x4) return physics.Joint.slider.view
+   is
+      pragma unreferenced (Self);
+      the_Joint : constant physics.Joint.slider.view := box2d_physics.Joint.new_slider_Joint (Object_A, Object_B,
+                                                                                              Frame_A,  Frame_B);
+   begin
+      return the_Joint;
+   end new_slider_Joint;
+
+
+   overriding
+   function new_cone_twist_Joint (Self : access Item;   Object_A,
+                                                        Object_B : in physics.Object.view;
+                                                        Frame_A,
+                                                        Frame_B  : in Matrix_4x4) return physics.Joint.cone_twist.view
+   is
+      pragma unreferenced (Self);
+      the_Joint : constant physics.Joint.cone_twist.view := box2d_physics.Joint.new_cone_twist_Joint (Object_A, Object_B,
+                                                                                                      Frame_A,  Frame_B);
+   begin
+      return the_Joint;
+   end new_cone_twist_Joint;
+
+
+   ---------------
+   --- Operations
+   --
+
+   overriding
+   procedure update_Bounds (Self : in out Item;   of_Obect : in physics.Object.view)
+   is
+      the_c_Object : constant access box2d_c.Object := box2d_physics.Object.view (of_Obect).C;
+      pragma Unreferenced (the_c_Object);
+   begin
+      null;
+   end update_Bounds;
+
+
+   overriding
+   procedure add (Self : in out Item;   the_Object : in physics.Object.view)
+   is
+      the_box2d_Object : constant box2d_physics.Object.view := box2d_physics.Object.view (the_Object);
+      the_c_Object     : constant Object_pointer            := the_box2d_Object.C;
+
+      procedure rebuild_Shape
+      is
+         use type physics.Model.shape_Kind,
+                  physics.Model.view;
+
+--           the_Scale : aliased Vector_3;
+         shape_Info : Physics.Model.a_Shape renames the_Object.Model.shape_Info;
+      begin
+--           if the_Object.physics_Model = null then
+--              return;
+--           end if;
+
+--           the_Scale := Self.physics_Model.Scale;
+
+         case shape_Info.Kind
+         is
+         when physics.Model.Cube =>         the_box2d_Object.Shape_is (Self.new_box_Shape         (shape_Info.half_Extents));
+         when physics.Model.a_Sphere =>     the_box2d_Object.Shape_is (Self.new_sphere_Shape      (shape_Info.sphere_Radius));
+         when physics.Model.multi_Sphere => the_box2d_Object.Shape_is (Self.new_multisphere_Shape (shape_Info.Sites.all,
+                                                                                                   shape_Info.Radii.all));
+         when physics.Model.Cone =>         the_box2d_Object.Shape_is (Self.new_cone_Shape        (radius => Real (the_Object.Model.Scale (1) / 2.0),
+                                                                                                   height => Real (the_Object.Model.Scale (2))));
+         when physics.Model.a_Capsule =>    the_box2d_Object.Shape_is (Self.new_capsule_Shape     (shape_Info.lower_Radius,
+                                                                                                   shape_Info.Height));
+         when physics.Model.Cylinder =>     the_box2d_Object.Shape_is (Self.new_cylinder_Shape    (shape_Info.half_Extents));
+         when physics.Model.Hull =>         the_box2d_Object.Shape_is (Self.new_convex_hull_Shape (shape_Info.Points.all));
+         when physics.Model.Mesh =>         the_box2d_Object.Shape_is (Self.new_mesh_Shape        (shape_Info.Model));
+         when physics.Model.Plane =>        the_box2d_Object.Shape_is (Self.new_plane_Shape       (Shape_Info.plane_Normal,
+                                                                                                   Shape_Info.plane_Offset));
+         when physics.Model.Heightfield =>  the_box2d_Object.Shape_is (Self.new_heightfield_Shape (shape_Info.Heights.all,
+                                                                                                   the_Object.Model.Scale));
+         when physics.Model.Circle =>       the_box2d_Object.Shape_is (Self.new_circle_Shape      (shape_Info.circle_Radius));
+         when physics.Model.Polygon =>      the_box2d_Object.Shape_is (Self.new_polygon_Shape     (physics.space.polygon_Vertices (shape_Info.Vertices (1 .. shape_Info.vertex_Count))));
+         end case;
+
+      end rebuild_Shape;
+      pragma Unreferenced (rebuild_Shape);
+
+   begin
+--        rebuild_Shape;
+
+      Self.object_Map.insert (the_C_Object, the_box2d_Object);
+      b2d_Space_add_Object   (Self.C, the_c_Object);
+   end add;
+
+
+   overriding
+   procedure rid (Self : in out Item;   the_Object : in physics.Object.view)
+   is
+      the_c_Object : constant Object_pointer := box2d_physics.Object.view (the_Object).C;
+   begin
+      b2d_Space_rid_Object (Self.C, the_c_Object);
+   end rid;
+
+
+   overriding
+   function cast_Ray (Self : access Item;    From, To : in Vector_3) return physics.Space.ray_Collision
+   is
+      c_From          : aliased c_math_c.Vector_3.item := +From;
+      c_To            : aliased c_math_c.Vector_3.item := +To;
+
+      the_c_Collision : constant box2d_c.b2d_ray_Collision.Item := b2d_Space_cast_Ray (Self.C, c_From'unchecked_Access,
+                                                                                               c_To  'unchecked_Access);
+      the_Collision   : physics.Space.ray_Collision;
+
+   begin
+      if the_c_Collision.near_Object /= null
+      then
+         the_Collision.near_Object := to_Object_view (b2d_Object_user_Data (the_c_Collision.near_Object));
+      end if;
+
+      the_Collision.hit_Fraction :=  Real (the_c_Collision.hit_Fraction);
+      the_Collision.Normal_world := +the_c_Collision.Normal_world;
+      the_Collision.Site_world   := +the_c_Collision.Site_world;
+
+      return the_Collision;
+   end cast_Ray;
+
+
+   overriding
+   procedure evolve (Self : in out Item;   By : in Duration)
+   is
+   begin
+      b2d_Space_evolve (Self.C, C.C_float (By));
+
+      -- Update each objects dynamics.
+      --
+      declare
+         use c_Object_Maps_of_Object;
+         Cursor     : c_Object_Maps_of_Object.Cursor := Self.object_Map.First;
+         the_Object : box2d_Physics.Object.view;
+      begin
+         while has_Element (Cursor)
+         loop
+            the_Object := Element (Cursor);
+            the_Object.update_Dynamics;
+
+            next (Cursor);
+         end loop;
+      end;
+   end evolve;
+
+
+   overriding
+   function Gravity (Self : in Item) return Vector_3
+   is
+   begin
+      raise Error with "TODO";
+      return [0.0, 0.0, 0.0];
+   end Gravity;
+
+
+   overriding
+   procedure Gravity_is (Self : in out Item;   Now : in Vector_3)
+   is
+      c_Now : aliased c_math_c.Vector_3.item := +Now;
+   begin
+      b2d_Space_Gravity_is (Self.C, c_Now'unchecked_Access);
+   end Gravity_is;
+
+
+   overriding
+   procedure add (Self : in out Item;   the_Joint : in physics.Joint.view)
+   is
+      use box2d_physics.Joint;
+      the_c_Joint : constant Joint_pointer := box2d_physics.Joint.view (the_Joint).C;
+   begin
+      b2d_Space_add_Joint (Self.C, the_c_Joint);
+      --  set_b2d_user_Data   (box2d_physics.Joint.view (the_Joint));
+   end add;
+
+
+   overriding
+   procedure rid (Self : in out Item;   the_Joint : in physics.Joint.view)
+   is
+      the_c_Joint : constant Joint_pointer := box2d_physics.Joint.view (the_Joint).C;
+   begin
+      b2d_Space_rid_Joint (Self.C, the_c_Joint);
+   end rid;
+
+
+   ---------------------
+   --  Contact Manifolds
+   --
+
+   overriding
+   function manifold_Count (Self : in Item) return Natural
+   is
+   begin
+      return Natural (b2d_space_contact_Count (Self.C));
+   end manifold_Count;
+
+
+   overriding
+   function Manifold (Self : access Item;   Index : in Positive) return physics.space.a_Manifold
+   is
+      use type C.int;
+      function to_Any_limited_view is new ada.unchecked_Conversion (Swig.void_ptr, Any_limited_view);
+
+      the_Contact  : box2d_c.b2d_Contact.item renames b2d_space_Contact (Self.C, C.int (Index) - 1);
+      the_Manifold : physics.space.a_Manifold;
+
+   begin
+      the_Manifold.Objects (1)  := physics.Object.view (to_Any_limited_view (b2d_object_user_Data (the_Contact.Object_A)));
+      the_Manifold.Objects (2)  := physics.Object.view (to_Any_limited_view (b2d_object_user_Data (the_Contact.Object_B)));
+
+      the_Manifold.Contact.Site := +the_Contact.Site;
+
+      return the_Manifold;
+   end Manifold;
+
+
+   overriding
+   procedure set_Joint_local_Anchor (Self : in out Item;   the_Joint    : in physics.Joint.view;
+                                                           is_Anchor_A  : in Boolean;
+                                                           local_Anchor : in Vector_3)
+   is
+      the_c_Joint : constant Joint_pointer          := box2d_physics.Joint.view (the_Joint).C;
+      c_Anchor    : aliased  c_math_c.Vector_3.item := +local_Anchor;
+
+   begin
+      b2d_Joint_set_local_Anchor (the_c_Joint,
+                                  Boolean'Pos (is_Anchor_A),
+                                  c_Anchor'unchecked_Access);
+   end set_Joint_local_Anchor;
+
+
+   --- Joint Cursors
+   --
+
+   overriding
+   procedure next (Cursor : in out joint_Cursor)
+   is
+   begin
+      if Cursor.C.Joint = null then
+         raise constraint_Error with "Null cursor.";
+      end if;
+
+      b2d_Space_next_Joint (Cursor.C'unchecked_Access);
+   end next;
+
+
+   overriding
+   function has_Element (Cursor : in joint_Cursor) return Boolean
+   is
+   begin
+      return Cursor.C.Joint /= null;
+   end has_Element;
+
+
+   overriding
+   function Element (Cursor : in joint_Cursor) return physics.Joint.view
+   is
+   begin
+      if Cursor.C.Joint = null then
+         raise constraint_Error with "Null cursor.";
+      end if;
+
+      declare
+         the_C_raw_Joint : constant Swig.void_ptr    := b2d_b2Joint_user_Data (Cursor.C.Joint);
+         the_raw_Joint   : constant Any_limited_view := to_Any_view (the_C_raw_Joint);
+      begin
+         return physics.Joint.view (the_raw_Joint);
+      end;
+   end Element;
+
+
+   overriding
+   function first_Joint (Self : in Item) return physics.Space.joint_Cursor'Class
+   is
+      the_Cursor : constant joint_Cursor := (C => b2d_Space_first_Joint (Self.C));
+   begin
+      return the_Cursor;
+   end first_Joint;
+
+
+end box2d_Physics.Space;

3-mid/physics/interface/source/private/box2d/box2d_physics-space.ads

@@ -0,0 +1,216 @@
+with
+     physics.Space;
+
+private
+with
+     box2d_Physics.Object,
+     box2d_c.joint_Cursor,
+     box2d_c.Pointers,
+
+     physics.Model,
+     physics.Shape,
+     physics.Object,
+     physics.Joint.ball,
+     physics.Joint.slider,
+     physics.Joint.hinge,
+     physics.Joint.cone_twist,
+     physics.Joint.DoF6,
+
+     ada.Containers.hashed_Maps;
+
+package box2d_Physics.Space
+--
+-- Provide a Box2D implementation of a physical space.
+--
+is
+   type Item is new physics.Space.item with private;
+   type View is access all Item'Class;
+
+
+   function to_Space return Item;
+
+   overriding
+   function manifold_Count (Self : in     Item) return Natural;
+
+   overriding
+   function Manifold       (Self : access Item;   Index : in Positive) return physics.space.a_Manifold;
+
+   overriding
+   function object_Count   (Self : in     Item) return Natural;
+
+
+
+private
+
+   function Hash (the_C_Object : in box2d_c.Pointers.Object_Pointer) return ada.Containers.Hash_type;
+   use type box2d_c.Pointers.Object_pointer;
+   use type box2d_Physics.Object.view;
+   package c_Object_Maps_of_Object is new ada.Containers.hashed_Maps (Key_type        => box2d_c.Pointers.Object_Pointer,
+                                                                      Element_type    => box2d_Physics.Object.view,
+                                                                      Hash            => Hash,
+                                                                      equivalent_Keys => "=",
+                                                                      "="             => "=");
+   type Item is new physics.Space.item with
+      record
+         C          : box2d_c.Pointers.Space_Pointer;
+         object_Map : c_Object_Maps_of_Object.Map;
+      end record;
+
+   use Math;
+
+   type joint_Cursor is new physics.Space.joint_Cursor with
+      record
+         C : aliased box2d_c.joint_Cursor.item;
+      end record;
+
+   overriding
+   procedure next        (Cursor : in out joint_Cursor);
+   overriding
+   function  has_Element (Cursor : in     joint_Cursor) return Boolean;
+   overriding
+   function  Element     (Cursor : in     joint_Cursor) return physics.Joint.view;
+
+   overriding
+   function  first_Joint (Self   : in     Item)         return physics.Space.joint_Cursor'Class;
+
+
+   ----------
+   --- Forge
+   --
+
+   overriding
+   procedure destruct (Self : in out Item);
+
+
+   ---------
+   --- Forge
+   --
+
+   -- Shapes
+
+   overriding
+   function new_Shape (Self : access Item;   Model : in physics.Model.view) return physics.Shape.view;
+
+
+   -- 3D
+
+   overriding
+   function       new_sphere_Shape (Self : access Item;   Radius       : in Real := 0.5)                 return physics.Shape.view;
+   overriding
+   function          new_box_Shape (Self : access Item;   half_Extents : in Vector_3 := [0.5, 0.5, 0.5]) return physics.Shape.view;
+   overriding
+   function      new_capsule_Shape (Self : access Item;   Radius       : in Real :=  0.5;
+                                                          Height       : in Real)                        return physics.Shape.view;
+   overriding
+   function         new_cone_Shape (Self : access Item;   Radius       : in Real :=  0.5;
+                                                          Height       : in Real := 1.0)                 return physics.Shape.view;
+   overriding
+   function     new_cylinder_Shape (Self : access Item;   half_Extents : in Vector_3 := [0.5, 0.5, 0.5]) return physics.Shape.view;
+   overriding
+   function  new_heightfield_Shape (Self : access Item;   Heightfield  : in out physics.Heightfield;
+                                                          Scale        : in     Vector_3)                return physics.Shape.view;
+   overriding
+   function  new_multisphere_Shape (Self : access Item;   Sites        : in physics.Vector_3_array;
+                                                          Radii        : in math.Vector)                 return physics.Shape.view;
+   overriding
+   function        new_plane_Shape (Self : access Item;   Normal       : in Vector_3 := [0.0, 1.0, 0.0];
+                                                          Offset       : in Real     :=  0.0)            return physics.Shape.view;
+   overriding
+   function  new_convex_hull_Shape (Self : access Item;   Points       : in physics.Vector_3_array)      return physics.Shape.view;
+   overriding
+   function         new_mesh_Shape (Self : access Item;   Points       : access Physics.Geometry_3D.a_Model) return physics.Shape .view;
+
+
+   --  2D
+
+   overriding
+   function  new_circle_Shape  (Self : access Item;   Radius   : in Real := 0.5)                    return physics.Shape .view;
+   overriding
+   function  new_polygon_Shape (Self : access Item;   Vertices : in physics.Space.polygon_Vertices) return physics.Shape .view;
+
+
+   --  Objects
+
+   overriding
+   function  new_Object (Self : access Item;   of_Shape     : in physics.Shape .view;
+                                               of_Mass      : in Real;
+                                               Friction     : in Real;
+                                               Restitution  : in Real;
+                                               at_Site      : in Vector_3;
+                                               is_Kinematic : in Boolean) return physics.Object.view;
+   --  Joints
+   --
+   overriding
+   function new_hinge_Joint      (Self : access Item;   Object_A,
+                                                        Object_B         : in physics.Object.view;
+                                                        Anchor_in_A,
+                                                        Anchor_in_B      : in Vector_3;
+                                                        pivot_Axis       : in Vector_3;
+                                                        low_Limit,
+                                                        high_Limit       : in Real;
+                                                        collide_Conected : in Boolean)    return physics.Joint.hinge.view;
+   overriding
+   function new_hinge_Joint      (Self : access Item;   Object_A,
+                                                        Object_B         : in physics.Object.view;
+                                                        Frame_A,
+                                                        Frame_B          : in Matrix_4x4;
+                                                        low_Limit,
+                                                        high_Limit       : in Real;
+                                                        collide_Conected : in Boolean)    return physics.Joint.hinge.view;
+   overriding
+   function new_hinge_Joint      (Self : access Item;   Object_A         : in physics.Object.view;
+                                                        Frame_A          : in Matrix_4x4) return physics.Joint.hinge.view;
+   overriding
+   function new_DoF6_Joint       (Self : access Item;   Object_A,
+                                                        Object_B         : in physics.Object.view;
+                                                        Frame_A,
+                                                        Frame_B          : in Matrix_4x4) return physics.Joint.DoF6.view;
+   overriding
+   function new_ball_Joint       (Self : access Item;   Object_A,
+                                                        Object_B         : in physics.Object.view;
+                                                        Pivot_in_A,
+                                                        Pivot_in_B       : in Vector_3)   return physics.Joint.ball.view;
+   overriding
+   function new_slider_Joint     (Self : access Item;   Object_A,
+                                                        Object_B         : in physics.Object.view;
+                                                        Frame_A,
+                                                        Frame_B          : in Matrix_4x4) return physics.Joint.slider.view;
+   overriding
+   function new_cone_twist_Joint (Self : access Item;   Object_A,
+                                                        Object_B         : in physics.Object.view;
+                                                        Frame_A,
+                                                        Frame_B          : in Matrix_4x4) return physics.Joint.cone_twist.view;
+   -------------
+   -- Attributes
+   --
+
+   overriding
+   function  Gravity    (Self : in     Item)     return Vector_3;
+   overriding
+   procedure Gravity_is (Self : in out Item;   Now : in Vector_3);
+
+
+   ---------------
+   --- Operations
+   --
+
+   overriding
+   procedure evolve        (Self : in out Item;   By           : in Duration);
+   overriding
+   procedure add           (Self : in out Item;   the_Object   : in physics.Object.view);
+   overriding
+   procedure rid           (Self : in out Item;   the_Object   : in physics.Object.view);
+   overriding
+   function  cast_Ray      (Self : access Item;   From, To     : in Vector_3) return physics.Space.ray_Collision;
+   overriding
+   procedure add           (Self : in out Item;   the_Joint    : in physics.Joint.view);
+   overriding
+   procedure rid           (Self : in out Item;   the_Joint    : in physics.Joint.view);
+   overriding
+   procedure update_Bounds (Self : in out Item;   of_Obect     : in physics.Object.view);
+   overriding
+   procedure set_Joint_local_Anchor
+                           (Self : in out Item;   the_Joint    : in physics.Joint.view;
+                                                  is_Anchor_A  : in Boolean;
+                                                  local_Anchor : in Vector_3);
+end box2d_Physics.Space;

3-mid/physics/interface/source/private/box2d/box2d_physics.ads

@@ -0,0 +1,15 @@
+with
+     float_Math;
+
+package box2d_Physics
+--
+-- Provides an implementation of the physics interface using a binding to the Box2D C library.
+--
+is
+   pragma Pure;
+
+   package Math renames float_Math;
+
+   Error : exception;
+
+end box2d_Physics;

3-mid/physics/interface/source/private/bullet/bullet_physics-joint.adb

@@ -0,0 +1,949 @@
+with
+     bullet_c.Binding,
+     bullet_physics.Object,
+
+     c_math_c.Vector_3,
+     c_math_c.Matrix_4x4,
+     c_math_c.Conversion,
+
+     Swig,
+     interfaces.C,
+
+     ada.unchecked_Conversion,
+     ada.unchecked_Deallocation,
+     ada.Text_IO;
+
+package body bullet_Physics.Joint
+is
+   use c_math_c.Conversion,
+       bullet_c.Binding,
+       Interfaces,
+       ada.Text_IO;
+
+
+   type Any_limited_view is access all lace.Any.limited_item'Class;
+
+   function to_Any_view    is new ada.unchecked_Conversion (Swig.void_ptr,    Any_limited_view);
+   function to_Object_view is new ada.unchecked_Conversion (swig.void_ptr, physics.Object.view);
+   pragma Unreferenced (to_Object_view);
+
+
+   --------------
+   --  Joint.item
+   --
+
+   overriding
+   function reaction_Force (Self : in Item) return Vector_3
+   is
+   begin
+      raise Error with "TODO";
+      return math.Origin_3D;
+   end reaction_Force;
+
+
+   overriding
+   function reaction_Torque (Self : in Item) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end reaction_Torque;
+
+
+   overriding
+   procedure user_Data_is (Self : in out Item;   Now : access lace.Any.limited_item'Class)
+   is
+   begin
+      Self.user_Data := Now;
+   end user_Data_is;
+
+
+   overriding
+   function user_Data (Self : in Item) return access lace.Any.limited_item'Class
+   is
+   begin
+      return Self.user_Data;
+   end user_Data;
+
+
+   --------
+   --  DoF6
+   --
+
+   function new_Dof6_Joint (Object_A, Object_B : in physics.Object.view;
+                            Frame_A,  Frame_B  : in Matrix_4x4) return physics.Joint.DoF6.view
+   is
+      Self : constant DoF6_view := new DoF6;
+
+      c_Object_A : constant bullet_C.Pointers.Object_Pointer := bullet_physics.Object.view (Object_A).C;
+      c_Object_B : constant bullet_C.Pointers.Object_Pointer := bullet_physics.Object.view (Object_B).C;
+
+      c_Frame_A  : aliased  c_math_c.Matrix_4x4.item := +Frame_A;
+      c_Frame_B  : aliased  c_math_c.Matrix_4x4.item := +Frame_B;
+
+   begin
+      Self.C := b3d_new_DoF6_Joint (c_Object_A,
+                                    c_Object_B,
+                                    c_Frame_A'unchecked_Access,
+                                    c_Frame_B'unchecked_Access);
+      return Self;
+   end new_Dof6_Joint;
+
+
+   overriding
+   procedure destruct (Self : in out DoF6)
+   is
+   begin
+      raise Error with "TODO";
+   end destruct;
+
+
+   overriding
+   function Object_A (Self : in DoF6) return physics.Object.view
+   is
+      c_Object_A : constant bullet_c.Pointers.Object_pointer := b3d_Joint_Object_A (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b3d_Object_user_Data (c_Object_A)));
+   end Object_A;
+
+
+   overriding
+   function Object_B (Self : in DoF6) return physics.Object.view
+   is
+      c_Object_B : constant bullet_c.Pointers.Object_pointer := b3d_Joint_Object_B (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b3d_Object_user_Data (c_Object_B)));
+   end Object_B;
+
+
+   overriding
+   function Frame_A (Self : in DoF6) return Matrix_4x4
+   is
+   begin
+      return +b3d_Joint_Frame_A (Self.C);
+   end Frame_A;
+
+
+   overriding
+   function Frame_B (Self : in DoF6) return Matrix_4x4
+   is
+   begin
+      return +b3d_Joint_Frame_B (Self.C);
+   end Frame_B;
+
+
+   overriding
+   procedure Frame_A_is (Self : in out DoF6;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b3d_Joint_Frame_A_is (Self.C, c_Now'unchecked_Access);
+   end Frame_A_is;
+
+
+   overriding
+   procedure Frame_B_is (Self : in out DoF6;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b3d_Joint_Frame_B_is (Self.C, c_Now'unchecked_Access);
+   end Frame_B_is;
+
+
+   overriding
+   function is_Limited (Self : in DoF6;   DoF : in Degree_of_freedom) return Boolean
+   is
+      use type Swig.bool;
+   begin
+      return b3d_Joint_is_Limited (Self.C,
+                                   Degree_of_freedom'Pos (DoF)) /= 0;
+   end is_Limited;
+
+
+   overriding
+   procedure Velocity_is (Self : in out DoF6;   Now : in Real;
+                                                DoF : in Degree_of_freedom)
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & DoF'Image & ".";
+      end if;
+
+      b3d_Joint_Velocity_is (Self.C, C.int (DoF),
+                                     c_math_c.Real (Now));
+   end Velocity_is;
+
+
+   overriding
+   function Extent (Self : in DoF6;   DoF : Degree_of_freedom) return Real
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & DoF'Image & ".";
+      end if;
+
+      return Real (b3d_Joint_Extent (Self.C, C.int (DoF)));
+   end Extent;
+
+
+   overriding
+   procedure desired_Extent_is (Self : in out DoF6;   Now : in Real;
+                                                      DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end desired_Extent_is;
+
+
+   overriding
+   function lower_Limit (Self : in DoF6;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      return Real (b3d_Joint_6DoF_lower_Limit (Self.C, C.int (DoF)));
+   end lower_Limit;
+
+
+   overriding
+   function upper_Limit (Self : in DoF6;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      return Real (b3d_Joint_6DoF_upper_Limit (Self.C, C.int (DoF)));
+   end upper_Limit;
+
+
+   overriding
+   procedure lower_Limit_is (Self : in out DoF6;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)
+   is
+   begin
+      b3d_Joint_6DoF_lower_Limit_is (Self.C, C.int (DoF),
+                                             c_math_c.Real (Now));
+   end lower_Limit_is;
+
+
+   overriding
+   procedure upper_Limit_is (Self : in out DoF6;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)
+   is
+   begin
+      b3d_Joint_6DoF_upper_Limit_is (Self.C, C.int (DoF),
+                                             c_math_c.Real (Now));
+   end upper_Limit_is;
+
+
+   --------
+   --  Ball
+   --
+
+   function new_Ball_Joint (Object_A,   Object_B   : in physics.Object.view;
+                            Pivot_in_A, Pivot_in_B : in Vector_3) return physics.Joint.ball.view
+   is
+      Self : constant Ball_view := new Ball;
+
+      c_Object_A   : constant bullet_C.Pointers.Object_Pointer := bullet_physics.Object.view (Object_A).C;
+      c_Object_B   : constant bullet_C.Pointers.Object_Pointer := bullet_physics.Object.view (Object_B).C;
+
+      c_Pivot_in_A : aliased  c_math_c.Vector_3.item := +Pivot_in_A;
+      c_Pivot_in_B : aliased  c_math_c.Vector_3.item := +Pivot_in_B;
+
+   begin
+      Self.C := b3d_new_ball_Joint (c_Object_A,
+                                    c_Object_B,
+                                    c_Pivot_in_A'unchecked_Access,
+                                    c_Pivot_in_B'unchecked_Access);
+      return Self;
+   end new_Ball_Joint;
+
+
+   overriding
+   procedure destruct (Self : in out Ball)
+   is
+   begin
+      raise Error with "TODO";
+   end destruct;
+
+
+   overriding
+   function Object_A (Self : in Ball) return physics.Object.view
+   is
+      c_Object_A : constant bullet_c.Pointers.Object_Pointer := b3d_Joint_Object_A (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b3d_Object_user_Data (c_Object_A)));
+   end Object_A;
+
+
+   overriding
+   function Object_B (Self : in Ball) return physics.Object.view
+   is
+      c_Object_B : constant bullet_c.Pointers.Object_Pointer := b3d_Joint_Object_B (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b3d_Object_user_Data (c_Object_B)));
+   end Object_B;
+
+
+   overriding
+   function Frame_A (Self : in Ball) return Matrix_4x4
+   is
+   begin
+      return +b3d_Joint_Frame_A (Self.C);
+   end Frame_A;
+
+
+   overriding
+   function Frame_B (Self : in Ball) return Matrix_4x4
+   is
+   begin
+      return +b3d_Joint_Frame_B (Self.C);
+   end Frame_B;
+
+
+   overriding
+   procedure Frame_A_is (Self : in out Ball;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b3d_Joint_Frame_A_is (Self.C, c_Now'unchecked_Access);
+   end Frame_A_is;
+
+
+   overriding
+   procedure Frame_B_is (Self : in out Ball;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b3d_Joint_Frame_B_is (Self.C, c_Now'unchecked_Access);
+   end Frame_B_is;
+
+
+   overriding
+   function is_Limited (Self : in Ball;   DoF : in Degree_of_freedom) return Boolean
+   is
+      use type Swig.bool;
+   begin
+      return b3d_Joint_is_Limited (Self.C,
+                                   Degree_of_freedom'Pos (DoF)) /= 0;
+   end is_Limited;
+
+
+   overriding
+   procedure Velocity_is (Self : in out Ball;   Now : in Real;
+                                                DoF : in Degree_of_freedom)
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & DoF'Image & ".";
+      end if;
+
+      b3d_Joint_Velocity_is (Self.C, C.int (Now),
+                                     c_math_c.Real (DoF));
+   end Velocity_is;
+
+
+   overriding
+   function Extent (Self : in Ball;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      if DoF < 4 then
+         raise Program_Error with "Illegal degree of freedom:" & DoF'Image & ".";
+      end if;
+
+      return Real (b3d_Joint_Extent (Self.C, C.int (DoF)));
+   end Extent;
+
+
+   overriding
+   procedure desired_Extent_is (Self : in out Ball;   Now : in Real;
+                                                      DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end desired_Extent_is;
+
+
+   overriding
+   function lower_Limit (Self : in Ball;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end lower_Limit;
+
+
+   overriding
+   function upper_Limit (Self : in Ball;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end upper_Limit;
+
+
+   overriding
+   procedure lower_Limit_is (Self : in out Ball;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end lower_Limit_is;
+
+
+   overriding
+   procedure upper_Limit_is (Self : in out Ball;   Now : in Real;
+                                                   DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end upper_Limit_is;
+
+
+   ----------
+   --  Slider
+   --
+
+   function new_Slider_Joint (Object_A,   Object_B : in physics.Object.view;
+                              Frame_A,    Frame_B  : in Matrix_4x4) return physics.Joint.slider.view
+   is
+      Self       : constant Slider_view := new Slider;
+
+      c_Object_A : constant bullet_C.Pointers.Object_Pointer := bullet_physics.Object.view (Object_A).C;
+      c_Object_B : constant bullet_C.Pointers.Object_Pointer := bullet_physics.Object.view (Object_B).C;
+
+      c_Frame_A  : aliased c_math_c.Matrix_4x4.item := +Frame_A;
+      c_Frame_B  : aliased c_math_c.Matrix_4x4.item := +Frame_B;
+   begin
+      Self.C := b3d_new_slider_Joint (c_Object_A,
+                                      c_Object_B,
+                                      c_Frame_A'Unchecked_Access,
+                                      c_Frame_B'Unchecked_Access);
+      return Self;
+   end new_Slider_Joint;
+
+
+   overriding
+   procedure destruct (Self : in out Slider)
+   is
+   begin
+      raise Error with "TODO";
+   end destruct;
+
+
+   overriding
+   function Object_A (Self : in  Slider) return physics.Object.view
+   is
+      c_Object_A : constant bullet_c.Pointers.Object_Pointer := b3d_Joint_Object_A (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b3d_Object_user_Data (c_Object_A)));
+   end Object_A;
+
+
+   overriding
+   function Object_B (Self : in Slider) return physics.Object.view
+   is
+      c_Object_B : constant bullet_c.Pointers.Object_Pointer := b3d_Joint_Object_B (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b3d_Object_user_Data (c_Object_B)));
+   end Object_B;
+
+
+   overriding
+   function Frame_A (Self : in Slider) return Matrix_4x4
+   is
+   begin
+      return +b3d_Joint_Frame_A (Self.C);
+   end Frame_A;
+
+
+   overriding
+   function Frame_B (Self : in Slider) return Matrix_4x4
+   is
+   begin
+      return +b3d_Joint_Frame_B (Self.C);
+   end Frame_B;
+
+
+   overriding
+   procedure Frame_A_is (Self : in out Slider;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b3d_Joint_Frame_A_is (Self.C, c_Now'unchecked_Access);
+   end Frame_A_is;
+
+
+   overriding
+   procedure Frame_B_is (Self : in out Slider;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b3d_Joint_Frame_B_is (Self.C, c_Now'unchecked_Access);
+   end Frame_B_is;
+
+
+   overriding
+   function is_Limited (Self : in Slider;   DoF : in Degree_of_freedom) return Boolean
+   is
+      use type Swig.bool;
+   begin
+      return b3d_Joint_is_Limited (Self.C,
+                                   Degree_of_freedom'Pos (DoF)) /= 0;
+   end is_Limited;
+
+
+   overriding
+   procedure Velocity_is (Self : in out Slider;   Now : in Real;
+                                                  DoF : in Degree_of_freedom)
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & DoF'Image & ".";
+      end if;
+
+      b3d_Joint_Velocity_is (Self.C, C.int (Now),
+                                     c_math_c.Real (DoF));
+   end Velocity_is;
+
+
+   overriding
+   function Extent (Self : in Slider;   DoF : Degree_of_freedom) return Real
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & DoF'Image & ".";
+      end if;
+
+      return Real (b3d_Joint_Extent (Self.C, C.int (DoF)));
+   end Extent;
+
+
+   overriding
+   procedure desired_Extent_is (Self : in out Slider;   Now : in Real;
+                                                        DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end desired_Extent_is;
+
+
+   overriding
+   function lower_Limit (Self : in Slider;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end lower_Limit;
+
+
+   overriding
+   function upper_Limit (Self : in Slider;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end upper_Limit;
+
+
+   overriding
+   procedure lower_Limit_is (Self : in out Slider;   Now : in Real;
+                                                     DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end lower_Limit_is;
+
+
+   overriding
+   procedure upper_Limit_is (Self : in out Slider;   Now : in Real;
+                                                     DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end upper_Limit_is;
+
+
+   --------------
+   --  cone_Twist
+   --
+
+   function new_cone_Twist_Joint (Object_A,   Object_B   : in physics.Object.view;
+                                  Frame_A,    Frame_B    : in Matrix_4x4) return physics.Joint.cone_twist.view
+   is
+      Self : constant cone_Twist_view := new cone_Twist;
+
+      c_Object_A : constant bullet_C.Pointers.Object_Pointer := bullet_physics.Object.view (Object_A).C;
+      c_Object_B : constant bullet_C.Pointers.Object_Pointer := bullet_physics.Object.view (Object_B).C;
+
+      c_Frame_A  : aliased  c_math_c.Matrix_4x4.item := +Frame_A;
+      c_Frame_B  : aliased  c_math_c.Matrix_4x4.item := +Frame_B;
+   begin
+      Self.C := b3d_new_DoF6_Joint (c_Object_A,
+                                    c_Object_B,
+                                    c_Frame_A'unchecked_Access,
+                                    c_Frame_B'unchecked_Access);
+      return Self;
+   end new_cone_Twist_Joint;
+
+
+   overriding
+   procedure destruct (Self : in out cone_Twist)
+   is
+   begin
+      raise Error with "TODO";
+   end destruct;
+
+
+   overriding
+   function Object_A (Self : in cone_Twist) return physics.Object.view
+   is
+      c_Object_A : constant bullet_c.Pointers.Object_pointer := b3d_Joint_Object_A (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b3d_Object_user_Data (c_Object_A)));
+   end Object_A;
+
+
+   overriding
+   function Object_B (Self : in cone_Twist) return physics.Object.view
+   is
+      c_Object_B : constant bullet_c.Pointers.Object_pointer := b3d_Joint_Object_B (Self.C);
+   begin
+      return physics.Object.view (to_Any_view (b3d_Object_user_Data (c_Object_B)));
+   end Object_B;
+
+
+   overriding
+   function Frame_A (Self : in cone_Twist) return Matrix_4x4
+   is
+   begin
+      return +b3d_Joint_Frame_A (Self.C);
+   end Frame_A;
+
+
+   overriding
+   function Frame_B (Self : in cone_Twist) return Matrix_4x4
+   is
+   begin
+      return +b3d_Joint_Frame_B (Self.C);
+   end Frame_B;
+
+
+   overriding
+   procedure Frame_A_is  (Self : in out cone_Twist;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b3d_Joint_Frame_A_is (Self.C, c_Now'unchecked_Access);
+   end Frame_A_is;
+
+
+   overriding
+   procedure Frame_B_is (Self : in out cone_Twist;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b3d_Joint_Frame_B_is (Self.C, c_Now'unchecked_Access);
+   end Frame_B_is;
+
+
+   overriding
+   function is_Limited (Self : in cone_Twist;   DoF : Degree_of_freedom) return Boolean
+   is
+      use type Swig.bool;
+   begin
+      return b3d_Joint_is_Limited (Self.C,
+                                   Degree_of_freedom'Pos (DoF)) /= 0;
+   end is_Limited;
+
+
+   overriding
+   procedure Velocity_is (Self : in out cone_Twist;   Now : in Real;
+                                                      DoF : in Degree_of_freedom)
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & DoF'Image & ".";
+      end if;
+
+      b3d_Joint_Velocity_is (Self.C, C.int (Now),
+                                     c_math_c.Real (DoF));
+   end Velocity_is;
+
+
+   overriding
+   function Extent (Self : in cone_Twist;   DoF : Degree_of_freedom) return Real
+   is
+   begin
+      if DoF < 4 then
+         raise Error with "Illegal degree of freedom:" & DoF'Image & ".";
+      end if;
+
+      return Real (b3d_Joint_Extent (Self.C, C.int (DoF)));
+   end Extent;
+
+
+   overriding
+   procedure desired_Extent_is (Self : in out cone_Twist;   Now : in Real;
+                                                            DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end desired_Extent_is;
+
+
+   overriding
+   function lower_Limit (Self : in cone_Twist;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end lower_Limit;
+
+
+   overriding
+   function upper_Limit (Self : in cone_Twist;   DoF : in Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end upper_Limit;
+
+
+   overriding
+   procedure lower_Limit_is (Self : in out cone_Twist;   Now : in Real;
+                                                         DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end lower_Limit_is;
+
+
+   overriding
+   procedure upper_Limit_is (Self : in out cone_Twist;   Now : in Real;
+                                                         DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end upper_Limit_is;
+
+
+   ---------
+   --  Hinge
+   --
+
+   function new_hinge_Joint (Object_A : in physics.Object.view;
+                             Frame_A  : in Matrix_4x4) return physics.Joint.hinge.view
+   is
+      use type bullet_physics.Object.view;
+
+      Self : constant Hinge_view := new Hinge;
+
+      c_Object_A : constant bullet_C.Pointers.Object_Pointer := bullet_physics.Object.view (Object_A).C;
+      c_Frame_A  : aliased  c_math_c.Matrix_4x4.item         := +Frame_A;
+
+   begin
+      Self.C := b3d_new_space_hinge_Joint (c_Object_A,
+                                           c_Frame_A'unchecked_Access);
+      return Self;
+   end new_hinge_Joint;
+
+
+   overriding
+   procedure destruct (Self : in out Hinge)
+   is
+      pragma unreferenced (Self);
+   begin
+      put_Line ("bullet_physics-joint.adb =>    raise Program_Error with ""TBD"";");
+      raise Error with "TODO";
+   end destruct;
+
+
+   function new_hinge_Joint (Object_A, Object_B : in physics.Object.view;
+                             Frame_A,  Frame_B  : in Matrix_4x4) return physics.Joint.hinge.view
+   is
+      use type bullet_physics.Object.view;
+
+      Self : constant Hinge_view := new Hinge;
+
+      c_Object_A : bullet_C.Pointers.Object_Pointer;
+      c_Object_B : bullet_C.Pointers.Object_Pointer;
+
+      c_Frame_A  : aliased c_math_c.Matrix_4x4.item := +Frame_A;
+      c_Frame_B  : aliased c_math_c.Matrix_4x4.item := +Frame_B;
+
+   begin
+      if bullet_physics.Object.view (Object_A) /= null
+      then
+         c_Object_A := bullet_physics.Object.view (Object_A).C;
+      end if;
+
+      if bullet_physics.Object.view (Object_B) /= null
+      then
+         c_Object_B := bullet_physics.Object.view (Object_B).C;
+      end if;
+
+      Self.C := b3d_new_hinge_Joint (c_Object_A,
+                                     c_Object_B,
+                                     c_Frame_A'unchecked_Access,
+                                     c_Frame_B'unchecked_Access);
+      return Self;
+   end new_hinge_Joint;
+
+
+   overriding
+   procedure Limits_are (Self : in out Hinge;   Low, High        : in Real;
+                                                Softness         : in Real := 0.9;
+                                                biasFactor       : in Real := 0.3;
+                                                relaxationFactor : in Real := 1.0)
+   is
+   begin
+      b3d_Joint_hinge_Limits_are (Self.C,
+                                  c_Math_c.Real (Low),
+                                  c_Math_c.Real (High),
+                                  c_Math_c.Real (Softness),
+                                  c_Math_c.Real (biasFactor),
+                                  c_Math_c.Real (relaxationFactor));
+   end Limits_are;
+
+
+   overriding
+   function lower_Limit (Self : in Hinge) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end lower_Limit;
+
+
+   overriding
+   function upper_Limit (Self : in Hinge) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end upper_Limit;
+
+
+   overriding
+   function Angle (Self : in Hinge) return Real
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end Angle;
+
+
+   overriding
+   function Object_A (Self : in Hinge) return physics.Object.view
+   is
+   begin
+      raise Error with "TODO";
+      return null;
+   end Object_A;
+
+
+   overriding
+   function Object_B (Self : in Hinge) return physics.Object.view
+   is
+   begin
+      raise Error with "TODO";
+      return null;
+   end Object_B;
+
+
+   overriding
+   function Frame_A (Self : in Hinge) return Matrix_4x4
+   is
+      c_Frame : aliased  c_math_c.Matrix_4x4.item;
+   begin
+      raise Error with "TODO";
+      return +c_Frame;
+   end Frame_A;
+
+
+   overriding
+   function Frame_B (Self : in Hinge) return Matrix_4x4
+   is
+      c_Frame : aliased  c_math_c.Matrix_4x4.item;
+   begin
+      raise Error with "TODO";
+      return +c_Frame;
+   end Frame_B;
+
+
+   overriding
+   procedure Frame_A_is (Self : in out Hinge;   Now : in Matrix_4x4)
+   is
+      c_Frame : aliased constant c_math_c.Matrix_4x4.item := +Now;
+      pragma Unreferenced (c_Frame);
+   begin
+      raise Error with "TODO";
+   end Frame_A_is;
+
+
+   overriding
+   procedure Frame_B_is (Self : in out Hinge;   Now : in Matrix_4x4)
+   is
+      c_Frame : aliased constant c_math_c.Matrix_4x4.item := +Now;
+      pragma Unreferenced (c_Frame);
+   begin
+      raise Error with "TODO";
+   end Frame_B_is;
+
+
+   overriding
+   function is_Limited (Self : in Hinge;   DoF : Degree_of_freedom) return Boolean
+   is
+      pragma unreferenced (Self);
+   begin
+      return DoF = 1;
+   end is_Limited;
+
+
+   overriding
+   procedure Velocity_is (Self : in out Hinge;   Now : in Real;
+                                                 DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+
+      if DoF /= 1 then
+         raise Error with "Illegal degree of freedom:" & DoF'Image & ".";
+      end if;
+   end Velocity_is;
+
+
+   overriding
+   function Extent (Self : in Hinge;   DoF : Degree_of_freedom) return Real
+   is
+   begin
+      raise Error with "TODO";
+
+      if DoF /= 1 then
+         raise Error with "Illegal degree of freedom:" & DoF'Image & ".";
+      end if;
+
+      return 0.0;
+   end Extent;
+
+
+   overriding
+   procedure desired_Extent_is (Self : in out Hinge;   Now : in Real;
+                                                       DoF : in Degree_of_freedom)
+   is
+   begin
+      raise Error with "TODO";
+   end desired_Extent_is;
+
+
+   --------
+   --- Free
+   --
+
+   procedure free (the_Joint : in out physics.Joint.view)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (physics.Joint.item'Class,
+                                                              physics.Joint.view);
+   begin
+      deallocate (the_Joint);
+   end free;
+
+
+end bullet_Physics.Joint;

3-mid/physics/interface/source/private/bullet/bullet_physics-joint.ads

@@ -0,0 +1,333 @@
+with
+     physics.Joint.DoF6,
+     physics.Joint.cone_twist,
+     physics.Joint.slider,
+     physics.Joint.hinge,
+     physics.Joint.ball,
+     physics.Object,
+
+     bullet_C.Pointers,
+
+     lace.Any;
+
+package bullet_Physics.Joint
+--
+-- Provides glue between a physics joint and a Bullet3D joint.
+--
+is
+   type Item is abstract limited new physics.Joint.item with
+      record
+         C         : bullet_c.Pointers.Joint_pointer;
+         user_Data : access lace.Any.limited_item'Class;
+      end record;
+
+   type View is access all Item'Class;
+
+
+   ---------
+   --- Forge
+   --
+
+   use Math;
+
+   function new_Dof6_Joint       (Object_A,   Object_B   : in physics.Object.view;
+                                  Frame_A,    Frame_B    : in Matrix_4x4) return physics.Joint.DoF6.view;
+
+   function new_ball_Joint       (Object_A,   Object_B   : in physics.Object.view;
+                                  Pivot_in_A, Pivot_in_B : in Vector_3) return physics.Joint.ball.view;
+
+   function new_slider_Joint     (Object_A,   Object_B   : in physics.Object.view;
+                                  Frame_A,    Frame_B    : in Matrix_4x4) return physics.Joint.slider.view;
+
+   function new_cone_twist_Joint (Object_A,   Object_B   : in physics.Object.view;
+                                  Frame_A,    Frame_B    : in Matrix_4x4) return physics.Joint.cone_twist.view;
+
+   function new_hinge_Joint      (Object_A,   Object_B   : in physics.Object.view;
+                                  Frame_A,    Frame_B    : in Matrix_4x4) return physics.Joint.hinge.view;
+
+   function new_hinge_Joint      (Object_A               : in physics.Object.view;
+                                  Frame_A                : in Matrix_4x4) return physics.Joint.hinge.view;
+
+   procedure free (the_Joint : in out physics.Joint.view);
+
+
+
+private
+
+   use physics.Joint;
+
+   overriding
+   function  reaction_Force  (Self : in     Item) return Vector_3;
+   overriding
+   function  reaction_Torque (Self : in     Item) return Real;
+
+   overriding
+   procedure user_Data_is    (Self : in out Item;   Now : access lace.Any.limited_item'Class);
+   overriding
+   function  user_Data       (Self : in     Item)  return access lace.Any.limited_item'Class;
+
+
+   --------
+   --  DoF6
+   --
+   type DoF6 is new Item
+                and physics.Joint.DoF6.item with
+      record
+         null;
+      end record;
+
+   type DoF6_view is access DoF6
+   ;
+
+   overriding
+   procedure destruct    (Self : in out DoF6);
+
+   overriding
+   function  Object_A     (Self : in     DoF6)     return physics.Object.view;
+   overriding
+   function  Object_B     (Self : in     DoF6)     return physics.Object.view;
+
+   overriding
+   function  Frame_A      (Self : in     DoF6)     return Matrix_4x4;
+   overriding
+   function  Frame_B      (Self : in     DoF6)     return Matrix_4x4;
+
+   overriding
+   procedure Frame_A_is  (Self : in out DoF6;   Now : in Matrix_4x4);
+   overriding
+   procedure Frame_B_is  (Self : in out DoF6;   Now : in Matrix_4x4);
+
+   overriding
+   function  is_Limited  (Self : in     DoF6;   DoF : in Degree_of_freedom) return Boolean;
+
+   overriding
+   procedure Velocity_is (Self : in out DoF6;   Now : in Real;
+                                                DoF : in Degree_of_freedom);
+   overriding
+   function  Extent            (Self : in     DoF6;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   procedure desired_Extent_is (Self : in out DoF6;   Now : in Real;
+                                                      DoF : in Degree_of_freedom);
+   overriding
+   function  lower_Limit    (Self : in     DoF6;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   function  upper_Limit    (Self : in     DoF6;   DoF : in Degree_of_freedom) return Real;
+
+   overriding
+   procedure lower_Limit_is (Self : in out DoF6;   Now : in Real;
+                                                   DoF : in Degree_of_freedom);
+   overriding
+   procedure upper_Limit_is (Self : in out DoF6;   Now : in Real;
+                                                   DoF : in Degree_of_freedom);
+
+   ----------
+   --  Slider
+   --
+   type Slider is new Item
+                  and physics.Joint.Slider.item with
+      record
+         null;
+      end record;
+
+   type Slider_view is access Slider;
+
+
+   overriding
+   procedure destruct    (Self : in out Slider);
+
+   overriding
+   function  Object_A    (Self : in     Slider) return physics.Object.view;
+   overriding
+   function  Object_B    (Self : in     Slider) return physics.Object.view;
+
+   overriding
+   function  Frame_A     (Self : in     Slider) return Matrix_4x4;
+   overriding
+   function  Frame_B     (Self : in     Slider) return Matrix_4x4;
+
+   overriding
+   procedure Frame_A_is  (Self : in out Slider;   Now : in Matrix_4x4);
+   overriding
+   procedure Frame_B_is  (Self : in out Slider;   Now : in Matrix_4x4);
+
+   overriding
+   function  is_Limited  (Self : in     Slider;   DoF : in Degree_of_freedom) return Boolean;
+   overriding
+   procedure Velocity_is (Self : in out Slider;   Now : in Real;
+                                                  DoF : in Degree_of_freedom);
+   overriding
+   function  Extent            (Self : in     Slider;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   procedure desired_Extent_is (Self : in out Slider;   Now : in Real;
+                                                        DoF : in Degree_of_freedom);
+   overriding
+   function  lower_Limit    (Self : in     Slider;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   function  upper_Limit    (Self : in     Slider;   DoF : in Degree_of_freedom) return Real;
+
+   overriding
+   procedure lower_Limit_is (Self : in out Slider;   Now : in Real;
+                                                     DoF : in Degree_of_freedom);
+   overriding
+   procedure upper_Limit_is (Self : in out Slider;   Now : in Real;
+                                                     DoF : in Degree_of_freedom);
+
+   --------------
+   --  cone_Twist
+   --
+   type cone_Twist is new Item
+                      and physics.Joint.cone_Twist.item with
+      record
+         null;
+      end record;
+
+   type cone_Twist_view is access cone_Twist;
+
+
+   overriding
+   procedure destruct    (Self : in out cone_Twist);
+
+   overriding
+   function  Object_A    (Self : in     cone_Twist)     return physics.Object.view;
+   overriding
+   function  Object_B    (Self : in     cone_Twist)     return physics.Object.view;
+
+   overriding
+   function  Frame_A     (Self : in     cone_Twist)     return Matrix_4x4;
+   overriding
+   function  Frame_B     (Self : in     cone_Twist)     return Matrix_4x4;
+
+   overriding
+   procedure Frame_A_is  (Self : in out cone_Twist;   Now : in Matrix_4x4);
+   overriding
+   procedure Frame_B_is  (Self : in out cone_Twist;   Now : in Matrix_4x4);
+
+   overriding
+   function  is_Limited  (Self : in     cone_Twist;   DoF : in Degree_of_freedom)    return Boolean;
+   overriding
+   procedure Velocity_is (Self : in out cone_Twist;   Now : in Real;
+                                                      DoF : in Degree_of_freedom);
+   overriding
+   function  Extent            (Self : in     cone_Twist;   DoF : Degree_of_freedom) return Real;
+   overriding
+   procedure desired_Extent_is (Self : in out cone_Twist;   Now : in Real;
+                                                            DoF : in Degree_of_freedom);
+   overriding
+   function  lower_Limit    (Self : in     cone_Twist;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   function  upper_Limit    (Self : in     cone_Twist;   DoF : in Degree_of_freedom) return Real;
+
+   overriding
+   procedure lower_Limit_is (Self : in out cone_Twist;   Now : in Real;
+                                                         DoF : in Degree_of_freedom);
+   overriding
+   procedure upper_Limit_is (Self : in out cone_Twist;   Now : in Real;
+                                                         DoF : in Degree_of_freedom);
+
+   --------
+   --  Ball
+   --
+   type Ball is new Item
+                and physics.Joint.Ball.item with
+      record
+         null;
+      end record;
+
+   type Ball_view is access Ball;
+
+
+   overriding
+   procedure destruct   (Self : in out Ball);
+
+   overriding
+   function  Object_A   (Self : in     Ball) return physics.Object.view;
+   overriding
+   function  Object_B   (Self : in     Ball) return physics.Object.view;
+
+   overriding
+   function  Frame_A    (Self : in     Ball) return Matrix_4x4;
+   overriding
+   function  Frame_B    (Self : in     Ball) return Matrix_4x4;
+
+   overriding
+   procedure Frame_A_is (Self : in out Ball;   Now : in Matrix_4x4);
+   overriding
+   procedure Frame_B_is (Self : in out Ball;   Now : in Matrix_4x4);
+
+   overriding
+   function  is_Limited  (Self : in     Ball;   DoF : in Degree_of_freedom) return Boolean;
+   overriding
+   procedure Velocity_is (Self : in out Ball;   Now : in Real;
+                                                DoF : in Degree_of_freedom);
+   overriding
+   function  Extent            (Self : in     Ball;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   procedure desired_Extent_is (Self : in out Ball;   Now : in Real;
+                                                      DoF : in Degree_of_freedom);
+   overriding
+   function  lower_Limit    (Self : in     Ball;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   function  upper_Limit    (Self : in     Ball;   DoF : in Degree_of_freedom) return Real;
+
+   overriding
+   procedure lower_Limit_is (Self : in out Ball;   Now : in Real;
+                                                   DoF : in Degree_of_freedom);
+   overriding
+   procedure upper_Limit_is (Self : in out Ball;   Now : in Real;
+                                                   DoF : in Degree_of_freedom);
+
+   ---------
+   --  Hinge
+   --
+   type Hinge is new Item
+                and physics.Joint.Hinge.item with
+      record
+         null;
+      end record;
+
+   type Hinge_view is access Hinge;
+
+
+   overriding
+   procedure destruct    (Self : in out Hinge);
+
+   overriding
+   function  Object_A    (Self : in     Hinge)     return physics.Object.view;
+   overriding
+   function  Object_B    (Self : in     Hinge)     return physics.Object.view;
+
+   overriding
+   function  Frame_A     (Self : in     Hinge)     return Matrix_4x4;
+   overriding
+   function  Frame_B     (Self : in     Hinge)     return Matrix_4x4;
+
+   overriding
+   procedure Frame_A_is  (Self : in out Hinge;   Now : in Matrix_4x4);
+   overriding
+   procedure Frame_B_is  (Self : in out Hinge;   Now : in Matrix_4x4);
+
+   overriding
+   function  is_Limited  (Self : in     Hinge;   DoF : in Degree_of_freedom) return Boolean;
+   overriding
+   procedure Velocity_is (Self : in out Hinge;   Now : in Real;
+                                                 DoF : in Degree_of_freedom);
+   overriding
+   function  Extent            (Self : in     Hinge;   DoF : in Degree_of_freedom) return Real;
+   overriding
+   procedure desired_Extent_is (Self : in out Hinge;   Now : in Real;
+                                                       DoF : in Degree_of_freedom);
+   overriding
+   procedure Limits_are  (Self : in out Hinge;   Low, High        : in Real;
+                                                 Softness         : in Real := 0.9;
+                                                 biasFactor       : in Real := 0.3;
+                                                 relaxationFactor : in Real := 1.0);
+   overriding
+   function  lower_Limit (Self : in     Hinge)   return Real;
+   overriding
+   function  upper_Limit (Self : in     Hinge)   return Real;
+
+   overriding
+   function  Angle       (Self : in     Hinge)   return Real;
+
+
+end bullet_Physics.Joint;

3-mid/physics/interface/source/private/bullet/bullet_physics-object.adb

@@ -0,0 +1,373 @@
+with
+     bullet_c.Binding,
+
+     bullet_physics.Shape,
+
+     c_math_c.Conversion,
+     c_math_c.Vector_3,
+     c_math_c.Matrix_3x3,
+     c_math_c.Matrix_4x4,
+
+     Swig,
+     interfaces.C,
+
+     ada.unchecked_Deallocation,
+     ada.Unchecked_Conversion,
+     ada.Text_IO;
+
+package body bullet_Physics.Object
+is
+   use bullet_c.Binding,
+       c_math_c.Conversion,
+       ada.Text_IO;
+
+   type Any_limited_view is access all lace.Any.limited_item'Class;
+
+
+   function new_Object (Shape        : in physics.Shape.view;
+                        Mass         : in Real;
+                        Friction     : in Real;
+                        Restitution  : in Real;
+                        at_Site      : in Vector_3) return View
+                        --  is_Kinematic : in Boolean) return View
+   is
+      Self : constant View := new Item;
+   begin
+      Self.define (Shape       => Shape,
+                   Mass        => Mass,
+                   Friction    => Friction,
+                   Restitution => Restitution,
+                   at_Site     => at_Site);
+      return Self;
+   end new_Object;
+
+
+   overriding
+   procedure define (Self : access Item;   Shape       : in physics.Shape.view;
+                                           Mass        : in Real;
+                                           Friction    : in Real;
+                                           Restitution : in Real;
+                                           at_Site     : in Vector_3)
+   is
+      use interfaces.C;
+      function to_void_ptr is new ada.unchecked_Conversion (Any_limited_view, Swig.void_ptr);
+
+   begin
+      Self.C := b3d_new_Object (c_math_c.Real (Mass),
+                                bullet_physics.Shape.view (Shape).C,
+                                is_Kinematic => Boolean'Pos (False));
+                                --  Boolean'Pos (is_Kinematic));
+
+      b3d_Object_Friction_is    (Self.C, c_float (Friction));
+      b3d_Object_Restitution_is (Self.C, c_float (Restitution));
+      b3d_Object_user_Data_is   (Self => Self.C.all'Access,
+                                 Now  => to_void_ptr (Self.all'Access));
+
+      Self.user_Data_is (Self);
+      Self.Site_is (at_Site);
+   end define;
+
+
+   overriding
+   procedure destruct (Self : in out Item)
+   is
+   begin
+      null;
+   end destruct;
+
+
+   procedure free (the_Object : in out physics.Object.view)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (physics.Object.item'Class,
+                                                              physics.Object.view);
+   begin
+      the_Object.destruct;
+      deallocate (the_Object);
+   end free;
+
+
+   function C (Self : in Item) return access bullet_C.Object
+   is
+   begin
+      return Self.C;
+   end C;
+
+
+   overriding
+   function Model (Self : in Item) return physics.Model.view
+   is
+   begin
+      return Self.Model;
+   end Model;
+
+
+   overriding
+   procedure Model_is (Self : in out Item;   Now : in physics.Model.view)
+   is
+   begin
+      Self.Model := Now;
+   end Model_is;
+
+
+   overriding
+   function Shape (Self : in Item) return physics.Shape.view
+   is
+      c_Shape : constant bullet_c.Pointers.Shape_pointer := b3d_Object_Shape (Self.C);
+
+      function to_Any_view is new ada.unchecked_Conversion (Swig.void_ptr, Any_limited_view);
+   begin
+      return physics.Shape.view (to_Any_view (b3d_Shape_user_Data (c_Shape)));
+   end Shape;
+
+
+   overriding
+   function Scale (Self : in Item) return Vector_3
+   is
+   begin
+      raise Error with "TODO";
+      return math.Origin_3D;
+   end Scale;
+
+
+   overriding
+   procedure Scale_is (Self : in out Item;   Now : in Vector_3)
+   is
+   begin
+      put_Line ("Scale_is not implemented for bullet_Physics.Object");
+      raise Error with "TODO";
+   end Scale_is;
+
+
+   overriding
+   procedure update_Dynamics (Self : in out Item)
+   is
+      Dynamics : constant Matrix_4x4 := Self.Transform;
+   begin
+      Self.Dynamics.set (Dynamics);
+   end update_Dynamics;
+
+
+   overriding
+   function get_Dynamics (Self : in Item) return Matrix_4x4
+   is
+   begin
+      return Self.Dynamics.get;
+   end get_Dynamics;
+
+
+   overriding
+   function is_Active (Self : in Item) return Boolean
+   is
+   begin
+      return True;
+   end is_Active;
+
+
+   overriding
+   procedure activate (Self : in out Item;   forceActivation : in Boolean := False)
+   is
+      pragma unreferenced (forceActivation);
+   begin
+      null;
+   end activate;
+
+
+   overriding
+   function Mass (Self : in Item) return Real
+   is
+   begin
+      return Real (b3d_Object_Mass (Self.C));
+   end Mass;
+
+
+   overriding
+   function Site (Self : in Item) return Vector_3
+   is
+      the_Site : constant c_math_c.Vector_3.item := b3d_Object_Site (Self.C);
+   begin
+      return +the_Site;
+   end Site;
+
+
+   overriding
+   procedure Site_is (Self : in out Item;   Now : in Vector_3)
+   is
+      c_Now : aliased c_math_c.Vector_3.item := +Now;
+   begin
+      b3d_Object_Site_is (Self.C, c_Now'unchecked_Access);
+   end Site_is;
+
+
+   overriding
+   function Spin (Self : in Item) return math.Matrix_3x3
+   is
+      use type bullet_c.Pointers.Object_pointer;
+   begin
+      if Self.C /= null
+      then
+         declare
+            the_Spin : constant c_math_c.Matrix_3x3.item := b3d_Object_Spin (Self.C);
+         begin
+            return +the_Spin;
+         end;
+      else
+         return Self.Dynamics.get_Spin;
+      end if;
+   end Spin;
+
+
+   overriding
+   procedure Spin_is (Self : in out Item;   Now : in Matrix_3x3)
+   is
+      use type bullet_c.Pointers.Object_pointer;
+   begin
+      Self.Dynamics.set_Spin (Now);
+
+      if Self.C /= null
+      then
+         declare
+            c_Now : aliased c_math_c.Matrix_3x3.item := +Now;
+         begin
+            b3d_Object_Spin_is (Self.C, c_Now'unchecked_Access);
+         end;
+      end if;
+   end Spin_is;
+
+
+   overriding
+   function xy_Spin (Self : in Item) return Radians
+   is
+   begin
+      raise Error with "TODO";
+      return 0.0;
+   end xy_Spin;
+
+
+   overriding
+   procedure xy_Spin_is (Self : in out Item;   Now : in Radians)
+   is
+   begin
+      raise Error with "TODO";
+   end xy_Spin_is;
+
+
+   overriding
+   function Transform (Self : in Item) return Matrix_4x4
+   is
+      the_Transform : constant c_math_c.Matrix_4x4.item := b3d_Object_Transform (Self.C);
+   begin
+      return +the_Transform;
+   end Transform;
+
+
+   overriding
+   procedure Transform_is (Self : in out Item;   Now : in Matrix_4x4)
+   is
+      c_Now : aliased c_math_c.Matrix_4x4.item := +Now;
+   begin
+      b3d_Object_Transform_is (Self.C, c_Now'unchecked_Access);
+   end Transform_is;
+
+
+   overriding
+   function Speed (Self : in Item) return math.Vector_3
+   is
+      the_Speed : constant c_math_c.Vector_3.item := b3d_Object_Speed (Self.C);
+   begin
+      return +the_Speed;
+   end Speed;
+
+
+   overriding
+   procedure Speed_is (Self : in out Item;   Now : in Vector_3)
+   is
+      c_Now : aliased c_math_c.Vector_3.item := +Now;
+   begin
+      b3d_Object_Speed_is (Self.C, c_Now'unchecked_Access);
+   end Speed_is;
+
+
+   overriding
+   function Gyre (Self : in Item) return math.Vector_3
+   is
+      the_Gyre : constant c_math_c.Vector_3.item := b3d_Object_Gyre (Self.C);
+   begin
+      return +the_Gyre;
+   end Gyre;
+
+
+   overriding
+   procedure Gyre_is (Self : in out Item;   Now : in Vector_3)
+   is
+      c_Now : aliased c_math_c.Vector_3.item := +Now;
+   begin
+      b3d_Object_Gyre_is (Self.C, c_Now'unchecked_Access);
+   end Gyre_is;
+
+
+   overriding
+   procedure Friction_is (Self : in out Item;   Now : in Real)
+   is
+   begin
+      b3d_Object_Friction_is (Self.C, +Now);
+   end Friction_is;
+
+
+   overriding
+   procedure Restitution_is (Self : in out Item;   Now : in Real)
+   is
+   begin
+      b3d_Object_Restitution_is (Self.C, +Now);
+   end Restitution_is;
+
+
+   --- Forces
+   --
+
+   overriding
+   procedure apply_Torque (Self : in out Item;   Torque : in Vector_3)
+   is
+      c_Torque : aliased c_math_c.Vector_3.item := +Torque;
+   begin
+      b3d_Object_apply_Torque (Self.C, c_Torque'unchecked_Access);
+   end apply_Torque;
+
+
+   overriding
+   procedure apply_Torque_impulse (Self : in out Item;   Torque : in Vector_3)
+   is
+      c_Torque : aliased c_math_c.Vector_3.item := +Torque;
+   begin
+      b3d_Object_apply_Torque_impulse (Self.C, c_Torque'unchecked_Access);
+   end apply_Torque_impulse;
+
+
+   overriding
+   procedure apply_Force (Self : in out Item;   Force : in Vector_3)
+   is
+      c_Force : aliased c_math_c.Vector_3.item := +Force;
+   begin
+      b3d_Object_apply_Force (Self.C, c_Force'unchecked_Access);
+   end apply_Force;
+
+
+   --- User data
+   --
+
+   overriding
+   procedure user_Data_is (Self : in out Item;   Now : access lace.Any.limited_item'Class)
+   is
+   begin
+      Self.user_Data := Now.all'unchecked_Access;
+   end user_Data_is;
+
+
+   overriding
+   function user_Data (Self : in Item) return access lace.Any.limited_item'Class
+   is
+   begin
+      return Self.user_Data;
+   end user_Data;
+
+
+end bullet_Physics.Object;

3-mid/physics/interface/source/private/bullet/bullet_physics-object.ads

@@ -0,0 +1,150 @@
+with
+     physics.Object,
+     physics.Model,
+     physics.Shape,
+     bullet_C;
+
+private
+with
+     bullet_c.Pointers,
+     lace.Any;
+
+package bullet_Physics.Object
+--
+-- Provides glue between a physics object and a Bullet3D object.
+--
+is
+   type Item is limited new physics.Object.item with private;
+   type View is access all Item'Class;
+
+
+   use Math;
+
+   ---------
+   --- Forge
+   --
+
+   function  new_Object (Shape        : in     physics.Shape.view;
+                         Mass         : in     Real;
+                         Friction     : in     Real;
+                         Restitution  : in     Real;
+                         at_Site      : in     Vector_3) return View;
+                         --  is_Kinematic : in     Boolean) return View;
+
+   overriding
+   procedure define (Self : access Item;   Shape       : in physics.Shape.view;
+                                           Mass        : in Real;
+                                           Friction    : in Real;
+                                           Restitution : in Real;
+                                           at_Site     : in Vector_3);
+
+   procedure free   (the_Object : in out physics.Object.view);
+
+
+   --------------
+   --- Attributes
+   --
+
+   function C         (Self : in     Item) return access bullet_C.Object;
+
+   overriding
+   function  Model    (Self : in     Item) return physics.Model.view;
+   overriding
+   procedure Model_is (Self : in out Item;   Now : in physics.Model.view);
+
+   overriding
+   procedure update_Dynamics (Self : in out Item);
+   overriding
+   function     get_Dynamics (Self : in     Item) return Matrix_4x4;
+
+
+
+private
+
+   type Item is limited new physics.Object.item with
+      record
+         C         :        bullet_c.Pointers.Object_pointer;
+         Shape     :        physics.Shape.view;
+         Model     :        physics.Model.view;
+         Dynamics  :        physics.Object.safe_Dynamics;
+         user_Data : access lace.Any.limited_item'Class;
+      end record;
+
+
+   overriding
+   procedure destruct     (Self : in out Item);
+
+   overriding
+   function  Shape        (Self : in     Item)     return physics.Shape.view;
+
+   overriding
+   function  Scale        (Self : in     Item)     return Vector_3;
+   overriding
+   procedure Scale_is     (Self : in out Item;   Now : in Vector_3);
+
+   overriding
+   procedure activate     (Self : in out Item;   forceActivation : in Boolean := False);
+   overriding
+   function  is_Active    (Self : in     Item)     return Boolean;
+
+   overriding
+   function  Mass         (Self : in     Item)     return Real;
+
+   overriding
+   function  Site         (Self : in     Item)     return Vector_3;
+   overriding
+   procedure Site_is      (Self : in out Item;   Now : in Vector_3);
+
+   overriding
+   function  Spin         (Self : in     Item)     return Matrix_3x3;
+   overriding
+   procedure Spin_is      (Self : in out Item;   Now : in Matrix_3x3);
+
+   overriding
+   function  xy_Spin      (Self : in     Item)     return Radians;
+   overriding
+   procedure xy_Spin_is   (Self : in out Item;   Now : in Radians);
+
+   overriding
+   function  Transform    (Self : in     Item)     return Matrix_4x4;
+   overriding
+   procedure Transform_is (Self : in out Item;   Now : in Matrix_4x4);
+
+   overriding
+   function  Speed        (Self : in     Item)     return Vector_3;
+   overriding
+   procedure Speed_is     (Self : in out Item;   Now : in Vector_3);
+
+   overriding
+   function  Gyre         (Self : in     Item)     return Vector_3;
+   overriding
+   procedure Gyre_is      (Self : in out Item;   Now : in Vector_3);
+
+   overriding
+   procedure Friction_is  (Self : in out Item;   Now : in Real);
+
+   overriding
+   procedure Restitution_is (Self : in out Item;   Now : in Real);
+
+
+   --- Forces
+   --
+
+   overriding
+   procedure apply_Torque         (Self : in out Item;   Torque : in Vector_3);
+   overriding
+   procedure apply_Torque_impulse (Self : in out Item;   Torque : in Vector_3);
+   overriding
+   procedure apply_Force          (Self : in out Item;   Force  : in Vector_3);
+
+
+   --- User data
+   --
+
+   overriding
+   procedure user_Data_is (Self : in out Item;   Now : access lace.Any.limited_item'Class);
+   overriding
+   function  user_Data    (Self : in     Item)  return access lace.Any.limited_item'Class;
+
+
+end bullet_Physics.Object;

3-mid/physics/interface/source/private/bullet/bullet_physics-shape.adb

@@ -0,0 +1,270 @@
+with
+     bullet_c.Binding,
+
+     c_math_c.Vector_2,
+     c_math_c.Vector_3,
+     c_math_c.Conversion,
+     c_math_c.Triangle,
+
+     ada.unchecked_Deallocation,
+     ada.Unchecked_Conversion,
+
+     interfaces.C;
+
+package body bullet_Physics.Shape
+is
+   use c_math_c.Conversion,
+       bullet_c.Binding,
+       Interfaces;
+
+   ---------
+   --  Forge
+   --
+
+   overriding
+   procedure define (Self : in out Item)
+   is
+   begin
+      raise Error with "Bullet shape not supported.";
+   end define;
+
+
+   overriding
+   procedure destruct (Self : in out Item)
+   is
+   begin
+      null;
+   end destruct;
+
+
+   -------
+   --- Box
+   --
+   type Box_view is access Box;
+
+   function new_box_Shape (half_Extents : in Vector_3) return physics.Shape.view
+   is
+      Self           : constant Box_view               := new Box;
+      c_half_Extents : aliased  c_math_c.Vector_3.item := +half_Extents;
+   begin
+      Self.C := b3d_new_Box (c_half_Extents'unchecked_Access);
+      return physics.Shape.view (Self);
+   end new_box_Shape;
+
+
+   -----------
+   --- Capsule
+   --
+   type Capsule_view is access Capsule;
+
+   function new_capsule_Shape (Radii  : in Vector_2;
+                               Height : in Real) return physics.Shape.view
+   is
+      Self    : constant Capsule_view           := new Capsule;
+      c_Radii : aliased  c_math_c.Vector_2.item := +Radii;
+   begin
+      Self.C := b3d_new_Capsule (c_Radii'unchecked_Access, +Height);
+      return physics.Shape.view (Self);
+   end new_capsule_Shape;
+
+
+   --------
+   --- Cone
+   --
+   type Cone_view is access Cone;
+
+   function new_cone_Shape (Radius,
+                            Height : in Real) return physics.Shape.view
+   is
+      Self : constant Cone_view := new Cone;
+   begin
+      Self.C := b3d_new_Cone (+Radius, +Height);
+      return physics.Shape.view (Self);
+   end new_cone_Shape;
+
+
+   ---------------
+   --- convex_Hull
+   --
+   type convex_Hull_view is access convex_Hull;
+
+   function new_convex_hull_Shape (Points : in physics.Vector_3_array) return physics.Shape.view
+   is
+      Self     : constant convex_Hull_view := new convex_Hull;
+      c_Points : array (1 .. Points'Length) of aliased c_math_c.Vector_3.item;
+   begin
+      for i in c_Points'Range
+      loop
+         c_Points (i) := +Points (i);
+      end loop;
+
+      Self.C := b3d_new_convex_Hull (c_Points (1)'unchecked_Access,
+                                     c_Points'Length);
+      return physics.Shape.view (Self);
+   end new_convex_hull_Shape;
+
+
+   --------
+   --- Mesh
+   --
+   type Mesh_view is access Mesh;
+
+   function new_mesh_Shape (Model : access math.Geometry.d3.a_Model) return physics.Shape.view
+   is
+      Self        : constant Mesh_view := new Mesh;
+      c_Points    : array (1 .. Model.site_Count) of aliased c_math_c.Vector_3.item;
+
+      type Triangles is array (1 .. Model.tri_Count) of aliased c_math_c.Triangle.item;
+      pragma Pack (Triangles);
+
+      c_Triangles : Triangles;
+
+   begin
+      for i in c_Points'Range
+      loop
+         c_Points (i) := +Model.Sites (i);
+      end loop;
+
+      for i in c_Triangles'Range
+      loop
+         c_Triangles (i) := (a => C.int (Model.Triangles (i)(1)),
+                             b => C.int (Model.Triangles (i)(2)),
+                             c => C.int (Model.Triangles (i)(3)));
+      end loop;
+
+      Self.C := b3d_new_Mesh (Points         => c_Points (c_Points'First)'unchecked_Access,
+                              point_Count    => 0,
+                              Triangles      => c_Triangles (c_Triangles'First)'unchecked_Access,
+                              triangle_Count => C.int (Model.tri_Count));
+      return physics.Shape.view (Self);
+   end new_mesh_Shape;
+
+
+   ------------
+   --- Cylinder
+   --
+   type Cylinder_view is access Cylinder;
+
+   function new_cylinder_Shape (half_Extents : in Vector_3) return physics.Shape.view
+   is
+      Self           : constant Cylinder_view          := new Cylinder;
+      c_half_Extents : aliased  c_math_c.Vector_3.item := +half_Extents;
+   begin
+      Self.C := b3d_new_Cylinder (c_half_Extents'unchecked_Access);
+      return physics.Shape.view (Self);
+   end new_cylinder_Shape;
+
+
+   ---------------
+   --- Heightfield
+   --
+   type Heightfield_view is access Heightfield;
+
+   function new_heightfield_Shape (Width,
+                                   Depth       : in Positive;
+                                   Heights     : in c_math_c.Pointers.Real_Pointer;
+                                   min_Height,
+                                   max_Height  : in Real;
+                                   Scale       : in Vector_3) return physics.Shape.view
+   is
+      use c_math_c.Pointers;
+
+      Self    : constant Heightfield_view       := new Heightfield;
+      c_Scale : aliased  c_math_c.Vector_3.item := +Scale;
+   begin
+      Self.C := b3d_new_Heightfield (+Width,
+                                     +Depth,
+                                     Heights,
+                                     c_math_c.Real (min_Height),
+                                     c_math_c.Real (max_Height),
+                                     c_Scale'unchecked_Access);
+      return physics.Shape.view (Self);
+   end new_heightfield_Shape;
+
+
+   ---------------
+   --- multiSphere
+   --
+   type multiSphere_view is access multiSphere;
+
+   function new_multiSphere_Shape (Positions    : in physics.Vector_3_array;
+                                   Radii        : in math.Vector) return physics.Shape.view
+   is
+      pragma Assert (Positions'Length = Radii'Length);
+
+      Self : constant multiSphere_view := new multiSphere;
+
+      c_Positions : array (1 .. Positions'Length) of aliased c_math_c.Vector_3.item;
+      c_Radii     : array (1 .. Radii    'Length) of aliased c_math_c.Real;
+   begin
+      for i in c_Radii'Range
+      loop
+         c_Positions (i) := +Positions (i);
+         c_Radii     (i) := +Radii     (i);
+      end loop;
+
+      Self.C := b3d_new_multiSphere (c_Positions (1)'unchecked_Access,
+                                     c_Radii     (1)'unchecked_Access,
+                                     Radii'Length);
+      return physics.Shape.view (Self);
+   end new_multiSphere_Shape;
+
+
+   ---------
+   --- Plane
+   --
+   type Plane_view is access Plane;
+
+   function new_plane_Shape (Normal : in Vector_3;
+                             Offset : in Real) return physics.Shape.view
+   is
+      Self     : constant Plane_view             := new Plane;
+      c_Vector : aliased  c_math_c.Vector_3.item := +Normal;
+   begin
+      Self.C := b3d_new_Plane (c_Vector'unchecked_Access, +Offset);
+      return physics.Shape.view (Self);
+   end new_plane_Shape;
+
+
+   ----------
+   --- Sphere
+   --
+
+   type Sphere_view is access Sphere;
+
+   function new_sphere_Shape (Radius : in math.Real) return physics.Shape.view
+   is
+      Self : constant Sphere_view := new Sphere;
+   begin
+      Self.C := b3d_new_Sphere (+Radius);
+      return physics.Shape.view (Self);
+   end new_sphere_Shape;
+
+
+   ---------------
+   ---  Attributes
+   --
+
+   overriding
+   procedure Scale_is (Self : in out Item;   Now : Vector_3)
+   is
+   begin
+      null;
+   end Scale_is;
+
+
+   --------
+   --- Free
+   --
+
+   procedure free (the_Shape : in out physics.Shape.view)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (physics.Shape.item'Class,
+                                                              physics.Shape.view);
+   begin
+      the_Shape.destruct;
+      deallocate (the_Shape);
+   end free;
+
+
+end bullet_Physics.Shape;

3-mid/physics/interface/source/private/bullet/bullet_physics-shape.ads

@@ -0,0 +1,82 @@
+with
+     physics.Shape,
+
+     c_math_c.Pointers,
+
+     bullet_c.Pointers,
+     bullet_c;
+
+package bullet_Physics.Shape
+--
+--  Provides glue between a physics shape and a Bullet3D shape.
+--
+is
+   type Item is abstract new physics.Shape.item with
+      record
+         C : bullet_c.Pointers.Shape_Pointer;
+      end record;
+
+   type View is access all Item'Class;
+
+
+   use Math;
+
+
+   ---------
+   --  Forge
+   --
+
+   overriding
+   procedure define   (Self : in out Item);
+   overriding
+   procedure destruct (Self : in out Item);
+
+
+   function new_box_Shape         (half_Extents : in     Vector_3) return physics.Shape.view;
+   function new_capsule_Shape     (Radii        : in     Vector_2;
+                                   Height       : in     Real)     return physics.Shape.view;
+   function new_cone_Shape        (Radius,
+                                   Height       : in     Real)     return physics.Shape.view;
+   function new_convex_hull_Shape (Points       : in     physics.Vector_3_array)
+                                                                   return physics.Shape.view;
+   function new_mesh_Shape        (Model        : access Geometry.d3.a_Model)
+                                                                   return physics.Shape.view;
+   function new_cylinder_Shape    (half_Extents : in     Vector_3) return physics.Shape.view;
+   function new_heightfield_Shape (Width,
+                                   Depth        : in     Positive;
+                                   Heights      : in     c_math_c.Pointers.Real_pointer;
+                                   min_Height,
+                                   max_Height   : in     Real;
+                                   Scale        : in     Vector_3) return physics.Shape.view;
+   function new_multiSphere_Shape (Positions    : in     physics.Vector_3_array;
+                                   Radii        : in     Vector)   return physics.Shape.view;
+   function new_plane_Shape       (Normal       : in     Vector_3;
+                                   Offset       : in     Real)     return physics.Shape.view;
+   function new_sphere_Shape      (Radius       : in     Real)     return physics.Shape.view;
+
+   procedure free (the_Shape : in out physics.Shape.view);
+
+
+   ---------------
+   ---  Attributes
+   --
+
+   overriding
+   procedure Scale_is (Self : in out Item;   Now : Vector_3);
+
+
+
+private
+
+   type Box         is new Item with null record;
+   type Capsule     is new Item with null record;
+   type Cone        is new Item with null record;
+   type Cylinder    is new Item with null record;
+   type Heightfield is new Item with null record;
+   type multiSphere is new Item with null record;
+   type Plane       is new Item with null record;
+   type Sphere      is new Item with null record;
+   type convex_Hull is new Item with null record;
+   type Mesh        is new Item with null record;
+
+end bullet_Physics.Shape;

3-mid/physics/interface/source/private/bullet/bullet_physics-space.adb

@@ -0,0 +1,547 @@
+with
+     bullet_c.Binding,
+     bullet_c.ray_Collision,
+
+     c_math_c.Vector_3,
+     c_math_c.Conversion,
+     c_math_c.Pointers,
+
+     bullet_physics.Shape,
+     bullet_physics.Joint,
+
+     Swig,
+     lace.Any,
+     interfaces.C,
+     ada.unchecked_Conversion;
+
+package body bullet_Physics.Space
+is
+
+   use bullet_c.Binding,
+       bullet_c.Pointers,
+       c_math_c.Conversion,
+       Interfaces;
+
+   function to_Object_view is new ada.unchecked_Conversion (swig.void_ptr,
+                                                            physics.Object.view);
+
+   ----------
+   --- Forge
+   --
+
+   function to_Space return Item
+   is
+   begin
+      return Self : Item
+      do
+         Self.C := bullet_c.Binding.b3d_new_Space;
+      end return;
+   end to_Space;
+
+
+   overriding
+   procedure destruct (Self : in out Item)
+   is
+   begin
+      bullet_c.Binding.b3d_free_Space (Self.C);
+   end destruct;
+
+
+   ---------
+   --- Shape
+   --
+
+   overriding
+   function new_Shape (Self : access Item;   Model : in physics.Model.view) return physics.Shape.view
+   is
+   begin
+      raise Error with "TODO";
+      return null;
+   end new_Shape;
+
+
+   overriding
+   function new_sphere_Shape (Self : access Item;   Radius : in Real := 0.5) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+      the_Sphere : constant physics.Shape .view := bullet_physics.Shape.new_sphere_Shape (Radius);
+   begin
+      return the_Sphere;
+   end new_sphere_Shape;
+
+
+   overriding
+   function new_box_Shape (Self : access Item;   half_Extents : in Vector_3 := [0.5, 0.5, 0.5]) return physics.Shape.view
+   is
+      pragma Unreferenced (Self);
+      the_Box : constant physics.Shape.view := bullet_physics.Shape.new_box_Shape (half_Extents);
+   begin
+      return the_Box;
+   end new_box_Shape;
+
+
+   overriding
+   function new_capsule_Shape (Self : access Item;   Radius : in Real :=  0.5;
+                                                     Height : in Real) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+      the_Capsule : constant physics.Shape .view := bullet_physics.Shape.new_capsule_Shape (Radii  => [Radius, Radius],
+                                                                                            Height => Height);
+   begin
+      return the_Capsule;
+   end new_capsule_Shape;
+
+
+   overriding
+   function new_cone_Shape (Self : access Item;   Radius : in Real := 0.5;
+                                                  Height : in Real := 1.0) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+      the_Cone : constant physics.Shape.view := bullet_physics.Shape.new_cone_Shape (Radius, Height);
+   begin
+      return the_Cone;
+   end new_cone_Shape;
+
+
+   overriding
+   function new_cylinder_Shape (Self : access Item;   half_Extents : in Vector_3 := [0.5, 0.5, 0.5]) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+      the_Cylinder : constant physics.Shape.view := bullet_physics.Shape.new_cylinder_Shape (half_Extents);
+   begin
+      return the_Cylinder;
+   end New_Cylinder_Shape;
+
+
+   overriding
+   function new_heightfield_Shape (Self : access Item;   Heightfield  : in out physics.Heightfield;
+                                                         Scale        : in     Vector_3) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+
+      function height_Extent (Self : in physics.Heightfield) return Vector_2
+      is
+         Min : Real := Real'Last;
+         Max : Real := Real'First;
+      begin
+         for Row in Self'Range (1)
+         loop
+            for Col in Self'Range (2)
+            loop
+               Min := Real'Min (Min, Self (Row, Col));
+               Max := Real'Max (Max, Self (Row, Col));
+            end loop;
+         end loop;
+
+         return [Min, Max];
+      end height_Extent;
+
+      function convert is new ada.unchecked_Conversion (physics.Space.Real_view,
+                                                        c_math_c.Pointers.Real_Pointer);
+
+      the_height_Extent : constant Vector_2           := height_Extent (Heightfield);
+      the_Heightfield   : constant physics.Shape.view := bullet_physics.Shape.new_heightfield_Shape (Heightfield'Length (1),
+                                                                                                     Heightfield'Length (2),
+                                                                                                     convert (Heightfield (1, 1)'unchecked_Access),
+                                                                                                     the_height_Extent (1),
+                                                                                                     the_height_Extent (2),
+                                                                                                     Scale);
+   begin
+      return the_Heightfield;
+   end new_heightfield_Shape;
+
+
+   overriding
+   function new_multisphere_Shape (Self : access Item;   Sites   : in physics.vector_3_array;
+                                                          Radii  : in Vector) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+      the_multi_Sphere : constant physics.Shape.view := bullet_physics.Shape.new_multisphere_Shape (Sites, Radii);
+   begin
+      return the_multi_Sphere;
+   end new_multisphere_Shape;
+
+
+   overriding
+   function new_plane_Shape (Self : access Item;   Normal : in Vector_3 := [0.0, 1.0, 0.0];
+                                                   Offset : in Real     :=  0.0) return physics.Shape .view
+   is
+      pragma unreferenced (Self);
+      the_Plane : constant physics.Shape.view := bullet_physics.Shape.new_plane_Shape (Normal, Offset);
+   begin
+      return the_Plane;
+   end new_plane_Shape;
+
+
+   overriding
+   function new_convex_hull_Shape (Self : access Item;   Points : in physics.vector_3_array) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+      the_Hull : constant physics.Shape.view := bullet_physics.Shape.new_convex_hull_Shape (Points);
+   begin
+      return the_Hull;
+   end new_convex_hull_Shape;
+
+
+   overriding
+   function new_mesh_Shape (Self : access Item;   Points : access Physics.Geometry_3D.a_Model) return physics.Shape.view
+   is
+      pragma unreferenced (Self);
+      the_Mesh : constant physics.Shape.view := bullet_physics.Shape.new_mesh_Shape (Points);
+   begin
+      return the_Mesh;
+   end new_mesh_Shape;
+
+
+   --  2D
+   --
+
+   overriding
+   function new_circle_Shape (Self : access Item;   Radius : in Real := 0.5) return physics.Shape.view
+   is
+   begin
+      raise physics.Space.unsupported_Shape with "Circle shape not allowed in bullet physics.";
+      return null;
+   end new_circle_Shape;
+
+
+   overriding
+   function new_polygon_Shape (Self : access Item;   Vertices : in physics.Space.polygon_Vertices) return physics.Shape.view
+   is
+   begin
+      raise physics.Space.unsupported_Shape with "Polygon shape not allowed in bullet physics.";
+      return null;
+   end new_polygon_Shape;
+
+
+   ------------
+   ---  Objects
+   --
+   function Hash (the_C_Object : in bullet_c.Pointers.Object_pointer) return ada.Containers.Hash_type
+   is
+      function convert is new ada.unchecked_Conversion (bullet_c.Pointers.Object_pointer,
+                                                        ada.Containers.Hash_type);
+   begin
+      return convert (the_C_Object);
+   end Hash;
+
+
+   overriding
+   function  new_Object (Self : access Item;   of_Shape     : in physics.Shape .view;
+                                               of_Mass      : in Real;
+                                               Friction     : in Real;
+                                               Restitution  : in Real;
+                                               at_Site      : in Vector_3;
+                                               is_Kinematic : in Boolean) return physics.Object.view
+   is
+      pragma unreferenced (Self);
+      the_b3d_Object : constant bullet_Physics.Object.view := bullet_physics.Object.new_Object (Shape       => of_Shape,
+                                                                                                Mass        => of_Mass,
+                                                                                                Friction    => Friction,
+                                                                                                Restitution => Restitution,
+                                                                                                at_Site     => at_Site);
+      the_Object : constant physics.Object.view := physics.Object.view (the_b3d_Object);
+
+   begin
+      return the_Object;
+   end new_Object;
+
+
+   overriding
+   function object_Count (Self : in Item) return Natural
+   is
+   begin
+      raise Error with "TODO";
+      return 0;
+   end object_Count;
+
+
+   -----------
+   ---  Joints
+   --
+
+   overriding
+   function new_hinge_Joint (Self : access Item;   Object_A,
+                                                   Object_B          : in physics.Object.view;
+                                                   Anchor_in_A,
+                                                   Anchor_in_B       : in Vector_3;
+                                                   pivot_Axis        : in Vector_3;
+                                                   low_Limit,
+                                                   high_Limit        : in Real;
+                                                   collide_Connected : in Boolean) return physics.Joint.hinge.view
+   is
+   begin
+      raise Error with "TODO";
+      return null;
+   end new_hinge_Joint;
+
+
+   overriding
+   function new_hinge_Joint (Self : access Item;   Object_A : in physics.Object.view;
+                                                   Frame_A  : in Matrix_4x4) return physics.Joint.hinge.view
+   is
+      pragma unreferenced (Self);
+      the_Joint : constant physics.Joint.hinge.view := bullet_physics.Joint.new_hinge_Joint (Object_A, Frame_A);
+   begin
+      return the_Joint;
+   end new_hinge_Joint;
+
+
+   overriding
+   function new_hinge_Joint (Self : access Item;   Object_A,
+                                                   Object_B          : in physics.Object.view;
+                                                   Frame_A,
+                                                   Frame_B           : in Matrix_4x4;
+                                                   low_Limit,
+                                                   high_Limit        : in Real;
+                                                   collide_Connected : in Boolean) return physics.Joint.hinge.view
+   is
+      pragma unreferenced (Self);
+      the_Joint : constant physics.Joint.hinge.view := bullet_physics.Joint.new_hinge_Joint (Object_A, Object_B,
+                                                                                             Frame_A,  Frame_B);
+   begin
+      return the_Joint;
+   end new_hinge_Joint;
+
+
+   overriding
+   function new_DoF6_Joint (Self : access Item;   Object_A,
+                                                  Object_B : in physics.Object.view;
+                                                  Frame_A,
+                                                  Frame_B  : in Matrix_4x4) return physics.Joint.DoF6.view
+   is
+      pragma Unreferenced (Self);
+      the_Joint : constant physics.Joint.DoF6.view := bullet_physics.Joint.new_DoF6_Joint (Object_A, Object_B,
+                                                                                           Frame_A,  Frame_B);
+   begin
+      return the_Joint;
+   end new_DoF6_Joint;
+
+
+   overriding
+   function new_ball_Joint (Self : access Item;   Object_A,
+                                                  Object_B   : in physics.Object.view;
+                                                  Pivot_in_A,
+                                                  Pivot_in_B : in Vector_3) return physics.Joint.ball.view
+   is
+      pragma unreferenced (Self);
+      the_Joint : constant physics.Joint.ball.view := Standard.bullet_physics.Joint.new_ball_Joint (Object_A,    Object_B,
+                                                                                                    Pivot_in_A,  Pivot_in_B);
+   begin
+      return the_Joint;
+   end new_ball_Joint;
+
+
+   overriding
+   function new_slider_Joint (Self : access Item;   Object_A,
+                                                    Object_B : in physics.Object.view;
+                                                    Frame_A,
+                                                    Frame_B  : in Matrix_4x4) return physics.Joint.slider.view
+   is
+      pragma unreferenced (Self);
+      the_Joint : constant physics.Joint.slider.view := bullet_physics.Joint.new_slider_Joint (Object_A, Object_B,
+                                                                                               Frame_A,  Frame_B);
+   begin
+      return the_Joint;
+   end new_slider_Joint;
+
+
+   overriding
+   function new_cone_twist_Joint (Self : access Item;   Object_A,
+                                                        Object_B : in physics.Object.view;
+                                                        Frame_A,
+                                                        Frame_B  : in Matrix_4x4) return physics.Joint.cone_twist.view
+   is
+      pragma unreferenced (Self);
+      the_Joint : constant physics.Joint.cone_twist.view := bullet_physics.Joint.new_cone_twist_Joint (Object_A, Object_B,
+                                                                                                       Frame_A,  Frame_B);
+   begin
+      return the_Joint;
+   end new_cone_twist_Joint;
+
+
+   ---------------
+   --- Operations
+   --
+
+   overriding
+   procedure update_Bounds (Self : in out Item;   of_Obect : in physics.Object.view)
+   is
+      the_c_Object : constant access bullet_c.Object := bullet_physics.Object.view (of_Obect).C;
+      pragma Unreferenced (the_c_Object);
+   begin
+      raise Error with "TODO";
+   end update_Bounds;
+
+
+   overriding
+   procedure add (Self : in out Item;   Object : in physics.Object.view)
+   is
+      the_c_Object : constant Object_Pointer := bullet_physics.Object.view (Object).C;
+   begin
+      b3d_Space_add_Object (Self.C, the_c_Object);
+   end add;
+
+
+   overriding
+   procedure rid (Self : in out Item;   Object : in physics.Object.view)
+   is
+      the_c_Object : constant Object_Pointer := bullet_physics.Object.view (Object).C;
+   begin
+      b3d_Space_rid_Object (Self.C, the_c_Object);
+   end rid;
+
+
+   overriding
+   function cast_Ray (Self : access Item;    From, To : in Vector_3) return physics.Space.ray_Collision
+   is
+      c_From : aliased c_math_c.Vector_3.item := +From;
+      c_To   : aliased c_math_c.Vector_3.item := +To;
+
+      the_Collision   :          physics.Space.ray_Collision;
+      the_c_Collision : constant bullet_c.ray_Collision.item := b3d_Space_cast_Ray (Self.C, c_From'unchecked_Access,
+                                                                                            c_To  'unchecked_Access);
+   begin
+      if the_c_Collision.near_Object /= null
+      then
+         the_Collision.near_Object := to_Object_view (b3d_Object_user_Data (the_c_Collision.near_Object));
+      end if;
+
+      the_Collision.hit_Fraction :=  Real (the_c_Collision.hit_Fraction);
+      the_Collision.Normal_world := +the_c_Collision.Normal_world;
+      the_Collision.Site_world   := +the_c_Collision.Site_world;
+
+      return the_Collision;
+   end cast_Ray;
+
+
+   overriding
+   procedure evolve (Self : in out Item;   By : in Duration)
+   is
+   begin
+      bullet_c.Binding.b3d_Space_evolve (Self.C, C.C_float (By));
+
+      -- Update each objects dynamics.
+      --
+      declare
+         use c_Object_Maps_of_Object;
+         Cursor     : c_Object_Maps_of_Object.Cursor := Self.object_Map.First;
+         the_Object : bullet_Physics.Object.view;
+      begin
+         while has_Element (Cursor)
+         loop
+            the_Object := Element (Cursor);
+            the_Object.update_Dynamics;
+
+            next (Cursor);
+         end loop;
+      end;
+   end evolve;
+
+
+   overriding
+   function Gravity (Self : in Item) return Vector_3
+   is
+   begin
+      raise Error with "TODO";
+      return [0.0, 0.0, 0.0];
+   end Gravity;
+
+
+   overriding
+   procedure Gravity_is (Self : in out Item;   Now : in Vector_3)
+   is
+      c_Now : aliased c_math_c.Vector_3.item := +Now;
+   begin
+      bullet_c.Binding.b3d_Space_Gravity_is (Self.C, c_Now'unchecked_Access);
+   end Gravity_is;
+
+
+   overriding
+   procedure add (Self : in out Item;   Joint : in physics.Joint.view)
+   is
+      the_c_Joint : constant Joint_Pointer := bullet_physics.Joint.view (Joint).C;
+   begin
+      b3d_Space_add_Joint (Self.C, the_c_Joint);
+   end add;
+
+
+   overriding
+   procedure rid (Self : in out Item;   Joint : in physics.Joint.view)
+   is
+   begin
+      raise Error with "TODO";
+   end rid;
+
+
+   overriding
+   function manifold_Count (Self : in Item) return Natural
+   is
+   begin
+      raise Error with "TODO";
+      return 0;
+   end manifold_Count;
+
+
+   overriding
+   function Manifold (Self : access Item;   Index : in Positive) return physics.space.a_Manifold
+   is
+      type Any_limited_view is access all lace.Any.limited_item'Class;
+      pragma Unreferenced (Any_limited_view);
+      the_Manifold : physics.space.a_Manifold;
+   begin
+      raise Error with "TODO";
+      return the_Manifold;
+   end Manifold;
+
+
+   overriding
+   procedure set_Joint_local_Anchor (Self : in out Item;   the_Joint    : in physics.Joint.view;
+                                                           is_Anchor_A  : in Boolean;
+                                                           local_Anchor : in Vector_3)
+   is
+   begin
+      raise Error with "TODO";
+   end set_Joint_local_Anchor;
+
+
+   -----------------
+   --- Joint Cursors
+   --
+
+   overriding
+   procedure next (Cursor : in out joint_Cursor)
+   is
+   begin
+      raise Error with "TODO";
+   end next;
+
+
+   overriding
+   function has_Element (Cursor : in joint_Cursor) return Boolean
+   is
+   begin
+      raise Error with "TODO";
+      return False;
+   end has_Element;
+
+
+   overriding
+   function Element (Cursor : in joint_Cursor) return physics.Joint.view
+   is
+   begin
+      raise Error with "TODO";
+      return null;
+   end Element;
+
+
+   overriding
+   function first_Joint (Self : in Item) return physics.Space.joint_Cursor'Class
+   is
+   begin
+      raise Error with "TODO";
+      return joint_Cursor' (others => <>);
+   end first_Joint;
+
+
+end bullet_Physics.Space;

3-mid/physics/interface/source/private/bullet/bullet_physics-space.ads

@@ -0,0 +1,216 @@
+with
+     physics.Space,
+     physics.Model;
+
+private
+with
+     bullet_c,
+     bullet_c.Pointers,
+     bullet_Physics.Object,
+
+     physics.Shape,
+     physics.Object,
+     physics.Joint.ball,
+     physics.Joint.slider,
+     physics.Joint.hinge,
+     physics.Joint.cone_twist,
+     physics.Joint.DoF6,
+
+     ada.Containers.hashed_Maps;
+
+package bullet_Physics.Space
+--
+-- Provides a Bullet3D implementation of a physical space.
+--
+is
+   type Item is new physics.Space.item with private;
+   type View is access all Item'Class;
+
+
+   -- TODO: Place this in a nested Forge package.
+   function to_Space return Item;
+
+   overriding
+   function manifold_Count (Self : in     Item) return Natural;
+   overriding
+   function Manifold       (Self : access Item;   Index : in Positive) return physics.space.a_Manifold;
+
+
+
+private
+
+   function Hash (the_C_Object : in bullet_c.Pointers.Object_Pointer) return ada.Containers.Hash_type;
+   use type bullet_c.Pointers.Object_pointer;
+   use type bullet_Physics.Object.view;
+   package c_Object_Maps_of_Object is new ada.Containers.hashed_Maps (Key_type        => bullet_c.Pointers.Object_Pointer,
+                                                                      Element_type    => bullet_Physics.Object.view,
+                                                                      Hash            => Hash,
+                                                                      equivalent_Keys => "=",
+                                                                      "="             => "=");
+
+   type Item is new physics.Space.item with
+      record
+         C          : bullet_c.Pointers.Space_Pointer;
+         object_Map : c_Object_Maps_of_Object.Map;
+      end record;
+
+   use Math;
+
+
+   ----------------
+   --- Joint Cursor
+   --
+   type joint_Cursor is new physics.Space.joint_Cursor with null record;
+
+   overriding
+   procedure next        (Cursor : in out joint_Cursor);
+   overriding
+   function  has_Element (Cursor : in     joint_Cursor) return Boolean;
+   overriding
+   function  Element     (Cursor : in     joint_Cursor) return physics.Joint.view;
+   overriding
+   function  first_Joint (Self   : in     Item)         return physics.Space.joint_Cursor'Class;
+
+
+   ----------
+   --- Forge
+   --
+
+   overriding
+   procedure destruct (Self : in out Item);
+
+
+   ---------
+   --- Shape
+   --
+
+   overriding
+   function              new_Shape (Self : access Item;   Model        : in physics.Model.view)              return physics.Shape.view;
+   overriding
+   function       new_sphere_Shape (Self : access Item;   Radius       : in Real     := 0.5)                 return physics.Shape.view;
+   overriding
+   function          new_box_Shape (Self : access Item;   half_Extents : in Vector_3 := [0.5, 0.5, 0.5])     return physics.Shape.view;
+   overriding
+   function      new_capsule_Shape (Self : access Item;   Radius       : in Real     :=  0.5;
+                                                          Height       : in Real)                            return physics.Shape.view;
+   overriding
+   function         new_cone_Shape (Self : access Item;   Radius       : in Real     :=  0.5;
+                                                          Height       : in Real     := 1.0)                 return physics.Shape.view;
+   overriding
+   function     new_cylinder_Shape (Self : access Item;   half_Extents : in Vector_3 := [0.5, 0.5, 0.5])     return physics.Shape.view;
+   overriding
+   function  new_heightfield_Shape (Self : access Item;   Heightfield  : in out physics.Heightfield;
+                                                          Scale        : in     Vector_3)                    return physics.Shape.view;
+   overriding
+   function  new_multisphere_Shape (Self : access Item;   Sites        : in physics.Vector_3_array;
+                                                          Radii        : in Vector)                          return physics.Shape.view;
+   overriding
+   function        new_plane_Shape (Self : access Item;   Normal       : in Vector_3 := [0.0, 1.0, 0.0];
+                                                          Offset       : in Real     :=  0.0)                return physics.Shape.view;
+   overriding
+   function  new_convex_hull_Shape (Self : access Item;   Points       : in physics.Vector_3_array)          return physics.Shape.view;
+   overriding
+   function         new_mesh_Shape (Self : access Item;   Points       : access Physics.Geometry_3D.a_Model) return physics.Shape.view;
+   overriding
+   function       new_circle_Shape (Self : access Item;   Radius       : in Real     := 0.5)                 return physics.Shape.view;
+   overriding
+   function      new_polygon_Shape (Self : access Item;   Vertices     : in physics.Space.polygon_Vertices)  return physics.Shape.view;
+
+
+   ----------
+   --- Object
+   --
+
+   overriding
+   function  new_Object   (Self : access Item;   of_Shape     : in physics.Shape .view;
+                                                 of_Mass      : in Real;
+                                                 Friction     : in Real;
+                                                 Restitution  : in Real;
+                                                 at_Site      : in Vector_3;
+                                                 is_Kinematic : in Boolean) return physics.Object.view;
+   overriding
+   function  object_Count (Self : in     Item) return Natural;
+
+
+   ---------
+   --- Joint
+   --
+
+   overriding
+   function new_hinge_Joint  (Self : access Item;   Object_A,
+                                                    Object_B          : in physics.Object.view;
+                                                    Anchor_in_A,
+                                                    Anchor_in_B       : in Vector_3;
+                                                    pivot_Axis        : in Vector_3;
+                                                    low_Limit,
+                                                    high_Limit        : in Real;
+                                                    collide_Connected : in Boolean) return physics.Joint.hinge.view;
+   overriding
+   function new_hinge_Joint  (Self : access Item;   Object_A,
+                                                    Object_B          : in physics.Object.view;
+                                                    Frame_A,
+                                                    Frame_B           : in Matrix_4x4;
+                                                    low_Limit,
+                                                    high_Limit        : in Real;
+                                                    collide_Connected : in Boolean) return physics.Joint.hinge.view;
+   overriding
+   function new_hinge_Joint  (Self : access Item;   Object_A   : in physics.Object.view;
+                                                    Frame_A    : in Matrix_4x4) return physics.Joint.hinge.view;
+   overriding
+   function new_DoF6_Joint   (Self : access Item;   Object_A,
+                                                    Object_B   : in physics.Object.view;
+                                                    Frame_A,
+                                                    Frame_B    : in Matrix_4x4) return physics.Joint.DoF6.view;
+   overriding
+   function new_ball_Joint   (Self : access Item;   Object_A,
+                                                    Object_B   : in physics.Object.view;
+                                                    Pivot_in_A,
+                                                    Pivot_in_B : in Vector_3)   return physics.Joint.ball.view;
+   overriding
+   function new_slider_Joint (Self : access Item;   Object_A,
+                                                    Object_B   : in physics.Object.view;
+                                                    Frame_A,
+                                                    Frame_B    : in Matrix_4x4) return physics.Joint.slider.view;
+   overriding
+   function new_cone_twist_Joint (Self : access Item;
+                                                    Object_A,
+                                                    Object_B   : in physics.Object.view;
+                                                    Frame_A,
+                                                    Frame_B    : in Matrix_4x4) return physics.Joint.cone_twist.view;
+   ---------------
+   --- Operations
+   --
+
+   overriding
+   procedure add        (Self : in out Item;   Object   : in physics.Object.view);
+   overriding
+   procedure rid        (Self : in out Item;   Object   : in physics.Object.view);
+
+   overriding
+   function  cast_Ray   (Self : access Item;   From,
+                                               To       : in Vector_3) return physics.Space.ray_Collision;
+
+   overriding
+   procedure evolve     (Self : in out Item;   By       : in Duration);
+
+   overriding
+   function  Gravity    (Self : in     Item) return Vector_3;
+   overriding
+   procedure Gravity_is (Self : in out Item;   Now      : in Vector_3);
+
+   overriding
+   procedure add        (Self : in out Item;   Joint    : in physics.Joint.view);
+   overriding
+   procedure rid        (Self : in out Item;   Joint    : in physics.Joint.view);
+
+   overriding
+   procedure update_Bounds
+                        (Self : in out Item;   of_Obect : in physics.Object.view);
+
+   overriding
+   procedure set_Joint_local_Anchor
+                        (Self : in out Item;   the_Joint    : in physics.Joint.view;
+                                               is_Anchor_A  : in Boolean;
+                                               local_Anchor : in Vector_3);
+
+end bullet_Physics.Space;

3-mid/physics/interface/source/private/bullet/bullet_physics.ads

@@ -0,0 +1,16 @@
+with
+     float_Math.Geometry.D3;
+
+package bullet_Physics
+--
+-- Provides an implementation of the physics interface using a binding to the Bullet3D C library.
+--
+is
+   pragma Pure;
+
+   package Math        renames float_Math;
+   package Geometry_3D renames math.Geometry.D3;
+
+   Error : exception;
+
+end bullet_Physics;