1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
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;
|