1068 lines
28 KiB
Ada
1068 lines
28 KiB
Ada
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;
|
|
|
|
|
|
overriding
|
|
function collide_Connected (Self : in Item) return Boolean
|
|
is
|
|
begin
|
|
return Boolean'Val (b2d_Joint_collide_Connected (Self.C));
|
|
end collide_Connected;
|
|
|
|
|
|
|
|
--------
|
|
-- 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 physics.Joint.ball.view (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 physics.Joint.slider.view (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 physics.Joint.cone_twist.view (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 physics.Joint.hinge.view (Self);
|
|
end new_hinge_Joint;
|
|
|
|
|
|
|
|
function new_hinge_Joint (in_Space : in box2d_c.Pointers.Space_Pointer;
|
|
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 (in_Space,
|
|
c_Object_A,
|
|
c_Frame_A'unchecked_Access);
|
|
return physics.Joint.hinge.view (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 physics.Joint.hinge.view (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
|
|
return Real (b2d_Joint_hinge_Angle (Self.C));
|
|
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;
|
|
|
|
|
|
overriding
|
|
function local_Anchor_on_A (Self : in Hinge) return Vector_3
|
|
is
|
|
begin
|
|
return +b2d_Joint_hinge_local_Anchor_on_A (Self.C);
|
|
end local_Anchor_on_A;
|
|
|
|
|
|
|
|
overriding
|
|
function local_Anchor_on_B (Self : in Hinge) return Vector_3
|
|
is
|
|
begin
|
|
return +b2d_Joint_hinge_local_Anchor_on_B (Self.C);
|
|
end local_Anchor_on_B;
|
|
|
|
|
|
|
|
overriding
|
|
function reference_Angle (Self : in Hinge) return Radians
|
|
is
|
|
begin
|
|
return Radians (b2d_Joint_hinge_reference_Angle (Self.C));
|
|
end reference_Angle;
|
|
|
|
|
|
overriding
|
|
function limit_Enabled (Self : in Hinge) return Boolean
|
|
is
|
|
begin
|
|
return Boolean'Val (b2d_Joint_hinge_limit_Enabled (Self.C));
|
|
end limit_Enabled;
|
|
|
|
|
|
|
|
overriding
|
|
function motor_Enabled (Self : in Hinge) return Boolean
|
|
is
|
|
begin
|
|
return Boolean'Val (b2d_Joint_hinge_motor_Enabled (Self.C));
|
|
end motor_Enabled;
|
|
|
|
|
|
|
|
overriding
|
|
function motor_Speed (Self : in Hinge) return Real
|
|
is
|
|
begin
|
|
return Real (b2d_Joint_hinge_motor_Speed (Self.C));
|
|
end motor_Speed;
|
|
|
|
|
|
|
|
overriding
|
|
function max_motor_Torque (Self : in Hinge) return Real
|
|
is
|
|
begin
|
|
return Real (b2d_Joint_hinge_max_motor_Torque (Self.C));
|
|
end max_motor_Torque;
|
|
|
|
|
|
|
|
--------
|
|
--- 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;
|