nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add initial prototype.

Browse Source
This commit is contained in:
Rod Kay
2022-07-31 17:34:54 +10:00
commit 54a53b2ac0
1421 changed files with 358874 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

228
4-high/gel/source/joint/gel-any_joint.adb Normal file
View File

@@ -0,0 +1,228 @@
with
physics.Object;
package body gel.any_Joint
is
use Math;
---------
-- Forge
--
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)
is
A_Frame : aliased constant Matrix_4x4 := Frame_A;
B_Frame : aliased 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 then sprite_A_Solid := std_Physics.Object.view (Sprite_A.Solid); end if;
if Sprite_B /= null then sprite_B_Solid := std_Physics.Object.view (Sprite_B.Solid); end if;
Joint.define (Joint_cast (Self), Sprite_A, Sprite_B); -- Define base class.
Self.Physics := in_Space.new_DoF6_Joint (sprite_A_Solid,
sprite_B_Solid,
A_Frame,
B_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_Anchor : in Vector_3;
pivot_Axis : in Matrix_3x3)
is
use linear_Algebra_3D;
pivot_in_A : constant Vector_3 := Inverse (Sprite_A.Spin) * (pivot_Anchor - Sprite_A.Site);
pivot_in_B : constant Vector_3 := Inverse (Sprite_B.Spin) * (pivot_Anchor - Sprite_B.Site);
axis_in_A : constant Matrix_3x3 := Sprite_A.Spin * pivot_Axis;
axis_in_B : constant Matrix_3x3 := Sprite_B.Spin * pivot_Axis;
Frame_A : constant Matrix_4x4 := to_transform_Matrix (axis_in_A, pivot_in_A);
Frame_B : constant Matrix_4x4 := to_transform_Matrix (axis_in_B, pivot_in_B);
begin
Self.define (in_Space,
Sprite_A, Sprite_B,
Frame_A, Frame_B);
end define;
overriding
procedure destroy (Self : in out Item)
is
begin
raise Error with "TODO";
end destroy;
--------------
--- Attributes
--
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 gel.joint.Physics_view
is
begin
return gel.joint.Physics_view (Self.Physics);
end Physics;
overriding
function Degrees_of_freedom (Self : in Item) return Joint.Degree_of_freedom
is
pragma unreferenced (Self);
begin
return 6;
end Degrees_of_freedom;
-- Bounds - limits the range of motion for a degree of freedom.
--
-- TODO: Use Radians type for angular bounds.
overriding
function is_Bound (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Boolean
is
begin
if for_Degree in Sway .. Surge then
return False;
end if;
return Self.Physics.is_Limited (for_Degree);
end is_Bound;
overriding
function low_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real
is
begin
case for_Degree
is
when Sway .. Surge =>
raise Error with "Unhandled degree of freedom:" & for_Degree'Image;
when Pitch .. Roll =>
return Self.Physics.lower_Limit (for_Degree);
end case;
end low_Bound;
overriding
procedure low_Bound_is (Self : access Item; for_Degree : in Joint.Degree_of_freedom;
Now : in Real)
is
begin
Self.Physics.lower_Limit_is (Now, for_Degree);
end low_Bound_is;
overriding
function high_Bound (Self : access Item; for_Degree : in Joint.Degree_of_freedom) return Real
is
begin
case for_Degree
is
when Sway .. Surge =>
raise Error with "Unhandled degree of freedom:" & for_Degree'Image;
when Pitch .. Roll =>
return Self.Physics.upper_Limit (for_Degree);
end case;
end high_Bound;
overriding
procedure high_Bound_is (Self : access Item; for_Degree : in Joint.Degree_of_freedom;
Now : in Real)
is
begin
Self.Physics.upper_Limit_is (Now, for_Degree);
end high_Bound_is;
----------
-- Extent
--
overriding
function Extent (Self : in Item; for_Degree : in Joint.Degree_of_freedom) return Real
is
begin
if for_Degree in Sway .. Surge
then
raise Error with "Unhandled degree of freedom:" & for_Degree'Image;
end if;
return Self.Physics.Extent (for_Degree);
end Extent;
------------------
-- Motor Velocity
--
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.any_Joint;

109
4-high/gel/source/joint/gel-any_joint.ads Normal file
View File

@@ -0,0 +1,109 @@
with
gel.Joint,
gel.Sprite,
physics.Joint.DoF6,
physics.Space;
package GEL.any_Joint
--
-- Allows sprites to be connected via '6 degree of freedom' joint.
--
is
type Item is new GEL.Joint.Item with private;
type View is access all Item'Class;
type Views is array (Math.Index range <>) of View;
Sway : constant Joint.Degree_of_freedom := 1;
Heave : constant Joint.Degree_of_freedom := 2;
Surge : constant Joint.Degree_of_freedom := 3;
Pitch : constant Joint.Degree_of_freedom := 4;
Yaw : constant Joint.Degree_of_freedom := 5;
Roll : constant Joint.Degree_of_freedom := 6;
package std_physics renames standard.Physics;
---------
--- Forge
--
procedure define (Self : access Item; in_Space : in std_physics.Space.view;
Sprite_A, Sprite_B : access gel.Sprite.item'Class;
pivot_Anchor : in math.Vector_3;
pivot_Axis : in math.Matrix_3x3);
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 math.Matrix_4x4);
overriding
procedure destroy (Self : in out Item);
--------------
--- Attributes
--
overriding
function Physics (Self : in Item) return gel.Joint.Physics_view;
overriding
function Frame_A (Self : in Item) return math.Matrix_4x4;
overriding
function Frame_B (Self : in Item) return math.Matrix_4x4;
overriding
procedure Frame_A_is (Self : in out Item; Now : in math.Matrix_4x4);
overriding
procedure Frame_B_is (Self : in out Item; Now : in math.Matrix_4x4);
overriding
function Degrees_of_freedom (Self : in Item) return joint.Degree_of_freedom;
-- Bounds - limits the range of motion for a degree of freedom.
--
overriding
function is_Bound (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Boolean;
overriding
function low_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return math.Real;
overriding
procedure low_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in math.Real);
overriding
function high_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return math.Real;
overriding
procedure high_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in math.Real);
overriding
function Extent (Self : in Item; for_Degree : in joint.Degree_of_freedom) return math.Real;
overriding
procedure Velocity_is (Self : in Item; for_Degree : in joint.Degree_of_freedom;
Now : in math.Real);
--------------
--- Operations
--
-- Nil.
private
type physics_DoF6_Joint_view is access all std_physics.Joint.DoF6.item'Class;
type Item is new gel.Joint.item with
record
Physics : access std_physics.Joint.DoF6.item'Class;
end record;
end GEL.any_Joint;

188
4-high/gel/source/joint/gel-ball_joint.adb Normal file
View File

@@ -0,0 +1,188 @@
with
physics.Object;
package body GEL.ball_Joint
is
----------
--- Forge
--
procedure define (Self : access Item; in_Space : in std_physics.Space.view;
Sprite_A, Sprite_B : access gel.Sprite.item'Class;
Pivot_in_A, Pivot_in_B : in Vector_3)
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 then sprite_A_Solid := std_physics.Object.view (Sprite_A.Solid); end if;
if Sprite_B /= null then sprite_B_Solid := std_physics.Object.view (Sprite_B.Solid); end if;
Joint.define (Joint_cast (Self), Sprite_A, Sprite_B); -- Define base class.
Self.Physics := in_Space.new_ball_Joint (sprite_A_Solid,
sprite_B_Solid,
Pivot_in_A,
Pivot_in_B);
end define;
overriding
procedure destroy (Self : in out Item)
is
begin
raise Error with "TODO";
end destroy;
--------------
--- Attributes
--
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 gel.joint.Physics_view
is
begin
return Self.Physics;
end Physics;
overriding
function Degrees_of_freedom (Self : in Item) return joint.Degree_of_freedom
is
pragma unreferenced (Self);
begin
return 6;
end Degrees_of_freedom;
----------
--- Bounds - limits the range of motion for a Degree of freedom.
--
overriding
function is_Bound (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Boolean
is
begin
if for_Degree in Sway .. Surge then
return False;
end if;
return Self.Physics.is_Limited (for_Degree);
end is_Bound;
overriding
function low_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real
is
begin
case for_Degree
is
when Sway .. Surge =>
raise Error with "Unhandled degree of freedom:" & for_Degree'Image;
when Pitch .. Roll =>
return Self.Physics.lower_Limit (for_Degree);
end case;
end low_Bound;
overriding
procedure low_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real)
is
begin
Self.Physics.lower_Limit_is (Now, for_Degree);
end low_Bound_is;
overriding
function high_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real
is
begin
case for_Degree
is
when Sway .. Surge =>
raise Error with "Unhandled degree of freedom:" & for_Degree'Image;
when Pitch .. Roll =>
return Self.Physics.upper_Limit (for_Degree);
end case;
end high_Bound;
overriding
procedure high_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real)
is
begin
Self.Physics.upper_Limit_is (Now, for_Degree);
end high_Bound_is;
----------
--- Extent
--
overriding
function Extent (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Real
is
begin
if for_Degree in Sway .. Surge
then
raise Error with "Unhandled Degree of freedom:" & for_Degree'Image;
end if;
return Self.Physics.Extent (for_Degree);
end Extent;
------------------
--- Motor Velocity
--
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.ball_Joint;

107
4-high/gel/source/joint/gel-ball_joint.ads Normal file
View File

@@ -0,0 +1,107 @@
with
gel.Joint,
gel.Sprite,
physics.Joint.DoF6,
physics.Joint.Ball,
physics.Space;
package gel.ball_Joint
--
-- Allows sprites to be connected via a 'ball and socket' joint.
--
is
type Item is new gel.Joint.item with private;
type View is access all Item'Class;
type Views is array (math.Index range <>) of View;
Sway : constant Joint.Degree_of_freedom := 1; -- TODO: Can we use an enumeration here ?
Heave : constant Joint.Degree_of_freedom := 2;
Surge : constant Joint.Degree_of_freedom := 3;
Pitch : constant Joint.Degree_of_freedom := 4;
Yaw : constant Joint.Degree_of_freedom := 5;
Roll : constant Joint.Degree_of_freedom := 6;
package std_physics renames standard.Physics;
use Math;
----------
--- Forge
--
procedure define (Self : access Item; in_Space : in std_physics.Space.view;
Sprite_A, Sprite_B : access gel.Sprite.item'Class;
Pivot_in_A, Pivot_in_B : in Vector_3);
overriding
procedure destroy (Self : in out Item);
--------------
-- Attributes
--
overriding
function Physics (Self : in Item) return gel.joint.Physics_view;
overriding
function Frame_A (Self : in Item) return Matrix_4x4;
overriding
function Frame_B (Self : in Item) return Matrix_4x4;
overriding
procedure Frame_A_is (Self : in out Item; Now : in Matrix_4x4);
overriding
procedure Frame_B_is (Self : in out Item; Now : in Matrix_4x4);
overriding
function Degrees_of_freedom (Self : in Item) return joint.Degree_of_freedom;
----------
--- Bounds - limits the range of motion for a degree of freedom.
--
overriding
function is_Bound (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Boolean;
overriding
function low_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real;
overriding
procedure low_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real);
overriding
function high_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real;
overriding
procedure high_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real);
overriding
function Extent (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Real;
overriding
procedure Velocity_is (Self : in Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real);
--------------
--- Operations
--
-- Nil.
private
type physics_DoF6_Joint_view is access all std_physics.Joint.DoF6.item'Class;
type Item is new GEL.Joint.item with
record
Physics : access std_physics.Joint.ball.item'Class;
end record;
end gel.ball_Joint;

209
4-high/gel/source/joint/gel-cone_twist_joint.adb Normal file
View File

@@ -0,0 +1,209 @@
with
physics.Object;
package body gel.cone_twist_Joint
is
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)
is
A_Frame : aliased constant Matrix_4x4 := Frame_A;
B_Frame : aliased 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 then sprite_A_Solid := standard.physics.Object.view (Sprite_A.Solid); end if;
if Sprite_B /= null then sprite_B_Solid := standard.physics.Object.view (Sprite_B.Solid); end if;
Joint.define (Joint_cast (Self), Sprite_A, Sprite_B); -- Define base class.
Self.Physics := in_Space.new_DoF6_Joint (sprite_A_Solid,
sprite_B_Solid,
A_Frame,
B_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_Anchor : in Vector_3;
pivot_Axis : in Matrix_3x3)
is
use linear_Algebra_3D;
pivot_in_A : constant Vector_3 := pivot_Anchor - Sprite_A.Site;
pivot_in_B : constant Vector_3 := pivot_Anchor - Sprite_B.Site;
Frame_A : constant Matrix_4x4 := to_transform_Matrix (pivot_Axis, pivot_in_A);
Frame_B : constant Matrix_4x4 := to_transform_Matrix (pivot_Axis, pivot_in_B);
begin
Self.define (in_Space,
Sprite_A, Sprite_B,
Frame_A, Frame_B);
end define;
overriding
procedure destroy (Self : in out Item)
is
begin
raise Error with "TODO";
end destroy;
--------------
--- Attributes
--
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 gel.Joint.Physics_view
is
begin
return joint.Physics_view (Self.Physics);
end Physics;
overriding
function Degrees_of_freedom (Self : in Item) return joint.Degree_of_freedom
is
pragma unreferenced (Self);
begin
return 6;
end Degrees_of_freedom;
-- Bounds - limits the range of motion for a Degree of freedom.
--
overriding
function is_Bound (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Boolean
is
begin
if for_Degree in Sway .. Surge
then
return False;
end if;
return Self.Physics.is_Limited (for_Degree);
end is_Bound;
overriding
function low_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real
is
begin
case for_Degree
is
when Sway .. Surge =>
raise Error with "Unhandled Degree of freedom:" & for_Degree'Image;
when Pitch .. Roll =>
return Self.Physics.lower_Limit (for_Degree);
end case;
end low_Bound;
overriding
procedure low_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real)
is
begin
Self.Physics.lower_Limit_is (Now, for_Degree);
end low_Bound_is;
overriding
function high_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real
is
begin
case for_Degree
is
when Sway .. Surge =>
raise Error with "Unhandled Degree of freedom:" & for_Degree'Image;
when Pitch .. Roll =>
return Self.Physics.upper_Limit (for_Degree);
end case;
end high_Bound;
overriding
procedure high_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real)
is
begin
Self.Physics.upper_Limit_is (Now, for_Degree);
end high_Bound_is;
----------
--- Extent
--
overriding
function Extent (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Real
is
begin
if for_Degree in Sway .. Surge
then
raise Error with "Unhandled Degree of freedom:" & for_Degree'Image;
end if;
return Self.Physics.Extent (for_Degree);
end Extent;
------------------
--- Motor Velocity
--
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.cone_twist_Joint;

109
4-high/gel/source/joint/gel-cone_twist_joint.ads Normal file
View File

@@ -0,0 +1,109 @@
with
gel.Joint,
gel.Sprite,
physics.Joint.DoF6,
physics.Space;
package gel.cone_twist_Joint
--
-- Allows sprites to be connected via 'cone-twist' joint.
--
is
type Item is new gel.Joint.item with private;
type View is access all Item'Class;
type Views is array (math.Index range <>) of View;
Sway : constant Joint.Degree_of_freedom := 1; -- TODO: These are duplicated in other joints.
Heave : constant Joint.Degree_of_freedom := 2;
Surge : constant Joint.Degree_of_freedom := 3;
Pitch : constant Joint.Degree_of_freedom := 4;
Yaw : constant Joint.Degree_of_freedom := 5;
Roll : constant Joint.Degree_of_freedom := 6;
package std_physics renames standard.Physics;
use Math;
---------
--- Forge
--
procedure define (Self : access Item; in_Space : in std_physics.Space.view;
Sprite_A, Sprite_B : access gel.Sprite.item'Class;
pivot_Anchor : in Vector_3;
pivot_Axis : in Matrix_3x3);
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);
overriding
procedure destroy (Self : in out Item);
--------------
--- Attributes
--
overriding
function Physics (Self : in Item) return gel.joint.Physics_view;
overriding
function Frame_A (Self : in Item) return Matrix_4x4;
overriding
function Frame_B (Self : in Item) return Matrix_4x4;
overriding
procedure Frame_A_is (Self : in out Item; Now : in Matrix_4x4);
overriding
procedure Frame_B_is (Self : in out Item; Now : in Matrix_4x4);
overriding
function Degrees_of_freedom (Self : in Item) return joint.Degree_of_freedom;
-- Bounds - limits the range of motion for a degree of freedom.
--
overriding
function is_Bound (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Boolean;
overriding
function low_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real;
overriding
procedure low_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real);
overriding
function high_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real;
overriding
procedure high_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real);
overriding
function Extent (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Real;
overriding
procedure Velocity_is (Self : in Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real);
--------------
--- Operations
--
-- Nil.
private
type physics_DoF6_Joint_view is access all std_physics.Joint.DoF6.item'Class;
type Item is new GEL.Joint.Item with
record
Physics : access std_physics.Joint.DoF6.item'Class;
end record;
end gel.cone_twist_Joint;

334
4-high/gel/source/joint/gel-hinge_joint.adb Normal file
View File

@@ -0,0 +1,334 @@
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);
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 Angle (Self : in Item'Class) return Real
is
begin
raise Error with "TODO";
return 0.0;
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;
----------------
--- 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;
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;

143
4-high/gel/source/joint/gel-hinge_joint.ads Normal file
View File

@@ -0,0 +1,143 @@
with
gel.Joint,
gel.Sprite,
physics.Joint.hinge,
physics.Space;
package gel.hinge_Joint
--
-- Allows sprites to be connected via a hinge joint.
--
is
type Item is new gel.Joint.item with private;
type View is access all Item'Class;
type Views is array (math.Index range <>) of View;
-- Degrees of freedom.
--
Revolve : constant joint.Degree_of_freedom := 1;
package std_physics renames standard.Physics;
use Math;
---------
--- Forge
--
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 : in Vector_3;
Anchor_in_B : in Vector_3;
low_Limit,
high_Limit : in math.Real;
collide_Conected : in Boolean);
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);
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);
--
-- Uses midpoint between sprite A and B for the pivot anchor.
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);
procedure define (Self : access Item; in_Space : in std_physics.Space.view;
Sprite_A : access gel.Sprite.item'Class;
Frame_A : in Matrix_4x4);
overriding
procedure destroy (Self : in out Item);
--------------
--- Attributes
--
function Angle (Self : in Item'Class) return Real;
overriding
function Physics (Self : in Item) return Joint.Physics_view;
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);
overriding
function Frame_A (Self : in Item) return Matrix_4x4;
overriding
function Frame_B (Self : in Item) return Matrix_4x4;
overriding
procedure Frame_A_is (Self : in out Item; Now : in Matrix_4x4);
overriding
procedure Frame_B_is (Self : in out Item; Now : in Matrix_4x4);
overriding
function Degrees_of_freedom (Self : in Item) return joint.degree_of_Freedom;
-- 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;
overriding
procedure low_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real);
overriding
function high_Bound (Self : access Item; for_Degree : in joint.Degree_of_freedom) return Real;
overriding
procedure high_Bound_is (Self : access Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real);
overriding
function is_Bound (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Boolean;
overriding
function Extent (Self : in Item; for_Degree : in joint.Degree_of_freedom) return Real;
overriding
procedure Velocity_is (Self : in Item; for_Degree : in joint.Degree_of_freedom;
Now : in Real);
--------------
--- Operations
--
-- Nil.
private
type Item is new gel.Joint.item with
record
Physics : access std_physics.Joint.hinge.item'Class;
low_Bound,
high_Bound : Real;
Softness : Real;
bias_Factor : Real;
relaxation_Factor : Real;
end record;
procedure apply_Limits (Self : in out Item);
end gel.hinge_Joint;

123
4-high/gel/source/joint/gel-joint.adb Normal file
View File

@@ -0,0 +1,123 @@
with
gel.Sprite,
gel.World,
ada.unchecked_Deallocation;
package body gel.Joint
is
function to_GEL (the_Joint : standard.physics.Joint.view) return gel.Joint.view
is
begin
return gel.Joint.view (the_Joint.user_Data);
end to_GEL;
---------
--- Forge
--
procedure define (Self : access Item; Sprite_A, Sprite_B : access gel.Sprite.item'class)
is
begin
Self.Sprite_A := Sprite_A;
Self.Sprite_B := Sprite_B;
end define;
procedure free (Self : in out View)
is
procedure deallocate is new ada.unchecked_Deallocation (Joint.item'Class, Joint.view);
begin
if Self /= null then
Self.destroy;
end if;
deallocate (Self);
end free;
--------------
--- Attributes
--
function Sprite_A (Self : in Item'Class) return access gel.Sprite.item'class
is
begin
return Self.Sprite_A;
end Sprite_A;
function Sprite_B (Self : in Item'Class) return access gel.Sprite.item'class
is
begin
return Self.Sprite_B;
end Sprite_B;
----------
--- Hinges
--
function local_Anchor_on_A (Self : in Item) return Vector_3
is
begin
return Self.local_Anchor_on_A;
end local_Anchor_on_A;
function local_Anchor_on_B (Self : in Item) return Vector_3
is
begin
return Self.local_Anchor_on_B;
end local_Anchor_on_B;
procedure local_Anchor_on_A_is (Self : out Item; Now : in Vector_3)
is
begin
Self.local_Anchor_on_A := Now;
if Self.Sprite_A.World /= null
then
Self.Sprite_A.World.set_local_Anchor_on_A (for_Joint => Self'unchecked_Access,
To => Now);
end if;
end local_Anchor_on_A_is;
procedure local_Anchor_on_B_is (Self : out Item; Now : in Vector_3)
is
begin
Self.local_Anchor_on_B := Now;
if Self.Sprite_B.World /= null
then
Self.Sprite_B.World.set_local_Anchor_on_B (for_Joint => Self'unchecked_Access,
To => Now);
end if;
end local_Anchor_on_B_is;
function reaction_Force (Self : in Item'Class) return Vector_3
is
begin
return Self.Physics.reaction_Force;
end reaction_Force;
function reaction_Torque (Self : in Item'Class) return Real
is
begin
return Self.Physics.reaction_Torque;
end reaction_Torque;
end gel.Joint;

124
4-high/gel/source/joint/gel-joint.ads Normal file
View File

@@ -0,0 +1,124 @@
with
physics.Joint,
lace.Any;
limited
with
gel.Sprite;
package gel.Joint
--
-- Allows sprites to be connected via a joint.
-- A joint constrains the motion of the sprites which it connects.
--
is
type Item is abstract new lace.Any.limited_item with private;
type View is access all Item'Class;
type Views is array (math.Index range <>) of View;
null_Joints : constant Joint.views;
function to_GEL (the_Joint : in physics.Joint.view) return gel.Joint.view;
subtype Degree_of_freedom is physics.Joint.Degree_of_freedom;
use Math;
---------
--- Forge
--
procedure define (Self : access Item; Sprite_A, Sprite_B : access gel.Sprite.item'Class);
procedure destroy (Self : in out Item) is abstract;
procedure free (Self : in out View);
--------------
--- Attributes
--
function Sprite_A (Self : in Item'Class) return access gel.Sprite.item'Class;
function Sprite_B (Self : in Item'Class) return access gel.Sprite.item'Class;
function Frame_A (Self : in Item) return Matrix_4x4 is abstract;
function Frame_B (Self : in Item) return Matrix_4x4 is abstract;
procedure Frame_A_is (Self : in out Item; Now : in Matrix_4x4) is abstract;
procedure Frame_B_is (Self : in out Item; Now : in Matrix_4x4) is abstract;
function Degrees_of_freedom (Self : in Item) return degree_of_Freedom is abstract;
--
-- Returns the number of possible DoF's for this joint.
type Physics_view is access all physics.Joint.item'Class;
function Physics (Self : in Item) return Physics_view is abstract;
-- Bounds - limits the range of motion for a Degree of freedom.
--
function low_Bound (Self : access Item; for_Degree : in Degree_of_freedom) return Real is abstract;
procedure low_Bound_is (Self : access Item; for_Degree : in Degree_of_freedom;
Now : in Real) is abstract;
function high_Bound (Self : access Item; for_Degree : in Degree_of_freedom) return Real is abstract;
procedure high_Bound_is (Self : access Item; for_Degree : in Degree_of_freedom;
Now : in Real) is abstract;
function is_Bound (Self : in Item; for_Degree : in Degree_of_freedom) return Boolean is abstract;
--
-- Returns true if an upper or lower bound has been set for the given Degree of freedom.
function Extent (Self : in Item; for_Degree : in Degree_of_freedom) return Real is abstract;
--
-- Angle about axis for rotational joints or spatial distance along an axis, in the case of sliders, etc.
procedure Velocity_is (Self : in Item; for_Degree : in Degree_of_freedom;
Now : in Real) is abstract;
function reaction_Force (Self : in Item'Class) return Vector_3;
function reaction_Torque (Self : in Item'Class) return Real;
--------------
--- Operations
--
-- Nil.
----------
--- Hinges
--
function local_Anchor_on_A (Self : in Item) return Vector_3;
function local_Anchor_on_B (Self : in Item) return Vector_3;
procedure local_Anchor_on_A_is (Self : out Item; Now : in Vector_3);
procedure local_Anchor_on_B_is (Self : out Item; Now : in Vector_3);
private
type Item is abstract new lace.Any.limited_item with
record
Sprite_A : access gel.Sprite.item'Class;
Sprite_B : access gel.Sprite.item'Class;
local_Anchor_on_A : Vector_3;
local_Anchor_on_B : Vector_3;
end record;
null_Joints : constant Joint.views (1 .. 0) := [others => null];
end gel.Joint;

203
4-high/gel/source/joint/gel-slider_joint.adb Normal file
View File

@@ -0,0 +1,203 @@
with
physics.Object;
package body gel.slider_Joint
is
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)
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 then sprite_A_Solid := std_physics.Object.view (Sprite_A.Solid); end if;
if Sprite_B /= null then sprite_B_Solid := std_physics.Object.view (Sprite_B.Solid); end if;
Joint.define (Joint_cast (Self), Sprite_A, Sprite_B); -- Define base class.
Self.Physics := in_Space.new_slider_Joint (sprite_A_Solid,
sprite_B_Solid,
A_Frame,
B_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_Anchor : in Vector_3;
pivot_Axis : in Matrix_3x3)
is
use linear_Algebra_3D;
pivot_in_A : constant Vector_3 := pivot_Anchor - Sprite_A.Site;
pivot_in_B : constant Vector_3 := pivot_Anchor - Sprite_B.Site;
Frame_A : constant Matrix_4x4 := to_transform_Matrix (pivot_Axis, pivot_in_A);
Frame_B : constant Matrix_4x4 := to_transform_Matrix (pivot_Axis, pivot_in_B);
begin
Self.define (in_Space,
Sprite_A, Sprite_B,
Frame_A, Frame_B);
end define;
overriding
procedure destroy (Self : in out Item)
is
begin
raise Error with "TODO";
end destroy;
--------------
--- Attributes
--
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 gel.Joint.Physics_view is
begin
return GEL.Joint.Physics_view (Self.Physics);
end Physics;
overriding
function Degrees_of_freedom (Self : in Item) return Joint.Degree_of_freedom
is
pragma unreferenced (Self);
begin
return 6; -- TODO: Fix this and all similar.
end Degrees_of_freedom;
-- Bounds - limits the range of motion for a Degree of freedom.
--
overriding
function is_Bound (Self : in Item; for_Degree : in Joint.Degree_of_freedom) return Boolean
is
begin
if for_Degree in Sway .. Surge
then
return False;
end if;
return Self.Physics.is_Limited (for_Degree);
end is_Bound;
overriding
function low_Bound (Self : access Item; for_Degree : in Joint.Degree_of_freedom) return Real
is
begin
case for_Degree
is
when Sway .. Surge =>
raise Error with "Unhandled degree of freedom:" & for_Degree'Image;
when Pitch .. Roll =>
return Self.Physics.lower_Limit (for_Degree);
end case;
end low_Bound;
overriding
procedure low_Bound_is (Self : access Item; for_Degree : in Joint.Degree_of_freedom;
Now : in Real)
is
begin
Self.Physics.lower_Limit_is (Now, for_Degree);
end low_Bound_is;
overriding
function high_Bound (Self : access Item; for_Degree : in Joint.Degree_of_freedom) return Real
is
begin
case for_Degree
is
when Sway .. Surge =>
raise Error with "Unhandled degree of freedom:" & for_Degree'Image;
when Pitch .. Roll =>
return Self.Physics.upper_Limit (for_Degree);
end case;
end high_Bound;
overriding
procedure high_Bound_is (Self : access Item; for_Degree : in Joint.Degree_of_freedom;
Now : in Real)
is
begin
Self.Physics.upper_Limit_is (Now, for_Degree);
end high_Bound_is;
----------
--- Extent
--
overriding
function Extent (Self : in Item; for_Degree : in Joint.Degree_of_freedom) return Real
is
begin
if for_Degree in Sway .. Surge
then
raise Error with "Unhandled degree of freedom:" & for_Degree'Image;
end if;
return Self.Physics.Extent (for_Degree);
end Extent;
------------------
--- Motor Velocity
--
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.slider_Joint;

108
4-high/gel/source/joint/gel-slider_joint.ads Normal file
View File

@@ -0,0 +1,108 @@
with
gel.Joint,
gel.Sprite,
physics.Joint.slider,
physics.Space;
package gel.slider_Joint
--
-- Allows sprites to be connected via a slider joint.
--
is
type Item is new gel.Joint.Item with private;
type View is access all Item'Class;
type Views is array (math.Index range <>) of View;
Sway : constant Joint.Degree_of_freedom := 1; -- TODO: These are duplicated.
Heave : constant Joint.Degree_of_freedom := 2;
Surge : constant Joint.Degree_of_freedom := 3;
Pitch : constant Joint.Degree_of_freedom := 4;
Yaw : constant Joint.Degree_of_freedom := 5;
Roll : constant Joint.Degree_of_freedom := 6;
package std_physics renames standard.Physics;
use Math;
---------
--- Forge
--
procedure define (Self : access Item; in_Space : in std_physics.Space.view;
Sprite_A, Sprite_B : access gel.Sprite.item'Class;
pivot_Anchor : in Vector_3;
pivot_Axis : in Matrix_3x3);
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);
overriding
procedure destroy (Self : in out Item);
--------------
--- Attributes
--
overriding
function Physics (Self : in Item) return gel.Joint.Physics_view;
overriding
function Frame_A (Self : in Item) return Matrix_4x4;
overriding
function Frame_B (Self : in Item) return Matrix_4x4;
overriding
procedure Frame_A_is (Self : in out Item; Now : in Matrix_4x4);
overriding
procedure Frame_B_is (Self : in out Item; Now : in Matrix_4x4);
overriding
function Degrees_of_freedom (Self : in Item) return Joint.Degree_of_freedom;
-- Bounds - limits the range of motion for a Degree of freedom.
--
overriding
function is_Bound (Self : in Item; for_Degree : in Joint.Degree_of_freedom) return Boolean;
overriding
function low_Bound (Self : access Item; for_Degree : in Joint.Degree_of_freedom) return Real;
overriding
procedure low_Bound_is (Self : access Item; for_Degree : in Joint.Degree_of_freedom;
Now : in Real);
overriding
function high_Bound (Self : access Item; for_Degree : in Joint.Degree_of_freedom) return Real;
overriding
procedure high_Bound_is (Self : access Item; for_Degree : in Joint.Degree_of_freedom;
Now : in Real);
overriding
function Extent (Self : in Item; for_Degree : in Joint.Degree_of_freedom) return Real;
overriding
procedure Velocity_is (Self : in Item; for_Degree : in Joint.Degree_of_freedom;
Now : in Real);
--------------
--- Operations
--
-- Nil.
private
type physics_slider_Joint_view is access all std_physics.Joint.slider.item'Class;
type Item is new gel.Joint.Item with
record
Physics : access std_physics.Joint.slider.item'Class;
end record;
end gel.slider_Joint;