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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232 | with Ada.Strings.Fixed;
with TCG.Utils; use TCG.Utils;
with DOM.Core; use DOM.Core;
with DOM.Core.Elements; use DOM.Core.Elements;
with DOM.Core.Nodes; use DOM.Core.Nodes;
package body TCG.Collision_Objects is
type Polygon_Access is access all Polygon;
function To_Float (Str : String) return Float;
function To_Point (Str : String) return Point;
function To_Polygon (Offset : Point;
Str : String)
return not null Polygon_Access;
function Create (N : Node) return Collision_Shape;
function Inside_Ellipse (Pt : Point;
Ellipse : Polygon)
return Boolean
with Pre => Ellipse'Length = 4 and then Ellipse'First = 1;
--------------
-- To_Float --
--------------
function To_Float (Str : String) return Float
is (Float'Value (Str));
--------------
-- To_Point --
--------------
function To_Point (Str : String) return Point is
Index : constant Natural := Ada.Strings.Fixed.Index (Str, ",");
begin
return (To_Float (Str (Str'First .. Index - 1)),
To_Float (Str (Index + 1 .. Str'Last)));
end To_Point;
----------------
-- To_Polygon --
----------------
function To_Polygon (Offset : Point;
Str : String)
return not null Polygon_Access
is
Number_Of_Points : constant Natural :=
Ada.Strings.Fixed.Count (Str, " ") + 1;
Ret : constant not null Polygon_Access
:= new Polygon (1 .. Number_Of_Points);
Index : Natural;
Last_Index : Natural := Str'First;
begin
for Pt of Ret.all loop
Index := Ada.Strings.Fixed.Index (Str (Last_Index .. Str'Last), " ");
if Index = 0 then
-- Last point in the list
Pt := To_Point (Str (Last_Index .. Str'Last));
else
Pt := To_Point (Str (Last_Index .. Index - 1));
end if;
Pt.X := Pt.X + Offset.X;
Pt.Y := Pt.Y + Offset.Y;
Last_Index := Index + 1;
end loop;
return Ret;
end To_Polygon;
------------
-- Create --
------------
function Create (N : Node) return Collision_Shape is
X : constant Float := To_Float (Item_As_String (N, "x"));
Y : constant Float := To_Float (Item_As_String (N, "y"));
Has_Width : constant Boolean := Item_Exists (N, "width");
Has_Height : constant Boolean := Item_Exists (N, "height");
Height, Width : Float;
Rect : Polygon (1 .. 4);
Poly : access Polygon;
List : Node_List;
begin
if Has_Width or else Has_Height then
Width := To_Float (Item_As_String (N, "width"));
Height := To_Float (Item_As_String (N, "height"));
Rect := ((X, Y),
(X + Width, Y),
(X + Width, Y + Height),
(X, Y + Height));
List := Get_Elements_By_Tag_Name (N, "ellipse");
if Length (List) /= 0 then
Free (List);
return (Ellipse_Shape, Rect);
else
Free (List);
return (Rectangle_Shape, Rect);
end if;
else
List := Get_Elements_By_Tag_Name (N, "polygon");
if Length (List) /= 1 then
raise Program_Error with "Invalid number of polygon elements";
end if;
Poly := To_Polygon ((X, Y),
Item_As_String (Item (List, 0), "points"));
Free (List);
return (Polygon_Shape, Poly);
end if;
end Create;
-------------------
-- Has_Collision --
-------------------
function Has_Collision (This : Collisions)
return Boolean
is (not This.List.Is_Empty);
------------
-- Create --
------------
procedure Load (This : in out Collisions;
N : DOM.Core.Node)
is
List : Node_List;
begin
List := Elements.Get_Elements_By_Tag_Name (N, "object");
for Index in 1 .. Length (List) loop
This.List.Append (Create (Item (List, Index - 1)));
end loop;
Free (List);
end Load;
--------------------
-- Inside_Ellipse --
--------------------
function Inside_Ellipse (Pt : Point;
Ellipse : Polygon)
return Boolean
is
Diag_1 : constant Geometry.Line := To_Line (Ellipse (1), Ellipse (3));
Diag_2 : constant Geometry.Line := To_Line (Ellipse (2), Ellipse (4));
Center : constant Point := Intersection (Diag_1, Diag_2);
H_Axis : constant Vector := To_Vector ((Ellipse (1), Ellipse (2)));
V_Axis : constant Vector := To_Vector ((Ellipse (2), Ellipse (3)));
H_Semi : constant Distance_Type := Length (H_Axis) / 2.0;
V_Semi : constant Distance_Type := Length (V_Axis) / 2.0;
begin
return (
((Pt.X - Center.X)**2 / H_Semi**2)
+
((Pt.Y - Center.Y)**2 / V_Semi**2)
) <= 1.0;
end Inside_Ellipse;
-------------
-- Collide --
-------------
function Collide
(This : Collisions;
X, Y : Float)
return Boolean
is
function Fixed_Inside (P : Point; Poly : Polygon) return Boolean;
function Fixed_Inside (P : Point; Poly : Polygon) return Boolean is
J : Natural := Poly'Last;
C : Boolean := False;
Deltay : Float;
begin
-- See http://www.ecse.rpi.edu/Homepages/wrf/Research
-- /Short_Notes/pnpoly.html
for S in Poly'Range loop
Deltay := P.Y - Poly (S).Y;
-- The divide below is mandatory: if you transform it into a
-- multiplication on the other side, the sign of the denominator
-- will flip the inequality, and thus make the code harder.
if ((0.0 <= Deltay and then P.Y < Poly (J).Y)
or else (Poly (J).Y <= P.Y and then Deltay < 0.0))
and then
(P.X - Poly (S).X < (Poly (J).X - Poly (S).X) * Deltay
/ (Poly (J).Y - Poly (S).Y))
then
C := not C;
end if;
J := S;
end loop;
return C;
end Fixed_Inside;
begin
for Shape of This.List loop
case Shape.Kind is
when Rectangle_Shape =>
if Fixed_Inside ((X, Y), Shape.Rect) then
return True;
end if;
when Ellipse_Shape =>
if Inside_Ellipse ((X, Y), Shape.Rect) then
return True;
end if;
when Polygon_Shape =>
if Fixed_Inside ((X, Y), Shape.Poly.all) then
return True;
end if;
end case;
end loop;
return False;
end Collide;
end TCG.Collision_Objects;
|