From 2d5c517f0d38a9f31e8e780416269ea787852930 Mon Sep 17 00:00:00 2001 From: Ketmar Dark Date: Tue, 19 Sep 2017 04:37:37 +0300 Subject: [PATCH] moved some geometry functions to shared/geom.pas; TODO: move most of g_basic.pas there --- src/game/Doom2DF.dpr | 1 + src/game/g_basic.pas | 7 +- src/game/g_grid.pas | 199 +----------------------------- src/game/g_holmes.pas | 2 +- src/game/g_panel.pas | 2 +- src/game/g_weapons.pas | 2 +- src/shared/geom.pas | 269 +++++++++++++++++++++++++++++++++++++++++ 7 files changed, 280 insertions(+), 202 deletions(-) create mode 100644 src/shared/geom.pas diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr index 0202340..53d66f1 100644 --- a/src/game/Doom2DF.dpr +++ b/src/game/Doom2DF.dpr @@ -41,6 +41,7 @@ program Doom2DF; uses mempool in '../shared/mempool.pas', conbuf in '../shared/conbuf.pas', + geom in '../shared/geom.pas', math, GL, GLExt, diff --git a/src/game/g_basic.pas b/src/game/g_basic.pas index e9412a3..f6653a3 100644 --- a/src/game/g_basic.pas +++ b/src/game/g_basic.pas @@ -95,7 +95,7 @@ var implementation uses - Math, e_log, g_map, g_gfx, g_player, SysUtils, MAPDEF, + Math, geom, e_log, g_map, g_gfx, g_player, SysUtils, MAPDEF, StrUtils, e_graphics, g_monsters, g_items, g_game; function g_PatchLength(X1, Y1, X2, Y2: Integer): Word; @@ -559,13 +559,17 @@ begin end;} function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean; +{ var i: Integer; dx, dy: Integer; Xerr, Yerr: Integer; incX, incY: Integer; x, y, d: Integer; +} begin + result := lineAABBIntersects(x1, y1, x2, y2, rX, rY, rWidth, rHeight); +{ Result := True; Xerr := 0; @@ -604,6 +608,7 @@ begin end; Result := False; +} end; function GetStr(var Str: string): string; diff --git a/src/game/g_grid.pas b/src/game/g_grid.pas index 427482f..5ef72f2 100644 --- a/src/game/g_grid.pas +++ b/src/game/g_grid.pas @@ -289,24 +289,6 @@ type end; -// you are not supposed to understand this -// returns `true` if there is an intersection, and enter coords -// enter coords will be equal to (x0, y0) if starting point is inside the box -// if result is `false`, `inx` and `iny` are undefined -function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean; - -// sweep two AABB's to see if and when they are overlapping -// returns `true` if collision was detected (but boxes doesn't overlap) -// u1 and u1 has no sense if no collision was detected -// u0 = normalized time of first collision (i.e. collision starts at myMove*u0) -// u1 = normalized time of second collision (i.e. collision stops after myMove*u1) -// hitedge for `it`: 0: top; 1: right; 2: bottom; 3: left -// enter/exit coords will form non-intersecting configuration (i.e. will be before/after the actual collision) -function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer; - u0: PSingle=nil; hitedge: PInteger=nil; u1: PSingle=nil): Boolean; - -function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; - procedure swapInt (var a: Integer; var b: Integer); inline; //function minInt (a, b: Integer): Integer; inline; //function maxInt (a, b: Integer): Integer; inline; @@ -315,7 +297,7 @@ procedure swapInt (var a: Integer; var b: Integer); inline; implementation uses - SysUtils, e_log, g_console, utils; + SysUtils, e_log, g_console, geom, utils; // ////////////////////////////////////////////////////////////////////////// // @@ -324,105 +306,6 @@ procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begi //function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end; //function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end; -function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end; - - -// ////////////////////////////////////////////////////////////////////////// // -function clipLine (var x0, y0, x1, y1: Single; xmin, ymin, xmax, ymax: Single): Boolean; -const - Inside = 0; - Left = 1; - Right = 2; - Bottom = 4; - Top = 8; - - function xcode (x, y: Single): Byte; inline; - begin - result := Inside; - if (x < xmin) then result := result or Left else if (x > xmax) then result := result or Right; - if (y < ymin) then result := result or Bottom else if (y > ymax) then result := result or Top; - end; - -var - outcode0, outcode1, outcodeOut: Byte; - x: Single = 0; - y: Single = 0; -begin - result := false; // accept - outcode0 := xcode(x0, y0); - outcode1 := xcode(x1, y1); - while true do - begin - if ((outcode0 or outcode1) = 0) then begin result := true; exit; end; // accept - if ((outcode0 and outcode1) <> 0) then exit; // reject - outcodeOut := outcode0; - if (outcodeOut = 0) then outcodeOut := outcode1; - if ((outcodeOut and Top) <> 0) then - begin - x := x0+(x1-x0)*(ymax-y0)/(y1-y0); - y := ymax; - end - else if ((outcodeOut and Bottom) <> 0) then - begin - x := x0+(x1-x0)*(ymin-y0)/(y1-y0); - y := ymin; - end - else if ((outcodeOut and Right) <> 0) then - begin - y := y0+(y1-y0)*(xmax-x0)/(x1-x0); - x := xmax; - end - else if ((outcodeOut and Left) <> 0) then - begin - y := y0+(y1-y0)*(xmin-x0)/(x1-x0); - x := xmin; - end; - if (outcodeOut = outcode0) then - begin - x0 := x; - y0 := y; - outcode0 := xcode(x0, y0); - end - else - begin - x1 := x; - y1 := y; - outcode1 := xcode(x1, y1); - end; - end; -end; - - -// returns `true` if there is an intersection, and enter coords -// enter coords will be equal to (x0, y0) if starting point is inside the box -// if result is `false`, `inx` and `iny` are undefined -function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean; -var - sx0, sy0, sx1, sy1: Single; -begin - inx := x0; - iny := y0; - result := false; - if (bw < 1) or (bh < 1) then exit; - if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end; - sx0 := x0; sy0 := y0; - sx1 := x1; sy1 := y1; - result := clipLine(sx0, sy0, sx1, sy1, bx, by, bx+bw-1, by+bh-1); - if result then - begin - inx := trunc(sx0); - iny := trunc(sy0); - // hack! - if (inx = bx) then Dec(inx) else if (inx = bx+bw-1) then Inc(inx); - if (iny = by) then Dec(iny) else if (iny = by+bh-1) then Inc(iny); - end - else - begin - inx := x1; - iny := y1; - end; -end; - // ////////////////////////////////////////////////////////////////////////// // constructor TLineWalker.Create (minx, miny, maxx, maxy: Integer); @@ -660,86 +543,6 @@ end; procedure TLineWalker.getXY (out ox, oy: Integer); inline; begin ox := xd; oy := yd; end; -// ////////////////////////////////////////////////////////////////////////// // -function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer; - u0: PSingle=nil; hitedge: PInteger=nil; u1: PSingle=nil): Boolean; -var - tin, tout: Single; - - function axisOverlap (me0, me1, it0, it1, d, he0, he1: Integer): Boolean; inline; - var - t: Single; - begin - result := false; - - if (me1 < it0) then - begin - if (d >= 0) then exit; // oops, no hit - t := (me1-it0+1)/d; - if (t > tin) then begin tin := t; hitedge^ := he1; end; - end - else if (it1 < me0) then - begin - if (d <= 0) then exit; // oops, no hit - t := (me0-it1-1)/d; - if (t > tin) then begin tin := t; hitedge^ := he0; end; - end; - - if (d < 0) and (it1 > me0) then - begin - t := (me0-it1-1)/d; - if (t < tout) then tout := t; - end - else if (d > 0) and (me1 > it0) then - begin - t := (me1-it0+1)/d; - if (t < tout) then tout := t; - end; - - result := true; - end; - -var - mex1, mey1, itx1, ity1, vx, vy: Integer; - htt: Integer = -1; -begin - result := false; - if (u0 <> nil) then u0^ := -1.0; - if (u1 <> nil) then u1^ := -1.0; - if (hitedge = nil) then hitedge := @htt else hitedge^ := -1; - - if (mew < 1) or (meh < 1) or (itw < 1) or (ith < 1) then exit; - - mex1 := mex0+mew-1; - mey1 := mey0+meh-1; - itx1 := itx0+itw-1; - ity1 := ity0+ith-1; - - // check if they are overlapping right now (SAT) - //if (mex1 >= itx0) and (mex0 <= itx1) and (mey1 >= ity0) and (mey0 <= ity1) then begin result := true; exit; end; - - if (medx = 0) and (medy = 0) then exit; // both boxes are sationary - - // treat b as stationary, so invert v to get relative velocity - vx := -medx; - vy := -medy; - - tin := -100000000.0; - tout := 100000000.0; - - if not axisOverlap(mex0, mex1, itx0, itx1, vx, 1, 3) then exit; - if not axisOverlap(mey0, mey1, ity0, ity1, vy, 2, 0) then exit; - - if (u0 <> nil) then u0^ := tin; - if (u1 <> nil) then u1^ := tout; - - if (tin <= tout) and (tin >= 0.0) and (tin <= 1.0) then - begin - result := true; - end; -end; - - // ////////////////////////////////////////////////////////////////////////// // procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer); begin diff --git a/src/game/g_holmes.pas b/src/game/g_holmes.pas index 165b848..33af326 100644 --- a/src/game/g_holmes.pas +++ b/src/game/g_holmes.pas @@ -19,7 +19,7 @@ unit g_holmes; interface uses - mempool, + mempool, geom, e_log, e_input, g_textures, g_basic, e_graphics, g_phys, g_grid, g_player, g_monsters, g_window, g_map, g_triggers, g_items, g_game, g_panel, g_console, g_gfx, diff --git a/src/game/g_panel.pas b/src/game/g_panel.pas index 2ff9af5..f5a6bdd 100644 --- a/src/game/g_panel.pas +++ b/src/game/g_panel.pas @@ -210,7 +210,7 @@ implementation uses e_texture, g_basic, g_map, g_game, g_gfx, e_graphics, g_weapons, g_triggers, - g_console, g_language, g_monsters, g_player, g_grid, e_log, GL, utils, xstreams; + g_console, g_language, g_monsters, g_player, g_grid, e_log, GL, geom, utils, xstreams; const PANEL_SIGNATURE = $4C4E4150; // 'PANL' diff --git a/src/game/g_weapons.pas b/src/game/g_weapons.pas index 311b18c..3d8b2e9 100644 --- a/src/game/g_weapons.pas +++ b/src/game/g_weapons.pas @@ -118,7 +118,7 @@ uses g_console, g_options, g_game, g_triggers, MAPDEF, e_log, g_monsters, g_saveload, g_language, g_netmsg, g_grid, - binheap, hashtable, utils, xstreams; + geom, binheap, hashtable, utils, xstreams; type TWaterPanel = record diff --git a/src/shared/geom.pas b/src/shared/geom.pas new file mode 100644 index 0000000..32b0ad0 --- /dev/null +++ b/src/shared/geom.pas @@ -0,0 +1,269 @@ +(* Copyright (C) DooM 2D:Forever Developers + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) +{$INCLUDE a_modes.inc} +// some geometry utilities +unit geom; + +interface + + +// do line clipping; returns `false` if line is outside of the box +function clipLine (var x0, y0, x1, y1: Single; xmin, ymin, xmax, ymax: Single): Boolean; + +// returns `true` if there is an intersection (if starting point is inside the box, it counts as intersection) +function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer): Boolean; + +// you are not supposed to understand this +// returns `true` if there is an intersection, and enter coords +// enter coords will be equal to (x0, y0) if starting point is inside the box +// if result is `false`, `inx` and `iny` are undefined +function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean; + +type + TSweepEdge = (None, Top, Right, Bottom, Left); + PSweepEdge = ^TSweepEdge; + +// sweep two AABB's to see if and when they are overlapping +// returns `true` if collision was detected (but boxes aren't overlap) +// `u1` and `u1` has no sense if no collision was detected (`hitx` and `hity` either) +// u0 = normalized time of first collision (i.e. collision starts at myMove*u0) +// u1 = normalized time of second collision (i.e. collision stops after myMove*u1) +// hitedge for `it`: it will probably be `None` if no collision was detected, but it is not guaranteed +// enter/exit coords will form non-intersecting configuration (i.e. will be before/after the actual collision) +// but beware of floating point inexactness; `sweepAABB()` will try to (crudely) compensate for it +// while calculating `hitx` and `hity`. +function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer; + u0: PSingle=nil; hitedge: PSweepEdge=nil; u1: PSingle=nil; + hitx: PInteger=nil; hity: PInteger=nil): Boolean; + +function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; + + +implementation + + +// ////////////////////////////////////////////////////////////////////////// // +function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end; + + +// ////////////////////////////////////////////////////////////////////////// // +function clipLine (var x0, y0, x1, y1: Single; xmin, ymin, xmax, ymax: Single): Boolean; +const + Inside = 0; + Left = 1; + Right = 2; + Bottom = 4; + Top = 8; + + function xcode (x, y: Single): Byte; inline; + begin + result := Inside; + if (x < xmin) then result := result or Left else if (x > xmax) then result := result or Right; + if (y < ymin) then result := result or Bottom else if (y > ymax) then result := result or Top; + end; + +var + outcode0, outcode1, outcodeOut: Byte; + x: Single = 0; + y: Single = 0; +begin + result := false; // accept + outcode0 := xcode(x0, y0); + outcode1 := xcode(x1, y1); + while true do + begin + if ((outcode0 or outcode1) = 0) then begin result := true; exit; end; // accept + if ((outcode0 and outcode1) <> 0) then exit; // reject + outcodeOut := outcode0; + if (outcodeOut = 0) then outcodeOut := outcode1; + if ((outcodeOut and Top) <> 0) then + begin + x := x0+(x1-x0)*(ymax-y0)/(y1-y0); + y := ymax; + end + else if ((outcodeOut and Bottom) <> 0) then + begin + x := x0+(x1-x0)*(ymin-y0)/(y1-y0); + y := ymin; + end + else if ((outcodeOut and Right) <> 0) then + begin + y := y0+(y1-y0)*(xmax-x0)/(x1-x0); + x := xmax; + end + else if ((outcodeOut and Left) <> 0) then + begin + y := y0+(y1-y0)*(xmin-x0)/(x1-x0); + x := xmin; + end; + if (outcodeOut = outcode0) then + begin + x0 := x; + y0 := y; + outcode0 := xcode(x0, y0); + end + else + begin + x1 := x; + y1 := y; + outcode1 := xcode(x1, y1); + end; + end; +end; + + +// returns `true` if there is an intersection (if starting point is inside the box, it counts as intersection) +function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer): Boolean; +var + sx0, sy0, sx1, sy1: Single; +begin + result := false; + if (bw < 1) or (bh < 1) then exit; + if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end; + sx0 := x0; sy0 := y0; + sx1 := x1; sy1 := y1; + result := clipLine(sx0, sy0, sx1, sy1, bx, by, bx+bw-1, by+bh-1); +end; + + +// returns `true` if there is an intersection, and enter coords +// enter coords will be equal to (x0, y0) if starting point is inside the box +// if result is `false`, `inx` and `iny` are undefined +function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean; +var + sx0, sy0, sx1, sy1: Single; +begin + inx := x0; + iny := y0; + result := false; + if (bw < 1) or (bh < 1) then exit; + if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end; + sx0 := x0; sy0 := y0; + sx1 := x1; sy1 := y1; + result := clipLine(sx0, sy0, sx1, sy1, bx, by, bx+bw-1, by+bh-1); + if result then + begin + inx := trunc(sx0); + iny := trunc(sy0); + // hack! + if (inx = bx) then Dec(inx) else if (inx = bx+bw-1) then Inc(inx); + if (iny = by) then Dec(iny) else if (iny = by+bh-1) then Inc(iny); + end + else + begin + inx := x1; + iny := y1; + end; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer; + u0: PSingle=nil; hitedge: PSweepEdge=nil; u1: PSingle=nil; + hitx: PInteger=nil; hity: PInteger=nil): Boolean; +var + tin, tout: Single; + + function axisOverlap (me0, me1, it0, it1, d: Integer; he0, he1: TSweepEdge): Boolean; inline; + var + t: Single; + begin + result := false; + + if (me1 < it0) then + begin + if (d >= 0) then exit; // oops, no hit + t := (me1-it0+1)/d; + if (t > tin) then begin tin := t; hitedge^ := he1; end; + end + else if (it1 < me0) then + begin + if (d <= 0) then exit; // oops, no hit + t := (me0-it1-1)/d; + if (t > tin) then begin tin := t; hitedge^ := he0; end; + end; + + if (d < 0) and (it1 > me0) then + begin + t := (me0-it1-1)/d; + if (t < tout) then tout := t; + end + else if (d > 0) and (me1 > it0) then + begin + t := (me1-it0+1)/d; + if (t < tout) then tout := t; + end; + + result := true; + end; + +var + mex1, mey1, itx1, ity1, vx, vy, ex, ey: Integer; + htt: TSweepEdge = TSweepEdge.None; // has no sense, who cares +begin + result := false; + if (u0 <> nil) then u0^ := -1.0; + if (u1 <> nil) then u1^ := -1.0; + if (hitx <> nil) then hitx^ := mex0; + if (hity <> nil) then hity^ := mey0; + if (hitedge = nil) then hitedge := @htt else hitedge^ := TSweepEdge.None; + + if (mew < 1) or (meh < 1) or (itw < 1) or (ith < 1) then exit; + + mex1 := mex0+mew-1; + mey1 := mey0+meh-1; + itx1 := itx0+itw-1; + ity1 := ity0+ith-1; + + // check if they are overlapping right now (SAT) + //if (mex1 >= itx0) and (mex0 <= itx1) and (mey1 >= ity0) and (mey0 <= ity1) then begin result := true; exit; end; + + if (medx = 0) and (medy = 0) then exit; // both boxes are sationary + + // treat b as stationary, so invert v to get relative velocity + vx := -medx; + vy := -medy; + + tin := -100000000.0; + tout := 100000000.0; + + if not axisOverlap(mex0, mex1, itx0, itx1, vx, TSweepEdge.Right, TSweepEdge.Left) then exit; + if not axisOverlap(mey0, mey1, ity0, ity1, vy, TSweepEdge.Bottom, TSweepEdge.Top) then exit; + + if (u0 <> nil) then u0^ := tin; + if (u1 <> nil) then u1^ := tout; + + if (tin <= tout) and (tin >= 0.0) and (tin <= 1.0) then + begin + result := true; + if (hitx <> nil) or (hity <> nil) then + begin + ex := mex0+round(medx*tin); + ey := mey0+round(medy*tin); + // just in case, compensate for floating point inexactness + if (ex >= itx0) and (ey >= ity0) and (ex < itx0+itw) and (ey < ity0+ith) then + begin + ex := mex0+trunc(medx*tin); + ey := mey0+trunc(medy*tin); + end; + if (hitx <> nil) then hitx^ := ex; + if (hity <> nil) then hity^ := ey; + end; + end; +end; + + +end. -- 2.29.2