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;