1 (* Copyright (C) Doom 2D: Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, version 3 of the License ONLY.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 {$INCLUDE a_modes.inc}
16 // some geometry utilities
22 // do line clipping; returns `false` if line is outside of the box
23 function clipLine (var x0
, y0
, x1
, y1
: Single; xmin
, ymin
, xmax
, ymax
: Single): Boolean;
25 // returns `true` if there is an intersection (if starting point is inside the box, it counts as intersection)
26 function lineAABBIntersects (x0
, y0
, x1
, y1
: Integer; bx
, by
, bw
, bh
: Integer): Boolean;
28 // you are not supposed to understand this
29 // returns `true` if there is an intersection, and enter coords
30 // enter coords will be equal to (x0, y0) if starting point is inside the box
31 // if result is `false`, `inx` and `iny` are undefined
32 function lineAABBIntersects (x0
, y0
, x1
, y1
: Integer; bx
, by
, bw
, bh
: Integer; out inx
, iny
: Integer): Boolean;
35 TSweepEdge
= (None
, Top
, Right
, Bottom
, Left
);
36 PSweepEdge
= ^TSweepEdge
;
38 // sweep two AABB's to see if and when they are overlapping
39 // returns `true` if collision was detected (but boxes aren't overlap)
40 // `u1` and `u1` has no sense if no collision was detected (`hitx` and `hity` either)
41 // u0 = normalized time of first collision (i.e. collision starts at myMove*u0)
42 // u1 = normalized time of second collision (i.e. collision stops after myMove*u1)
43 // hitedge for `it`: it will probably be `None` if no collision was detected, but it is not guaranteed
44 // enter/exit coords will form non-intersecting configuration (i.e. will be before/after the actual collision)
45 // but beware of floating point inexactness; `sweepAABB()` will try to (crudely) compensate for it
46 // while calculating `hitx` and `hity`.
48 function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer;
49 u0: PSingle=nil; hitedge: PSweepEdge=nil; u1: PSingle=nil;
50 hitx: PInteger=nil; hity: PInteger=nil): Boolean;
52 function sweepAABB (mex0
, mey0
, mew
, meh
: Integer; medx
, medy
: Integer; itx0
, ity0
, itw
, ith
: Integer;
53 out u0
: Single): Boolean;
55 function distanceSq (x0
, y0
, x1
, y1
: Integer): Integer; inline;
61 // ////////////////////////////////////////////////////////////////////////// //
62 function distanceSq (x0
, y0
, x1
, y1
: Integer): Integer; inline; begin result
:= (x1
-x0
)*(x1
-x0
)+(y1
-y0
)*(y1
-y0
); end;
65 // ////////////////////////////////////////////////////////////////////////// //
66 function clipLine (var x0
, y0
, x1
, y1
: Single; xmin
, ymin
, xmax
, ymax
: Single): Boolean;
74 function xcode (x
, y
: Single): Byte; inline;
77 if (x
< xmin
) then result
:= result
or Left
else if (x
> xmax
) then result
:= result
or Right
;
78 if (y
< ymin
) then result
:= result
or Bottom
else if (y
> ymax
) then result
:= result
or Top
;
82 outcode0
, outcode1
, outcodeOut
: Byte;
86 result
:= false; // accept
87 outcode0
:= xcode(x0
, y0
);
88 outcode1
:= xcode(x1
, y1
);
91 if ((outcode0
or outcode1
) = 0) then begin result
:= true; exit
; end; // accept
92 if ((outcode0
and outcode1
) <> 0) then exit
; // reject
93 outcodeOut
:= outcode0
;
94 if (outcodeOut
= 0) then outcodeOut
:= outcode1
;
95 if ((outcodeOut
and Top
) <> 0) then
97 x
:= x0
+(x1
-x0
)*(ymax
-y0
)/(y1
-y0
);
100 else if ((outcodeOut
and Bottom
) <> 0) then
102 x
:= x0
+(x1
-x0
)*(ymin
-y0
)/(y1
-y0
);
105 else if ((outcodeOut
and Right
) <> 0) then
107 y
:= y0
+(y1
-y0
)*(xmax
-x0
)/(x1
-x0
);
110 else if ((outcodeOut
and Left
) <> 0) then
112 y
:= y0
+(y1
-y0
)*(xmin
-x0
)/(x1
-x0
);
115 if (outcodeOut
= outcode0
) then
119 outcode0
:= xcode(x0
, y0
);
125 outcode1
:= xcode(x1
, y1
);
131 // returns `true` if there is an intersection (if starting point is inside the box, it counts as intersection)
132 function lineAABBIntersects (x0
, y0
, x1
, y1
: Integer; bx
, by
, bw
, bh
: Integer): Boolean;
134 sx0
, sy0
, sx1
, sy1
: Single;
137 if (bw
< 1) or (bh
< 1) then exit
;
138 if (x0
>= bx
) and (y0
>= by
) and (x0
< bx
+bw
) and (y0
< by
+bh
) then begin result
:= true; exit
; end;
139 sx0
:= x0
; sy0
:= y0
;
140 sx1
:= x1
; sy1
:= y1
;
141 result
:= clipLine(sx0
, sy0
, sx1
, sy1
, bx
, by
, bx
+bw
-1, by
+bh
-1);
145 // returns `true` if there is an intersection, and enter coords
146 // enter coords will be equal to (x0, y0) if starting point is inside the box
147 // if result is `false`, `inx` and `iny` are undefined
148 function lineAABBIntersects (x0
, y0
, x1
, y1
: Integer; bx
, by
, bw
, bh
: Integer; out inx
, iny
: Integer): Boolean;
150 sx0
, sy0
, sx1
, sy1
: Single;
155 if (bw
< 1) or (bh
< 1) then exit
;
156 if (x0
>= bx
) and (y0
>= by
) and (x0
< bx
+bw
) and (y0
< by
+bh
) then begin result
:= true; exit
; end;
157 sx0
:= x0
; sy0
:= y0
;
158 sx1
:= x1
; sy1
:= y1
;
159 result
:= clipLine(sx0
, sy0
, sx1
, sy1
, bx
, by
, bx
+bw
-1, by
+bh
-1);
165 if (inx
= bx
) then Dec(inx
) else if (inx
= bx
+bw
-1) then Inc(inx
);
166 if (iny
= by
) then Dec(iny
) else if (iny
= by
+bh
-1) then Inc(iny
);
176 // ////////////////////////////////////////////////////////////////////////// //
178 function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer;
179 u0: PSingle=nil; hitedge: PSweepEdge=nil; u1: PSingle=nil;
180 hitx: PInteger=nil; hity: PInteger=nil): Boolean;
184 function axisOverlap (me0, me1, it0, it1, d: Integer; he0, he1: TSweepEdge): Boolean; inline;
192 if (d >= 0) then exit; // oops, no hit
194 if (t > tin) then begin tin := t; hitedge^ := he1; end;
196 else if (it1 < me0) then
198 if (d <= 0) then exit; // oops, no hit
200 if (t > tin) then begin tin := t; hitedge^ := he0; end;
203 if (d < 0) and (it1 > me0) then
206 if (t < tout) then tout := t;
208 else if (d > 0) and (me1 > it0) then
211 if (t < tout) then tout := t;
218 mex1, mey1, itx1, ity1, vx, vy, ex, ey: Integer;
219 htt: TSweepEdge = TSweepEdge.None; // has no sense, who cares
222 if (u0 <> nil) then u0^ := -1.0;
223 if (u1 <> nil) then u1^ := -1.0;
224 if (hitx <> nil) then hitx^ := mex0;
225 if (hity <> nil) then hity^ := mey0;
226 if (hitedge = nil) then hitedge := @htt else hitedge^ := TSweepEdge.None;
228 if (mew < 1) or (meh < 1) or (itw < 1) or (ith < 1) then exit;
235 // check if they are overlapping right now (SAT)
236 //if (mex1 >= itx0) and (mex0 <= itx1) and (mey1 >= ity0) and (mey0 <= ity1) then begin result := true; exit; end;
238 if (medx = 0) and (medy = 0) then exit; // both boxes are sationary
240 // treat b as stationary, so invert v to get relative velocity
247 if not axisOverlap(mex0, mex1, itx0, itx1, vx, TSweepEdge.Right, TSweepEdge.Left) then exit;
248 if not axisOverlap(mey0, mey1, ity0, ity1, vy, TSweepEdge.Bottom, TSweepEdge.Top) then exit;
250 if (u0 <> nil) then u0^ := tin;
251 if (u1 <> nil) then u1^ := tout;
253 if (tin <= tout) and (tin >= 0.0) and (tin <= 1.0) then
256 if (hitx <> nil) or (hity <> nil) then
258 ex := mex0+round(medx*tin);
259 ey := mey0+round(medy*tin);
260 // just in case, compensate for floating point inexactness
261 if (ex >= itx0) and (ey >= ity0) and (ex < itx0+itw) and (ey < ity0+ith) then
263 ex := mex0+trunc(medx*tin);
264 ey := mey0+trunc(medy*tin);
266 if (hitx <> nil) then hitx^ := ex;
267 if (hity <> nil) then hity^ := ey;
273 function sweepAABB (mex0
, mey0
, mew
, meh
: Integer; medx
, medy
: Integer; itx0
, ity0
, itw
, ith
: Integer;
274 out u0
: Single): Boolean;
278 function axisOverlap (me0
, me1
, it0
, it1
, d
: Integer): Boolean; inline;
286 exit
; // oops, no hit
287 t
:= (me1
- it0
+ 1) / d
;
291 else if it1
< me0
then
294 exit
; // oops, no hit
295 t
:= (me0
- it1
- 1) / d
;
300 if (d
< 0) and (it1
> me0
) then
302 t
:= (me0
- it1
- 1) / d
;
306 else if (d
> 0) and (me1
> it0
) then
308 t
:= (me1
- it0
+ 1) / d
;
320 if (mew
>= 1) and (meh
>= 1) and (itw
>= 1) and (ith
>= 1) and ((medx
<> 0) or (medy
<> 0)) then
324 if axisOverlap(mex0
, mex0
+ mew
- 1, itx0
, itx0
+ itw
- 1, -medx
) then
326 if axisOverlap(mey0
, mey0
+ meh
- 1, ity0
, ity0
+ ith
- 1, -medy
) then
329 Result
:= (tin
<= tout
) and (tin
>= 0.0) and (tin
<= 1.0);