407 lines
11 KiB
Ada
407 lines
11 KiB
Ada
with
|
|
physics.Object,
|
|
ada.unchecked_Deallocation;
|
|
|
|
package body gel.hinge_Joint
|
|
is
|
|
use gel.Joint;
|
|
|
|
|
|
procedure define (Self : access Item; in_Space : in std_physics.Space.view;
|
|
Sprite_A, Sprite_B : access gel.Sprite.item'Class;
|
|
pivot_Axis : in Vector_3;
|
|
pivot_Anchor : in Vector_3)
|
|
is
|
|
pivot_in_A : constant Vector_3 := (pivot_Anchor - Sprite_A.Site);
|
|
pivot_in_B : constant Vector_3 := (pivot_Anchor - Sprite_B.Site);
|
|
|
|
the_Axis : constant Vector_3 := pivot_Axis;
|
|
|
|
begin
|
|
Self.define (in_Space,
|
|
Sprite_A, Sprite_B,
|
|
the_Axis,
|
|
pivot_in_A, pivot_in_B,
|
|
low_Limit => to_Radians (-180.0),
|
|
high_Limit => to_Radians ( 180.0),
|
|
collide_Conected => False);
|
|
|
|
Self.pivot_Anchor := pivot_Anchor;
|
|
end define;
|
|
|
|
|
|
|
|
procedure define (Self : access Item; in_Space : in std_physics.Space.view;
|
|
Sprite_A, Sprite_B : access gel.Sprite.item'Class;
|
|
pivot_Axis : in Vector_3)
|
|
is
|
|
Midpoint : constant Vector_3 := (Sprite_A.Site + Sprite_B.Site) / 2.0;
|
|
begin
|
|
Self.define (in_Space,
|
|
Sprite_A,
|
|
Sprite_B,
|
|
pivot_Axis,
|
|
pivot_anchor => Midpoint);
|
|
end define;
|
|
|
|
|
|
|
|
procedure define (Self : access Item; in_Space : in std_physics.Space.view;
|
|
Sprite_A, Sprite_B : access gel.Sprite.item'Class;
|
|
Frame_A, Frame_B : in Matrix_4x4;
|
|
low_Limit : in Real := to_Radians (-180.0);
|
|
high_Limit : in Real := to_Radians ( 180.0);
|
|
collide_Conected : in Boolean)
|
|
is
|
|
A_Frame : constant Matrix_4x4 := Frame_A;
|
|
B_Frame : constant Matrix_4x4 := Frame_B;
|
|
|
|
type Joint_cast is access all gel.Joint.item;
|
|
|
|
sprite_A_Solid,
|
|
sprite_B_Solid : std_physics.Object.view;
|
|
|
|
begin
|
|
if Sprite_A = null
|
|
or Sprite_B = null
|
|
then
|
|
raise Error with "Sprite is null.";
|
|
end if;
|
|
|
|
sprite_A_Solid := std_physics.Object.view (Sprite_A.Solid);
|
|
sprite_B_Solid := std_physics.Object.view (Sprite_B.Solid);
|
|
|
|
joint.define (Joint_cast (Self), Sprite_A, Sprite_B); -- Define base class.
|
|
|
|
Self.Physics := in_Space.new_hinge_Joint (sprite_A_Solid, sprite_B_Solid,
|
|
A_Frame, B_Frame,
|
|
low_Limit, high_Limit,
|
|
collide_Conected);
|
|
end define;
|
|
|
|
|
|
|
|
procedure define (Self : access Item; in_Space : in std_physics.Space.view;
|
|
Sprite_A : access gel.Sprite.item'Class;
|
|
Frame_A : in Matrix_4x4)
|
|
is
|
|
type Joint_cast is access all gel.Joint.item;
|
|
|
|
A_Frame : constant Matrix_4x4 := Frame_A;
|
|
sprite_A_Solid : std_physics.Object.view;
|
|
|
|
begin
|
|
joint.define (Joint_cast (Self), Sprite_A, null); -- Define base class.
|
|
|
|
sprite_A_Solid := std_physics.Object.view (Sprite_A.Solid);
|
|
Self.Physics := in_Space.new_hinge_Joint (sprite_A_Solid,
|
|
A_Frame);
|
|
end define;
|
|
|
|
|
|
|
|
procedure define (Self : access Item; in_Space : in std_physics.Space.view;
|
|
Sprite_A,
|
|
Sprite_B : access gel.Sprite.item'Class;
|
|
pivot_Axis : in Vector_3;
|
|
Anchor_in_A,
|
|
Anchor_in_B : in Vector_3;
|
|
low_Limit,
|
|
high_Limit : in Real;
|
|
collide_Conected : in Boolean)
|
|
is
|
|
type Joint_cast is access all gel.Joint.item;
|
|
|
|
sprite_A_Solid,
|
|
sprite_B_Solid : std_physics.Object.view;
|
|
|
|
begin
|
|
if Sprite_A = null
|
|
or Sprite_B = null
|
|
then
|
|
raise Error with "Attempt to join a null sprite.";
|
|
end if;
|
|
|
|
sprite_A_Solid := std_physics.Object.view (Sprite_A.Solid);
|
|
sprite_B_Solid := std_physics.Object.view (Sprite_B.Solid);
|
|
|
|
Joint.define (Joint_cast (Self), Sprite_A, Sprite_B); -- Define base class.
|
|
|
|
Self.Physics := in_Space.new_hinge_Joint (sprite_A_Solid, sprite_B_Solid,
|
|
Anchor_in_A, Anchor_in_B,
|
|
pivot_Axis,
|
|
low_Limit, high_Limit,
|
|
collide_Conected);
|
|
end define;
|
|
|
|
|
|
overriding
|
|
procedure destroy (Self : in out Item)
|
|
is
|
|
my_Physics : std_physics.Joint.view := std_physics.Joint.view (Self.Physics);
|
|
|
|
procedure deallocate is new ada.unchecked_Deallocation (std_physics.Joint.item'Class,
|
|
std_physics.Joint.view);
|
|
begin
|
|
my_Physics.destruct;
|
|
deallocate (my_Physics);
|
|
|
|
Self.Physics := null;
|
|
end destroy;
|
|
|
|
|
|
--------------
|
|
--- Attributes
|
|
--
|
|
|
|
overriding
|
|
function Degrees_of_freedom (Self : in Item) return joint.degree_of_Freedom
|
|
is
|
|
pragma unreferenced (Self);
|
|
begin
|
|
return 1;
|
|
end Degrees_of_freedom;
|
|
|
|
|
|
|
|
function Anchor_on_A (Self : in Item) return Vector_3
|
|
is
|
|
begin
|
|
return Self.Physics.local_Anchor_on_A;
|
|
end Anchor_on_A;
|
|
|
|
|
|
|
|
function Anchor_on_B (Self : in Item) return Vector_3
|
|
is
|
|
begin
|
|
return Self.Physics.local_Anchor_on_B;
|
|
end Anchor_on_B;
|
|
|
|
|
|
|
|
function pivot_Anchor (Self : in Item) return Vector_3
|
|
is
|
|
begin
|
|
return Self.pivot_Anchor;
|
|
end pivot_Anchor;
|
|
|
|
|
|
|
|
function reference_Angle (Self : in Item) return Radians
|
|
is
|
|
begin
|
|
return Self.Physics.reference_Angle;
|
|
end reference_Angle;
|
|
|
|
|
|
|
|
function limit_Enabled (Self : in Item) return Boolean
|
|
is
|
|
begin
|
|
return Self.Physics.limit_Enabled;
|
|
end limit_Enabled;
|
|
|
|
|
|
|
|
function Angle (Self : in Item) return Real
|
|
is
|
|
begin
|
|
return Self.Physics.Angle;
|
|
end Angle;
|
|
|
|
|
|
overriding
|
|
function Frame_A (Self : in Item) return Matrix_4x4
|
|
is
|
|
begin
|
|
return Self.Physics.Frame_A;
|
|
end Frame_A;
|
|
|
|
|
|
overriding
|
|
function Frame_B (Self : in Item) return Matrix_4x4
|
|
is
|
|
begin
|
|
return Self.Physics.Frame_B;
|
|
end Frame_B;
|
|
|
|
|
|
overriding
|
|
procedure Frame_A_is (Self : in out Item; Now : in Matrix_4x4)
|
|
is
|
|
begin
|
|
Self.Physics.Frame_A_is (Now);
|
|
end Frame_A_is;
|
|
|
|
|
|
overriding
|
|
procedure Frame_B_is (Self : in out Item; Now : in Matrix_4x4)
|
|
is
|
|
begin
|
|
Self.Physics.Frame_B_is (Now);
|
|
end Frame_B_is;
|
|
|
|
|
|
overriding
|
|
function Physics (Self : in Item) return joint.Physics_view
|
|
is
|
|
begin
|
|
return Joint.Physics_view (Self.Physics);
|
|
end Physics;
|
|
|
|
|
|
|
|
---------
|
|
--- Motor
|
|
--
|
|
|
|
function motor_Enabled (Self : in Item) return Boolean
|
|
is
|
|
begin
|
|
return Self.Physics.motor_Enabled;
|
|
end motor_Enabled;
|
|
|
|
|
|
|
|
function motor_Speed (Self : in Item) return Real
|
|
is
|
|
begin
|
|
return Self.Physics.motor_Speed;
|
|
end motor_Speed;
|
|
|
|
|
|
|
|
function max_motor_Torque (Self : in Item) return Real
|
|
is
|
|
begin
|
|
return Self.Physics.max_motor_Torque;
|
|
end max_motor_Torque;
|
|
|
|
|
|
|
|
----------------
|
|
--- Joint Limits
|
|
--
|
|
|
|
procedure Limits_are (Self : in out Item'Class; Low, High : in Real;
|
|
Softness : in Real := 0.9;
|
|
bias_Factor : in Real := 0.3;
|
|
relaxation_Factor : in Real := 1.0)
|
|
is
|
|
begin
|
|
Self.low_Bound := Low;
|
|
Self.high_Bound := High;
|
|
Self.Softness := Softness;
|
|
Self.bias_Factor := bias_Factor;
|
|
Self.relaxation_Factor := relaxation_Factor;
|
|
|
|
Self.apply_Limits;
|
|
end Limits_are;
|
|
|
|
|
|
|
|
procedure apply_Limits (Self : in out Item)
|
|
is
|
|
begin
|
|
Self.Physics.Limits_are (Self.low_Bound,
|
|
Self.high_Bound,
|
|
Self.Softness,
|
|
Self.bias_Factor,
|
|
Self.relaxation_Factor);
|
|
end apply_Limits;
|
|
|
|
|
|
-- Bounds - limits the range of motion for a Degree of freedom.
|
|
--
|
|
|
|
overriding
|
|
function low_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real
|
|
is
|
|
use type joint.Degree_of_freedom;
|
|
begin
|
|
if for_Degree /= Revolve then
|
|
raise Error with "Invalid degree of freedom:" & for_Degree'Image;
|
|
end if;
|
|
|
|
return Self.low_Bound;
|
|
end low_Bound;
|
|
|
|
|
|
overriding
|
|
procedure low_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
|
|
Now : in Real)
|
|
is
|
|
use type joint.Degree_of_freedom;
|
|
begin
|
|
if for_Degree /= Revolve then
|
|
raise Error with "Invalid degree of freedom:" & for_Degree'Image;
|
|
end if;
|
|
|
|
Self.low_Bound := Now;
|
|
Self.apply_Limits;
|
|
end low_Bound_is;
|
|
|
|
|
|
overriding
|
|
function high_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real
|
|
is
|
|
use type joint.Degree_of_freedom;
|
|
begin
|
|
if for_Degree /= Revolve then
|
|
raise Error with "Invalid degree of freedom:" & for_Degree'Image;
|
|
end if;
|
|
|
|
return Self.high_Bound;
|
|
end high_Bound;
|
|
|
|
|
|
overriding
|
|
procedure high_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
|
|
Now : in Real)
|
|
is
|
|
use type joint.Degree_of_freedom;
|
|
|
|
Span : Real := abs (Now) * 2.0;
|
|
begin
|
|
if for_Degree /= Revolve then
|
|
raise Error with "Invalid degree of freedom:" & for_Degree'Image;
|
|
end if;
|
|
|
|
Self.high_Bound := Now;
|
|
Self.apply_Limits;
|
|
end high_Bound_is;
|
|
|
|
|
|
overriding
|
|
function Extent (Self : in Item; for_Degree : in Degree_of_freedom) return Real
|
|
is
|
|
use type joint.Degree_of_freedom;
|
|
begin
|
|
if for_Degree /= Revolve then
|
|
raise Error with "Invalid degree of freedom:" & for_Degree'Image;
|
|
end if;
|
|
|
|
return Self.Angle;
|
|
end Extent;
|
|
|
|
|
|
overriding
|
|
function is_Bound (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Boolean
|
|
is
|
|
begin
|
|
return Self.Physics.is_Limited (for_Degree);
|
|
end is_Bound;
|
|
|
|
|
|
overriding
|
|
procedure Velocity_is (Self : in Item; for_Degree : in joint.Degree_of_freedom;
|
|
Now : in Real)
|
|
is
|
|
begin
|
|
self.Physics.Velocity_is (Now, for_Degree);
|
|
end Velocity_is;
|
|
|
|
|
|
end gel.hinge_Joint;
|