Add initial prototype.

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;