Add initial prototype.
This commit is contained in:
Rod Kay
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
Reference in New Issue
Block a user