From 082b546b38711030b4490facbefa37a331cb1a37 Mon Sep 17 00:00:00 2001 From: Ketmar Dark Date: Tue, 22 Aug 2017 20:16:22 +0300 Subject: [PATCH] removed all mentions of dynaabb tree from the sources; WARNING! EVERYTHING IS BROKEN! --- src/engine/e_graphics.pas | 4 +- src/game/Doom2DF.dpr | 1 - src/game/g_grid.pas | 300 +++++- src/game/g_items.pas | 92 +- src/game/g_map.pas | 158 +--- src/game/g_monsters.pas | 139 ++- src/game/g_netmaster.pas | 8 +- src/game/g_player.pas | 17 +- src/game/g_textures.pas | 8 +- src/game/g_weapons.pas | 334 +------ src/game/z_aabbtree.pas | 1822 ------------------------------------- src/shared/a_modes.inc | 2 + 12 files changed, 404 insertions(+), 2481 deletions(-) delete mode 100644 src/game/z_aabbtree.pas diff --git a/src/engine/e_graphics.pas b/src/engine/e_graphics.pas index c232759..59f848b 100644 --- a/src/engine/e_graphics.pas +++ b/src/engine/e_graphics.pas @@ -110,7 +110,7 @@ procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD); procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green, Blue: Byte; Scale: Single; Shadow: Boolean = False); procedure e_TextureFontPrintFmt(X, Y: GLint; Text: string; FontID: DWORD; Shadow: Boolean = False); -procedure e_TextureFontGetSize(ID: DWORD; var CharWidth, CharHeight: Byte); +procedure e_TextureFontGetSize(ID: DWORD; out CharWidth, CharHeight: Byte); procedure e_RemoveAllTextureFont(); function e_TextureFontCharWidth (ch: Char; FontID: DWORD): Integer; @@ -1596,7 +1596,7 @@ begin glDisable(GL_BLEND); end; -procedure e_TextureFontGetSize(ID: DWORD; var CharWidth, CharHeight: Byte); +procedure e_TextureFontGetSize(ID: DWORD; out CharWidth, CharHeight: Byte); begin CharWidth := 16; CharHeight := 16; diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr index 1341a79..18ab86f 100644 --- a/src/game/Doom2DF.dpr +++ b/src/game/Doom2DF.dpr @@ -71,7 +71,6 @@ uses g_netmaster in 'g_netmaster.pas', g_res_downloader in 'g_res_downloader.pas', g_grid in 'g_grid.pas', - z_aabbtree in 'z_aabbtree.pas', g_game in 'g_game.pas', g_gfx in 'g_gfx.pas', g_gui in 'g_gui.pas', diff --git a/src/game/g_grid.pas b/src/game/g_grid.pas index e45fede..f5667d3 100644 --- a/src/game/g_grid.pas +++ b/src/game/g_grid.pas @@ -77,7 +77,7 @@ type mProxyMaxCount: Integer; private - function allocCell: Integer; + function allocCell (): Integer; procedure freeCell (idx: Integer); // `next` is simply overwritten function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId; @@ -94,12 +94,15 @@ type function getProxyEnabled (pid: TBodyProxyId): Boolean; inline; procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline; + function getGridWidthPx (): Integer; inline; + function getGridHeightPx (): Integer; inline; + public constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize}); destructor Destroy (); override; function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId; - procedure removeBody (aObj: TBodyProxyId); // WARNING! this WILL destroy proxy! + procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy! procedure moveBody (body: TBodyProxyId; dx, dy: Integer); procedure resizeBody (body: TBodyProxyId; sx, sy: Integer); @@ -107,6 +110,9 @@ type function insideGrid (x, y: Integer): Boolean; inline; + // `false` if `body` is surely invalid + function getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline; + //WARNING: don't modify grid while any query is in progress (no checks are made!) // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it) // no callback: return `true` on the first hit @@ -128,15 +134,186 @@ type //WARNING! no sanity checks! property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled; + + property gridX0: Integer read mMinX; + property gridY0: Integer read mMinY; + property gridWidth: Integer read getGridWidthPx; // in pixels + property gridHeight: Integer read getGridHeightPx; // in pixels end; +procedure swapInt (var a: Integer; var b: Integer); inline; + + implementation uses SysUtils, e_log; +// ////////////////////////////////////////////////////////////////////////// // +procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; 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; +var + wx0, wy0, wx1, wy1: Integer; // window coordinates + stx, sty: Integer; // "steps" for x and y axes + dsx, dsy: Integer; // "lengthes" for x and y axes + dx2, dy2: Integer; // "double lengthes" for x and y axes + xd, yd: Integer; // current coord + e: Integer; // "error" (as in bresenham algo) + rem: Integer; + term: Integer; + d0, d1: PInteger; + xfixed: Boolean; + temp: Integer; +begin + result := false; + // why not + inx := x0; + iny := y0; + if (bw < 1) or (bh < 1) then exit; // impossible box + + if (x0 = x1) and (y0 = y1) then + begin + // check this point + result := (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh); + exit; + end; + + // check if staring point is inside the box + if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end; + + // clip rectange + wx0 := bx; + wy0 := by; + wx1 := bx+bw-1; + wy1 := by+bh-1; + + // horizontal setup + if (x0 < x1) then + begin + // from left to right + if (x0 > wx1) or (x1 < wx0) then exit; // out of screen + stx := 1; // going right + end + else + begin + // from right to left + if (x1 > wx1) or (x0 < wx0) then exit; // out of screen + stx := -1; // going left + x0 := -x0; + x1 := -x1; + wx0 := -wx0; + wx1 := -wx1; + swapInt(wx0, wx1); + end; + + // vertical setup + if (y0 < y1) then + begin + // from top to bottom + if (y0 > wy1) or (y1 < wy0) then exit; // out of screen + sty := 1; // going down + end + else + begin + // from bottom to top + if (y1 > wy1) or (y0 < wy0) then exit; // out of screen + sty := -1; // going up + y0 := -y0; + y1 := -y1; + wy0 := -wy0; + wy1 := -wy1; + swapInt(wy0, wy1); + end; + + dsx := x1-x0; + dsy := y1-y0; + + if (dsx < dsy) then + begin + d0 := @yd; + d1 := @xd; + swapInt(x0, y0); + swapInt(x1, y1); + swapInt(dsx, dsy); + swapInt(wx0, wy0); + swapInt(wx1, wy1); + swapInt(stx, sty); + end + else + begin + d0 := @xd; + d1 := @yd; + end; + + dx2 := 2*dsx; + dy2 := 2*dsy; + xd := x0; + yd := y0; + e := 2*dsy-dsx; + term := x1; + + xfixed := false; + if (y0 < wy0) then + begin + // clip at top + temp := dx2*(wy0-y0)-dsx; + xd += temp div dy2; + rem := temp mod dy2; + if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do + if (xd+1 >= wx0) then + begin + yd := wy0; + e -= rem+dsx; + if (rem > 0) then begin Inc(xd); e += dy2; end; + xfixed := true; + end; + end; + + if (not xfixed) and (x0 < wx0) then + begin + // clip at left + temp := dy2*(wx0-x0); + yd += temp div dx2; + rem := temp mod dx2; + if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit; + xd := wx0; + e += rem; + if (rem >= dsx) then begin Inc(yd); e -= dx2; end; + end; + + if (y1 > wy1) then + begin + // clip at bottom + temp := dx2*(wy1-y0)+dsx; + term := x0+temp div dy2; + rem := temp mod dy2; + if (rem = 0) then Dec(term); + end; + + if (term > wx1) then term := wx1; // clip at right + + Inc(term); // draw last point + //if (term = xd) then exit; // this is the only point, get out of here + + if (sty = -1) then yd := -yd; + if (stx = -1) then begin xd := -xd; term := -term; end; + dx2 -= dy2; + + inx := d0^; + iny := d1^; + result := true; +end; + + // ////////////////////////////////////////////////////////////////////////// // procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer); begin @@ -201,6 +378,7 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // procedure TBodyGridBase.dumpStats (); var idx, mcb, cidx, cnt: Integer; @@ -221,6 +399,11 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // +function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end; +function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end; + + function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline; begin // fix coords @@ -230,6 +413,23 @@ begin end; +function TBodyGridBase.getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline; +begin + if (body >= 0) and (body < Length(mProxies)) then + begin + with mProxies[body] do begin rx := mX; ry := mY; end; + result := true; + end + else + begin + rx := 0; + ry := 0; + result := false; + end; +end; + + +// ////////////////////////////////////////////////////////////////////////// // function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline; begin if (pid >= 0) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false; @@ -252,7 +452,8 @@ begin end; -function TBodyGridBase.allocCell: Integer; +// ////////////////////////////////////////////////////////////////////////// // +function TBodyGridBase.allocCell (): Integer; var idx: Integer; begin @@ -290,6 +491,7 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId; var olen, idx: Integer; @@ -328,6 +530,7 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean; const tsize = mTileSize; @@ -361,6 +564,7 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean; var cidx: Integer; @@ -464,6 +668,7 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId; begin aTag := aTag and TagFullMask; @@ -472,37 +677,99 @@ begin end; -procedure TBodyGridBase.removeBody (aObj: TBodyProxyId); +procedure TBodyGridBase.removeBody (body: TBodyProxyId); begin - if (aObj < 0) or (aObj > High(mProxies)) then exit; // just in case - removeInternal(aObj); - freeProxy(aObj); + if (body < 0) or (body > High(mProxies)) then exit; // just in case + removeInternal(body); + freeProxy(body); end; +// ////////////////////////////////////////////////////////////////////////// // procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer); var px: PBodyProxyRec; + x0, y0, w, h: Integer; begin if (body < 0) or (body > High(mProxies)) then exit; // just in case - if ((dx = 0) and (dy = 0) and (sx = 0) and (sy = 0)) then exit; - removeInternal(body); + if (dx = 0) and (dy = 0) and (sx = 0) and (sy = 0) then exit; px := @mProxies[body]; - Inc(px.mX, dx); - Inc(px.mY, dy); - Inc(px.mWidth, sx); - Inc(px.mHeight, sy); - insertInternal(body); + x0 := px.mX; + y0 := px.mY; + w := px.mWidth; + h := px.mHeight; + // did any corner crossed tile boundary? + if (x0 div mTileSize <> (x0+dx) div mTileSize) or + (y0 div mTileSize <> (y0+dx) div mTileSize) or + ((x0+w) div mTileSize <> (x0+w+sx) div mTileSize) or + ((y0+h) div mTileSize <> (y0+h+sy) div mTileSize) then + begin + removeInternal(body); + Inc(px.mX, dx); + Inc(px.mY, dy); + Inc(px.mWidth, sx); + Inc(px.mHeight, sy); + insertInternal(body); + end + else + begin + Inc(px.mX, dx); + Inc(px.mY, dy); + Inc(px.mWidth, sx); + Inc(px.mHeight, sy); + end; end; procedure TBodyGridBase.moveBody (body: TBodyProxyId; dx, dy: Integer); +var + px: PBodyProxyRec; + nx, ny: Integer; begin - moveResizeBody(body, dx, dy, 0, 0); + if (body < 0) or (body > High(mProxies)) then exit; // just in case + if (dx = 0) and (dy = 0) then exit; + // check if tile coords was changed + px := @mProxies[body]; + nx := px.mX+dx; + ny := px.mY+dy; + if (nx div mTileSize <> px.mX div mTileSize) or (ny div mTileSize <> px.mY div mTileSize) then + begin + // crossed tile boundary, do heavy work + moveResizeBody(body, dx, dy, 0, 0); + end + else + begin + // nothing to do with the grid, just fix coordinates + px.mX := nx; + px.mY := ny; + end; end; procedure TBodyGridBase.resizeBody (body: TBodyProxyId; sx, sy: Integer); +var + px: PBodyProxyRec; + x0, y0: Integer; + nw, nh: Integer; begin - moveResizeBody(body, 0, 0, sx, sy); + if (body < 0) or (body > High(mProxies)) then exit; // just in case + if (sx = 0) and (sy = 0) then exit; + // check if tile coords was changed + px := @mProxies[body]; + x0 := px.mX; + y0 := px.mY; + nw := px.mWidth+sx; + nh := px.mHeight+sy; + if ((x0+px.mWidth) div mTileSize <> (x0+nw) div mTileSize) or + ((y0+px.mHeight) div mTileSize <> (y0+nh) div mTileSize) then + begin + // crossed tile boundary, do heavy work + moveResizeBody(body, 0, 0, sx, sy); + end + else + begin + // nothing to do with the grid, just fix size + px.mWidth := nw; + px.mHeight := nh; + end; end; @@ -571,6 +838,7 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // // no callback: return `true` on the first hit function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP; const diff --git a/src/game/g_items.pas b/src/game/g_items.pas index eb122d8..27dbc75 100644 --- a/src/game/g_items.pas +++ b/src/game/g_items.pas @@ -86,7 +86,7 @@ uses g_basic, e_graphics, g_sound, g_main, g_gfx, g_map, Math, g_game, g_triggers, g_console, SysUtils, g_player, g_net, g_netmsg, e_log, - g_grid, z_aabbtree, binheap; + g_grid, binheap; var @@ -94,32 +94,7 @@ var // ////////////////////////////////////////////////////////////////////////// // -{ -type - TDynAABBTreeItemBase = specialize TDynAABBTreeBase; - - TDynAABBTreeItem = class(TDynAABBTreeItemBase) - function getFleshAABB (out aabb: AABB2D; flesh: Integer; tag: Integer): Boolean; override; - end; - -function TDynAABBTreeItem.getFleshAABB (out aabb: AABB2D; flesh: Integer; tag: Integer): Boolean; var - it: PItem; -begin - result := false; - if (flesh < 0) or (flesh > High(ggItems)) then raise Exception.Create('DynTree: trying to get dimensions of inexistant item'); - it := @ggItems[flesh]; - if (it.Obj.Rect.Width < 1) or (it.Obj.Rect.Height < 1) then exit; - aabb := AABB2D.Create(it.Obj.X, it.Obj.Y, it.Obj.X+it.Obj.Rect.Width-1, it.Obj.Y+it.Obj.Rect.Height-1); - if not aabb.valid then raise Exception.Create('wutafuuuuuuu?!'); - result := true; -end; -} - - -// ////////////////////////////////////////////////////////////////////////// // -var - //itemTree: TDynAABBTreeItem = nil; freeIds: TBinaryHeapInt = nil; // free item ids @@ -128,7 +103,6 @@ function g_Items_ValidId (idx: Integer): Boolean; inline; begin result := false; if (idx < 0) or (idx > High(ggItems)) then exit; - //if (ggItems[idx].treeNode = -1) then exit; if not ggItems[idx].slotIsUsed then exit; result := true; end; @@ -138,7 +112,6 @@ function g_Items_ByIdx (idx: Integer): PItem; begin if (idx < 0) or (idx > High(ggItems)) then raise Exception.Create('g_ItemObjByIdx: invalid index'); result := @ggItems[idx]; - //if (result.treeNode = -1) then raise Exception.Create('g_ItemObjByIdx: requested inexistent item'); if not result.slotIsUsed then raise Exception.Create('g_ItemObjByIdx: requested inexistent item'); end; @@ -146,7 +119,6 @@ end; function g_Items_ObjByIdx (idx: Integer): PObj; begin if (idx < 0) or (idx > High(ggItems)) then raise Exception.Create('g_ItemObjByIdx: invalid index'); - //if (ggItems[idx].treeNode = -1) then raise Exception.Create('g_ItemObjByIdx: requested inexistent item'); if not ggItems[idx].slotIsUsed then raise Exception.Create('g_ItemObjByIdx: requested inexistent item'); result := @ggItems[idx].Obj; end; @@ -154,37 +126,7 @@ end; // ////////////////////////////////////////////////////////////////////////// // procedure TItem.positionChanged (); -//var -// x, y: Integer; begin - (* - if (treeNode = -1) then - begin - treeNode := itemTree.insertObject(arrIdx, 0, true); // static object - {$IF DEFINED(D2F_DEBUG)} - itemTree.getNodeXY(treeNode, x, y); - e_WriteLog(Format('item #%d: inserted into the tree; nodeid=%d; x=%d; y=%d', [arrIdx, treeNode, x, y]), MSG_NOTIFY); - {$ENDIF} - end - else - begin - itemTree.getNodeXY(treeNode, x, y); - if (Obj.X = x) and (Obj.Y = y) then exit; // nothing to do - {$IF DEFINED(D2F_DEBUG)}e_WriteLog(Format('item #%d: updating tree; nodeid=%d; x=%d; y=%d', [arrIdx, treeNode, x, y]), MSG_NOTIFY);{$ENDIF} - - {$IFDEF TRUE} - itemTree.updateObject(treeNode); - {$ELSE} - itemTree.removeObject(treeNode); - treeNode := itemTree.insertObject(arrIdx, 0, true); // static object - {$ENDIF} - - {$IF DEFINED(D2F_DEBUG)} - itemTree.getNodeXY(treeNode, x, y); - e_WriteLog(Format('item #%d: updated tree; nodeid=%d; x=%d; y=%d', [arrIdx, treeNode, x, y]), MSG_NOTIFY); - {$ENDIF} - end; - *) end; @@ -321,7 +263,6 @@ begin InitTextures(); - //itemTree := TDynAABBTreeItem.Create(); freeIds := binHeapNewIntLess(); end; @@ -379,7 +320,6 @@ begin g_Texture_Delete('ITEM_MEDKIT_BLACK'); g_Texture_Delete('ITEM_JETPACK'); - //itemTree.Free(); freeIds.Free(); end; @@ -390,11 +330,8 @@ var begin if (idx < 0) or (idx > High(ggItems)) then raise Exception.Create('releaseItem: invalid item id'); it := @ggItems[idx]; - //if (it.treeNode = -1) then raise Exception.Create('releaseItem: trying to release unallocated item'); if not it.slotIsUsed then raise Exception.Create('releaseItem: trying to release unallocated item'); if (it.arrIdx <> idx) then raise Exception.Create('releaseItem: arrIdx inconsistency'); - //itemTree.removeObject(it.treeNode); - //it.treeNode := -1; it.slotIsUsed := false; if (it.Animation <> nil) then begin @@ -421,7 +358,6 @@ begin for i := olen to High(ggItems) do begin it := @ggItems[i]; - //it.treeNode := -1; it.slotIsUsed := false; it.arrIdx := i; it.ItemType := ITEM_NONE; @@ -436,8 +372,8 @@ begin result := freeIds.front; freeIds.popFront(); - if (result > High(ggItems)) then raise Exception.Create('allocItem: freeid list corrupted'); - if (ggItems[result].arrIdx <> result) then raise Exception.Create('allocItem: arrIdx inconsistency'); + if (Integer(result) > High(ggItems)) then raise Exception.Create('allocItem: freeid list corrupted'); + if (ggItems[result].arrIdx <> Integer(result)) then raise Exception.Create('allocItem: arrIdx inconsistency'); end; @@ -459,7 +395,6 @@ begin for i := olen to High(ggItems) do begin it := @ggItems[i]; - //it.treeNode := -1; it.slotIsUsed := false; it.arrIdx := i; it.ItemType := ITEM_NONE; @@ -473,7 +408,7 @@ begin end; it := @ggItems[slot]; - if {(it.treeNode = -1)} not it.slotIsUsed then + if not it.slotIsUsed then begin // this is unused slot; get it, and rebuild id list if rebuildFreeList then @@ -481,15 +416,13 @@ begin freeIds.clear(); for i := 0 to High(ggItems) do begin - if (i <> slot) and {(ggItems[i].treeNode = -1)} (not it.slotIsUsed) then freeIds.insert(i); + if (i <> slot) and (not it.slotIsUsed) then freeIds.insert(i); end; end; end else begin // it will be readded - //itemTree.removeObject(it.treeNode); - //it.treeNode := -1; it.slotIsUsed := false; end; @@ -517,7 +450,6 @@ begin for i := 0 to High(ggItems) do ggItems[i].Animation.Free(); ggItems := nil; end; - //if (itemTree <> nil) then itemTree.reset(); freeIds.clear(); end; @@ -535,9 +467,7 @@ begin it := @ggItems[find_id]; - //if (it.treeNode <> -1) then raise Exception.Create('g_Items_Create: trying to reuse already allocated item'); - if (it.arrIdx <> find_id) then raise Exception.Create('g_Items_Create: arrIdx inconsistency'); - //it.treeNode := -1; + if (it.arrIdx <> Integer(find_id)) then raise Exception.Create('g_Items_Create: arrIdx inconsistency'); //it.arrIdx := find_id; it.slotIsUsed := true; @@ -758,19 +688,11 @@ procedure g_Items_Remove (ID: DWORD); var it: PItem; trig: Integer; -{$IF DEFINED(D2F_DEBUG)} - //x, y: Integer; -{$ENDIF} begin if not g_Items_ValidId(ID) then raise Exception.Create('g_Items_Remove: invalid item id'); it := @ggItems[ID]; - if (it.arrIdx <> ID) then raise Exception.Create('g_Items_Remove: arrIdx desync'); - - {$IF DEFINED(D2F_DEBUG)} - //itemTree.getNodeXY(it.treeNode, x, y); - //e_WriteLog(Format('removing item #%d: updating tree; nodeid=%d; x=%d; y=%d (%d,%d)', [it.arrIdx, it.treeNode, x, y, it.Obj.X, it.Obj.Y]), MSG_NOTIFY); - {$ENDIF} + if (it.arrIdx <> Integer(ID)) then raise Exception.Create('g_Items_Remove: arrIdx desync'); trig := it.SpawnTrigger; diff --git a/src/game/g_map.pas b/src/game/g_map.pas index 7d6f3dd..7d13205 100644 --- a/src/game/g_map.pas +++ b/src/game/g_map.pas @@ -21,7 +21,7 @@ interface uses e_graphics, g_basic, MAPSTRUCT, g_textures, Classes, - g_phys, wadreader, BinEditor, g_panel, g_grid, z_aabbtree, md5, binheap, xprofiler; + g_phys, wadreader, BinEditor, g_panel, g_grid, md5, binheap, xprofiler; type TMapInfo = record @@ -181,9 +181,6 @@ var gdbg_map_use_accel_render: Boolean = true; gdbg_map_use_accel_coldet: Boolean = true; - //gdbg_map_use_tree_draw: Boolean = false; - //gdbg_map_use_tree_coldet: Boolean = false; - //gdbg_map_dump_coldet_tree_queries: Boolean = false; profMapCollision: TProfiler = nil; //WARNING: FOR DEBUGGING ONLY! gDrawPanelList: TBinaryHeapObj = nil; // binary heap of all walls we have to render, populated by `g_Map_CollectDrawPanels()` @@ -210,26 +207,6 @@ const type TPanelGrid = specialize TBodyGridBase; - { - TDynAABBTreePanelBase = specialize TDynAABBTreeBase; - - TDynAABBTreeMap = class(TDynAABBTreePanelBase) - function getFleshAABB (out aabb: AABB2D; pan: TPanel; tag: Integer): Boolean; override; - end; - { - -{ -function TDynAABBTreeMap.getFleshAABB (out aabb: AABB2D; pan: TPanel; tag: Integer): Boolean; -begin - result := false; - if (pan = nil) then begin aabb := AABB2D.Create(0, 0, 0, 0); exit; end; - aabb := AABB2D.Create(pan.X, pan.Y, pan.X+pan.Width-1, pan.Y+pan.Height-1); - if (pan.Width < 1) or (pan.Height < 1) then exit; - if not aabb.valid then raise Exception.Create('wutafuuuuuuu?!'); - result := true; -end; -} - function panelTypeToTag (panelType: Word): Integer; begin @@ -279,7 +256,6 @@ var FlagPoints: Array [FLAG_RED..FLAG_BLUE] of PFlagPoint; //DOMFlagPoints: Array of TFlagPoint; mapGrid: TPanelGrid = nil; - //mapTree: TDynAABBTreeMap = nil; procedure g_Map_ProfilersBegin (); @@ -302,123 +278,11 @@ begin end; -// wall index in `gWalls` or -1 -(* -function g_Map_traceToNearestWallOld (x0, y0, x1, y1: Integer; hitx: PInteger=nil; hity: PInteger=nil): Integer; - - function sqchecker (pan: TPanel; var ray: Ray2D): Single; - var - aabb: AABB2D; - tmin: Single; - begin - result := -666.0; // invalid - if not pan.Enabled then exit; - aabb := AABB2D.CreateWH(pan.X, pan.Y, pan.Width, pan.Height); - if not aabb.valid then exit; - if aabb.intersects(ray, @tmin) then - begin - //if (tmin*tmin > maxDistSq) then exit; - if (tmin >= 0.0) then - begin - //e_WriteLog(Format('sqchecker(%d,%d,%d,%d): panel #%d (%d,%d)-(%d,%d); tmin=%f', [x0, y0, x1, y1, pan.arrIdx, pan.X, pan.Y, pan.Width, pan.Height, tmin]), MSG_NOTIFY); - //if (tmin < 0.0) then tmin := 0.0; - result := tmin; - end; - end; - end; - -var - qr: TDynAABBTreeMap.TSegmentQueryResult; - ray: Ray2D; - hxf, hyf: Single; - hx, hy: Integer; - maxDistSq: Single; -begin - result := -1; - if (mapTree = nil) then exit; - if mapTree.segmentQuery(qr, x0, y0, x1, y1, sqchecker, (GridTagWall or GridTagDoor)) then - begin - maxDistSq := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); - if (qr.flesh <> nil) and (qr.time*qr.time <= maxDistSq) then - begin - result := qr.flesh.arrIdx; - if (hitx <> nil) or (hity <> nil) then - begin - ray := Ray2D.Create(x0, y0, x1, y1); - hxf := ray.origX+ray.dirX*qr.time; - hyf := ray.origY+ray.dirY*qr.time; - while true do - begin - hx := trunc(hxf); - hy := trunc(hyf); - if (hx >= qr.flesh.X) and (hy >= qr.flesh.Y) and (hx < qr.flesh.X+qr.flesh.Width) and (hy < qr.flesh.Y+qr.flesh.Height) then - begin - // go back a little - hxf -= ray.dirX; - hyf -= ray.dirY; - end - else - begin - break; - end; - end; - if (hitx <> nil) then hitx^ := hx; - if (hity <> nil) then hity^ := hy; - end; - end; - end; -end; -*) - - // wall index in `gWalls` or -1 function g_Map_traceToNearestWall (x0, y0, x1, y1: Integer; hitx: PInteger=nil; hity: PInteger=nil): Boolean; -(* -var - lastX, lastY, lastDistSq: Integer; - wasHit: Boolean = false; - - // pan=nil: before processing new tile - function sqchecker (pan: TPanel; tag: Integer; x, y, prevx, prevy: Integer): Boolean; - var - distSq: Integer; - begin - if (pan = nil) then - begin - // stop if something was hit at the previous tile - result := wasHit; - end - else - begin - result := false; - if ((tag and (GridTagWall or GridTagDoor)) <> 0) then - begin - if not pan.Enabled then exit; - end; - distSq := (prevx-x0)*(prevx-x0)+(prevy-y0)*(prevy-y0); - if (distSq < lastDistSq) then - begin - wasHit := true; - lastDistSq := distSq; - lastX := prevx; - lastY := prevy; - end; - end; - end; -*) var ex, ey: Integer; begin - (* - result := false; - if (mapGrid = nil) then exit; - lastDistSq := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0)+1; - lastX := 0; - lastY := 0; - result := mapGrid.traceRay(x0, y0, x1, y1, sqchecker, (GridTagWall or GridTagDoor)); - if (hitx <> nil) then hitx^ := lastX; - if (hity <> nil) then hity^ := lastY; - *) result := (mapGrid.traceRay(ex, ey, x0, y0, x1, y1, nil, (GridTagWall or GridTagDoor)) <> nil); end; @@ -1037,7 +901,7 @@ end; procedure CreateArea(Area: TAreaRec_1); var a: Integer; - id: DWORD; + id: DWORD = 0; begin case Area.AreaType of AREA_DMPOINT, AREA_PLAYERPOINT1, AREA_PLAYERPOINT2, @@ -1222,6 +1086,7 @@ begin addResToExternalResList(mapHeader.SkyName); end; + procedure mapCreateGrid (); var mapX0: Integer = $3fffffff; @@ -1266,15 +1131,12 @@ var e_WriteLog(Format('INSERTED wall #%d(%d) enabled (%d)', [Integer(idx), Integer(pan.proxyId), Integer(mapGrid.proxyEnabled[pan.proxyId])]), MSG_NOTIFY); end; {$ENDIF} - //mapTree.insertObject(pan, tag, true); // as static object end; end; begin mapGrid.Free(); mapGrid := nil; - //mapTree.Free(); - //mapTree := nil; calcBoundingBox(gWalls); calcBoundingBox(gRenderBackgrounds); @@ -1289,7 +1151,6 @@ begin e_WriteLog(Format('map dimensions: (%d,%d)-(%d,%d)', [mapX0, mapY0, mapX1, mapY1]), MSG_WARNING); mapGrid := TPanelGrid.Create(mapX0-512, mapY0-512, mapX1-mapX0+1+512*2, mapY1-mapY0+1+512*2); - //mapTree := TDynAABBTreeMap.Create(); addPanelsToGrid(gWalls, PANEL_WALL); addPanelsToGrid(gWalls, PANEL_CLOSEDOOR); @@ -1304,10 +1165,11 @@ begin addPanelsToGrid(gBlockMon, PANEL_BLOCKMON); mapGrid.dumpStats(); - //e_WriteLog(Format('tree depth: %d; %d nodes used, %d nodes allocated', [mapTree.computeTreeHeight, mapTree.nodeCount, mapTree.nodeAlloced]), MSG_NOTIFY); - //mapTree.forEachLeaf(nil); + + g_Mons_InitTree(mapGrid.gridX0, mapGrid.gridY0, mapGrid.gridWidth, mapGrid.gridHeight); end; + function g_Map_Load(Res: String): Boolean; const DefaultMusRes = 'Standart.wad:STDMUS\MUS1'; @@ -1650,6 +1512,11 @@ begin end; end; + // create map grid, init other grids (for monsters, for example) + e_WriteLog('Creating map grid', MSG_NOTIFY); + mapCreateGrid(); + + // Åñëè íå LoadState, òî ñîçäàåì òðèããåðû: if (triggers <> nil) and not gLoadGameMode then begin @@ -1811,9 +1678,6 @@ begin sfsGCEnable(); // enable releasing unused volumes end; - e_WriteLog('Creating map grid', MSG_NOTIFY); - mapCreateGrid(); - e_WriteLog('Done loading map.', MSG_NOTIFY); Result := True; end; diff --git a/src/game/g_monsters.pas b/src/game/g_monsters.pas index f94e8e8..25b2555 100644 --- a/src/game/g_monsters.pas +++ b/src/game/g_monsters.pas @@ -20,7 +20,7 @@ interface uses g_basic, e_graphics, g_phys, g_textures, - g_saveload, BinEditor, g_panel, z_aabbtree, xprofiler; + g_saveload, BinEditor, g_panel, xprofiler; const MONSTATE_SLEEP = 0; @@ -80,7 +80,7 @@ type FFireAttacker: Word; vilefire: TAnimation; - treeNode: Integer; // node in dyntree or -1 + proxyId: Integer; // node in dyntree or -1 arrIdx: Integer; // in gMonsters FDieTriggers: Array of Integer; @@ -90,8 +90,6 @@ type function findNewPrey(): Boolean; procedure ActivateTriggers(); - function getMapAABB (): AABB2D; inline; - public FNoRespawn: Boolean; FFireTime: Integer; @@ -136,6 +134,8 @@ type procedure positionChanged (); //WARNING! call this after monster position was changed, or coldet will not work right! + procedure getMapBox (out x, y, w, h: Integer); inline; + property MonsterType: Byte read FMonsterType; property MonsterHealth: Integer read FHealth write FHealth; property MonsterAmmo: Integer read FAmmo write FAmmo; @@ -160,12 +160,13 @@ type property GameAccelY: Integer read FObj.Accel.Y write FObj.Accel.Y; property GameDirection: TDirection read FDirection write FDirection; - property mapAABB: AABB2D read getMapAABB; - property StartID: Integer read FStartID; end; +// will be called from map loader +procedure g_Mons_InitTree (x, y, w, h: Integer); + procedure g_Monsters_LoadData (); procedure g_Monsters_FreeData (); procedure g_Monsters_Init (); @@ -205,7 +206,7 @@ function g_Mons_getNewTrapFrameId (): DWord; type - TMonsAlongLineCB = function (mon: TMonster; dist: Single): Boolean is nested; + TMonsAlongLineCB = function (mon: TMonster; distSq: Integer): Boolean is nested; function g_Mons_alongLine (x0, y0, x1, y1: Integer; cb: TMonsAlongLineCB): TMonster; @@ -231,7 +232,7 @@ uses e_log, g_main, g_sound, g_gfx, g_player, g_game, g_weapons, g_triggers, MAPDEF, g_items, g_options, g_console, g_map, Math, SysUtils, g_menu, wadreader, - g_language, g_netmsg; + g_language, g_netmsg, g_grid; // ////////////////////////////////////////////////////////////////////////// // @@ -267,38 +268,26 @@ var monCheckTrapLastFrameId: DWord; -function TMonster.getMapAABB (): AABB2D; inline; +procedure TMonster.getMapBox (out x, y, w, h: Integer); inline; begin - result := AABB2D.CreateWH(FObj.X+FObj.Rect.X, FObj.Y+FObj.Rect.Y, FObj.Rect.Width, FObj.Rect.Height); + x := FObj.X+FObj.Rect.X; + y := FObj.Y+FObj.Rect.Y; + w := FObj.Rect.Width; + h := FObj.Rect.Height; end; // ////////////////////////////////////////////////////////////////////////// // type - TDynAABBTreeMonsBase = specialize TDynAABBTreeBase; - - TDynAABBTreeMons = class(TDynAABBTreeMonsBase) - function getFleshAABB (out aabb: AABB2D; flesh: TMonster; tag: Integer): Boolean; override; - end; - -function TDynAABBTreeMons.getFleshAABB (out aabb: AABB2D; flesh: TMonster; tag: Integer): Boolean; -begin - result := false; - if (flesh = nil) then raise Exception.Create('DynTree: trying to get dimensions of inexistant monsters'); - if (flesh.Obj.Rect.Width < 1) or (flesh.Obj.Rect.Height < 1) then raise Exception.Create('DynTree: monster without size, wtf?!'); - //aabb := AABB2D.CreateWH(flesh.Obj.X+flesh.Obj.Rect.X, flesh.Obj.Y+flesh.Obj.Rect.Y, flesh.Obj.Rect.Width, flesh.Obj.Rect.Height); - aabb := flesh.getMapAABB(); - if not aabb.valid then raise Exception.Create('wutafuuuuuuu?!'); - result := true; -end; - + TMonsterGrid = specialize TBodyGridBase; var - monsTree: TDynAABBTreeMons = nil; + monsGrid: TMonsterGrid = nil; function g_Mons_alongLine (x0, y0, x1, y1: Integer; cb: TMonsAlongLineCB): TMonster; - +//!!!FIXME!!! +{ function sqchecker (mon: TMonster; var ray: Ray2D): Single; var aabb: AABB2D; @@ -317,13 +306,16 @@ function g_Mons_alongLine (x0, y0, x1, y1: Integer; cb: TMonsAlongLineCB): TMons var qr: TDynAABBTreeMons.TSegmentQueryResult; +} begin result := nil; +{ if not assigned(cb) then exit; if monsTree.segmentQuery(qr, x0, y0, x1, y1, sqchecker) then begin if (qr.flesh <> nil) then result := qr.flesh; end; +} end; @@ -335,30 +327,30 @@ begin {$IF DEFINED(D2F_DEBUG_MONS_MOVE)} //e_WriteLog(Format('monster #%d(%u): pos=(%d,%d); rpos=(%d,%d)', [arrIdx, UID, FObj.X, FObj.Y, FObj.Rect.X, FObj.Rect.Y]), MSG_NOTIFY); {$ENDIF} - if (treeNode = -1) then + if (proxyId = -1) then begin - treeNode := monsTree.insertObject(self, 0); + proxyId := monsGrid.insertBody(self, FObj.X+FObj.Rect.X, FObj.Y+FObj.Rect.Y, FObj.Rect.Width, FObj.Rect.Height); {$IF DEFINED(D2F_DEBUG_MONS_MOVE)} - monsTree.getNodeXY(treeNode, x, y); - e_WriteLog(Format('monster #%d(%u): inserted into the tree; nodeid=%d; x=%d; y=%d', [arrIdx, UID, treeNode, x, y]), MSG_NOTIFY); + monsGrid.getBodyXY(proxyId, x, y); + e_WriteLog(Format('monster #%d(%u): inserted into the grid; proxyid=%d; x=%d; y=%d', [arrIdx, UID, proxyId, x, y]), MSG_NOTIFY); {$ENDIF} end else begin - monsTree.getNodeXY(treeNode, x, y); + monsGrid.getBodyXY(proxyId, x, y); if (FObj.X+FObj.Rect.X = x) and (FObj.Y+FObj.Rect.Y = y) then exit; // nothing to do - {$IF DEFINED(D2F_DEBUG_MONS_MOVE)}e_WriteLog(Format('monster #%d(%u): updating tree; nodeid=%d; x=%d; y=%d', [arrIdx, UID, treeNode, x, y]), MSG_NOTIFY);{$ENDIF} + {$IF DEFINED(D2F_DEBUG_MONS_MOVE)}e_WriteLog(Format('monster #%d(%u): updating tree; proxyid=%d; x=%d; y=%d', [arrIdx, UID, proxyId, x, y]), MSG_NOTIFY);{$ENDIF} - {$IFDEF TRUE} - monsTree.updateObject(treeNode); + {$IF TRUE} + monsGrid.moveBody(proxyId, FObj.X+FObj.Rect.X, FObj.Y+FObj.Rect.Y); {$ELSE} - monsTree.removeObject(treeNode); - treeNode := monsTree.insertObject(self); + monsGrid.removeBody(proxyId); + proxyId := monsGrid.insertBody(self, FObj.X+FObj.Rect.X, FObj.Y+FObj.Rect.Y, FObj.Rect.Width, FObj.Rect.Height); {$ENDIF} {$IF DEFINED(D2F_DEBUG_MONS_MOVE)} - monsTree.getNodeXY(treeNode, x, y); - e_WriteLog(Format('monster #%d(%u): updated tree; nodeid=%d; x=%d; y=%d', [arrIdx, UID, treeNode, x, y]), MSG_NOTIFY); + monsGrid.getBodyXY(proxyId, x, y); + e_WriteLog(Format('monster #%d(%u): updated tree; proxyid=%d; x=%d; y=%d', [arrIdx, UID, proxyId, x, y]), MSG_NOTIFY); {$ENDIF} end; end; @@ -707,6 +699,7 @@ function isCorpse (o: PObj; immediately: Boolean): Integer; function monsCollCheck (mon: TMonster; atag: Integer): Boolean; begin + atag := atag; // shut up, fpc! result := false; // don't stop if (mon.FState = STATE_DEAD) and g_Obj_Collide(o, @mon.FObj) then begin @@ -731,7 +724,7 @@ begin // Èùåì ìåðòâûõ ìîíñòðîâ ïîáëèçîñòè if gmon_debug_use_sqaccel then begin - mon := monsTree.aabbQuery(o.X+o.Rect.X, o.Y+o.Rect.Y, o.Rect.Width, o.Rect.Height, monsCollCheck); + mon := monsGrid.forEachInAABB(o.X+o.Rect.X, o.Y+o.Rect.Y, o.Rect.Width, o.Rect.Height, monsCollCheck); if (mon <> nil) then result := mon.arrIdx; end else @@ -992,7 +985,6 @@ begin g_Sound_CreateWADEx('SOUND_MONSTER_FISH_ATTACK', GameWAD+':MSOUNDS\FISH_ATTACK'); - monsTree := TDynAABBTreeMons.Create(); clearUidMap(); monCheckTrapLastFrameId := 0; end; @@ -1211,8 +1203,6 @@ begin g_Sound_Delete('SOUND_MONSTER_SPIDER_WALK'); g_Sound_Delete('SOUND_MONSTER_FISH_ATTACK'); - - monsTree.Free(); end; procedure g_Monsters_Init(); @@ -1224,13 +1214,23 @@ procedure g_Monsters_Free(); var a: Integer; begin - monsTree.reset(); + monsGrid.Free(); + monsGrid := nil; for a := 0 to High(gMonsters) do gMonsters[a].Free(); gMonsters := nil; clearUidMap(); monCheckTrapLastFrameId := 0; end; + +// will be called from map loader +procedure g_Mons_InitTree (x, y, w, h: Integer); +begin + monsGrid.Free(); + monsGrid := TMonsterGrid.Create(x, y, w, h); +end; + + function g_Monsters_Create(MonsterType: Byte; X, Y: Integer; Direction: TDirection; AdjCoord: Boolean = False; ForcedUID: Integer = -1): TMonster; var @@ -1254,7 +1254,7 @@ begin mon := TMonster.Create(MonsterType, find_id, ForcedUID); gMonsters[find_id] := mon; mon.arrIdx := find_id; - mon.treeNode := -1; + mon.proxyId := -1; uidMap[mon.FUID] := mon; @@ -1711,7 +1711,7 @@ end; constructor TMonster.Create(MonsterType: Byte; aID: Integer; ForcedUID: Integer = -1); var a: Integer; - FramesID: DWORD; + FramesID: DWORD = 0; s: String; res: Boolean; begin @@ -1741,7 +1741,7 @@ begin FFirePainTime := 0; FFireAttacker := 0; - treeNode := -1; + proxyId := -1; arrIdx := -1; trapCheckFrameId := 0; @@ -2017,21 +2017,17 @@ begin vilefire.Free(); - if (treeNode <> -1) then + if (proxyId <> -1) then begin - if monsTree.isValidId(treeNode) then - begin - {$IF DEFINED(D2F_DEBUG_MONS_MOVE)} - e_WriteLog(Format('monster #%d(%u): removed from tree; nodeid=%d', [arrIdx, UID, treeNode]), MSG_NOTIFY); - {$ENDIF} - monsTree.removeObject(treeNode); - end; + monsGrid.removeBody(proxyId); + {$IF DEFINED(D2F_DEBUG_MONS_MOVE)} + e_WriteLog(Format('monster #%d(%u): removed from tree; proxyid=%d', [arrIdx, UID, proxyId]), MSG_NOTIFY); + {$ENDIF} + proxyId := -1; end; - if (arrIdx <> -1) then - begin - gMonsters[arrIdx] := nil; - end; + if (arrIdx <> -1) then gMonsters[arrIdx] := nil; + arrIdx := -1; uidMap[FUID] := nil; @@ -4566,7 +4562,7 @@ function g_Mons_IsAnyAliveAt (x, y: Integer; width, height: Integer): Boolean; function monsCollCheck (mon: TMonster; atag: Integer): Boolean; begin - result := (mon.Live and g_Obj_Collide(x, y, width, height, @mon.Obj)); + result := mon.Live;// and g_Obj_Collide(x, y, width, height, @mon.Obj)); end; var @@ -4577,7 +4573,7 @@ begin if (width < 1) or (height < 1) then exit; if gmon_debug_use_sqaccel then begin - result := (monsTree.aabbQuery(x, y, width, height, monsCollCheck) <> nil); + result := (monsGrid.forEachInAABB(x, y, width, height, monsCollCheck) <> nil); end else begin @@ -4597,12 +4593,14 @@ begin end; +///!!!FIXME!!! function g_Mons_ForEachAt (x, y: Integer; width, height: Integer; cb: TEachMonsterCB): Boolean; function monsCollCheck (mon: TMonster; atag: Integer): Boolean; begin - result := false; - if g_Obj_Collide(x, y, width, height, @mon.Obj) then result := cb(mon); + //result := false; + //if g_Obj_Collide(x, y, width, height, @mon.Obj) then result := cb(mon); + result := cb(mon); end; var @@ -4613,7 +4611,7 @@ begin if (width < 1) or (height < 1) then exit; if gmon_debug_use_sqaccel then begin - result := (monsTree.aabbQuery(x, y, width, height, monsCollCheck) <> nil); + result := (monsGrid.forEachInAABB(x, y, width, height, monsCollCheck) <> nil); end else begin @@ -4637,8 +4635,9 @@ function g_Mons_ForEachAliveAt (x, y: Integer; width, height: Integer; cb: TEach function monsCollCheck (mon: TMonster; atag: Integer): Boolean; begin - result := false; - if mon.Live and g_Obj_Collide(x, y, width, height, @mon.Obj) then result := cb(mon); + //result := false; + //if mon.Live and g_Obj_Collide(x, y, width, height, @mon.Obj) then result := cb(mon); + if mon.Live then result := cb(mon) else result := false; end; var @@ -4651,11 +4650,11 @@ begin begin if (width = 1) and (height = 1) then begin - result := (monsTree.pointQuery(x, y, monsCollCheck) <> nil); + result := (monsGrid.forEachAtPoint(x, y, monsCollCheck) <> nil); end else begin - result := (monsTree.aabbQuery(x, y, width, height, monsCollCheck) <> nil); + result := (monsGrid.forEachInAABB(x, y, width, height, monsCollCheck) <> nil); end; end else diff --git a/src/game/g_netmaster.pas b/src/game/g_netmaster.pas index 3e5a30b..27eefa4 100644 --- a/src/game/g_netmaster.pas +++ b/src/game/g_netmaster.pas @@ -73,7 +73,7 @@ implementation uses SysUtils, e_msg, e_input, e_graphics, e_log, g_window, g_net, g_console, - g_map, g_game, g_sound, g_textures, g_gui, g_menu, g_options, g_language, wadreader; + g_map, g_game, g_sound, g_gui, g_menu, g_options, g_language, wadreader; var NetMEvent: ENetEvent; @@ -383,8 +383,10 @@ end; procedure g_Serverlist_Draw(var SL: TNetServerList); var sy, i, y, mw, mx, l: Integer; - cw, ch: Byte; - ww, hh: Word; + cw: Byte = 0; + ch: Byte = 0; + ww: Word = 0; + hh: Word = 0; ip: string; begin ip := ''; diff --git a/src/game/g_player.pas b/src/game/g_player.pas index f277a4e..45f9e6b 100644 --- a/src/game/g_player.pas +++ b/src/game/g_player.pas @@ -21,7 +21,7 @@ interface uses e_graphics, g_playermodel, g_basic, g_textures, g_weapons, g_phys, g_sound, g_saveload, MAPSTRUCT, - BinEditor, g_panel, z_aabbtree; + BinEditor, g_panel; const KEY_LEFT = 1; @@ -222,8 +222,6 @@ type procedure resetWeaponQueue (); function hasAmmoForWeapon (weapon: Byte): Boolean; - function getMapAABB (): AABB2D; - public FDamageBuffer: Integer; @@ -316,6 +314,8 @@ type //WARNING! this does nothing for now, but still call it! procedure positionChanged (); //WARNING! call this after monster position was changed, or coldet will not work right! + procedure getMapBox (out x, y, w, h: Integer); inline; + property Name: String read FName write FName; property Model: TPlayerModel read FModel; property Health: Integer read FHealth write FHealth; @@ -348,8 +348,6 @@ type property UID: Word read FUID write FUID; property JustTeleported: Boolean read FJustTeleported write FJustTeleported; property NetTime: LongWord read FNetTime write FNetTime; - - property mapAABB: AABB2D read getMapAABB; end; TDifficult = record @@ -4817,7 +4815,7 @@ begin DecMin(FPain, 5, 0); DecMin(FPickup, 1, 0); - if FLive and (FObj.Y > gMapInfo.Height+128) and AnyServer then + if FLive and (FObj.Y > Integer(gMapInfo.Height)+128) and AnyServer then begin // Îáíóëèòü äåéñòâèÿ ïðèìî÷åê, ÷òîáû ôîí ïðîïàë FMegaRulez[MR_SUIT] := 0; @@ -5002,9 +5000,12 @@ begin if FKeys[b].Time = 0 then FKeys[b].Pressed := False else Dec(FKeys[b].Time); end; -function TPlayer.getMapAABB (): AABB2D; inline; +procedure TPlayer.getMapBox (out x, y, w, h: Integer); inline; begin - result := AABB2D.CreateWH(FObj.X+PLAYER_RECT.X, FObj.Y+PLAYER_RECT.Y, PLAYER_RECT.Width, PLAYER_RECT.Height); + x := FObj.X+PLAYER_RECT.X; + y := FObj.Y+PLAYER_RECT.Y; + w := PLAYER_RECT.Width; + h := PLAYER_RECT.Height; end; function TPlayer.Collide(X, Y: Integer; Width, Height: Word): Boolean; diff --git a/src/game/g_textures.pas b/src/game/g_textures.pas index 12072bb..0688391 100644 --- a/src/game/g_textures.pas +++ b/src/game/g_textures.pas @@ -99,8 +99,8 @@ function g_Frames_CreateFile(ID: PDWORD; Name: ShortString; FileName: String; function g_Frames_CreateMemory(ID: PDWORD; Name: ShortString; pData: Pointer; dataSize: LongInt; FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean; //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean; -function g_Frames_Get(var ID: DWORD; FramesName: ShortString): Boolean; -function g_Frames_GetTexture(var ID: DWORD; FramesName: ShortString; Frame: Word): Boolean; +function g_Frames_Get(out ID: DWORD; FramesName: ShortString): Boolean; +function g_Frames_GetTexture(out ID: DWORD; FramesName: ShortString; Frame: Word): Boolean; function g_Frames_Exists(FramesName: String): Boolean; procedure g_Frames_DeleteByName(FramesName: ShortString); procedure g_Frames_DeleteByID(ID: DWORD); @@ -572,7 +572,7 @@ begin FramesArray := nil; end; -function g_Frames_Get(var ID: DWORD; FramesName: ShortString): Boolean; +function g_Frames_Get(out ID: DWORD; FramesName: ShortString): Boolean; var a: DWORD; begin @@ -595,7 +595,7 @@ begin g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName])); end; -function g_Frames_GetTexture(var ID: DWORD; FramesName: ShortString; Frame: Word): Boolean; +function g_Frames_GetTexture(out ID: DWORD; FramesName: ShortString; Frame: Word): Boolean; var a: DWORD; begin diff --git a/src/game/g_weapons.pas b/src/game/g_weapons.pas index 46b0d77..7f8f99d 100644 --- a/src/game/g_weapons.pas +++ b/src/game/g_weapons.pas @@ -129,7 +129,7 @@ uses g_console, SysUtils, g_options, g_game, g_triggers, MAPDEF, e_log, g_monsters, g_saveload, g_language, g_netmsg, - z_aabbtree, binheap, hashtable; + binheap, hashtable; type TWaterPanel = record @@ -554,7 +554,8 @@ end; function g_Weapon_CreateShot(I: Integer; ShotType: Byte; Spawner, TargetUID: Word; X, Y, XV, YV: Integer): LongWord; var - find_id, FramesID: DWORD; + find_id: DWord; + FramesID: DWORD = 0; begin if I < 0 then find_id := FindShot() @@ -1366,327 +1367,9 @@ end; *) -(* -procedure g_Weapon_gunComplicated (const x, y, xd, yd, v, dmg: Integer; SpawnerUID: Word; CheckTrigger: Boolean); -const - HHGridSize = 64; - -var - hitray: Ray2D; - xi, yi: Integer; - - function doPlayerHit (idx: Integer): Boolean; - begin - result := false; - if (idx < 0) or (idx > High(gPlayers)) then exit; - if (gPlayers[idx] = nil) or not gPlayers[idx].Live then exit; - result := HitPlayer(gPlayers[idx], dmg, (xi*v)*10, (yi*v)*10-3, SpawnerUID, HIT_SOME); - if result and (v <> 0) then gPlayers[idx].Push((xi*v), (yi*v)); - {$IF DEFINED(D2F_DEBUG)} - //if result then e_WriteLog(Format(' PLAYER #%d HIT', [idx]), MSG_NOTIFY); - {$ENDIF} - end; - - function doMonsterHit (mon: TMonster): Boolean; - begin - result := false; - if (mon = nil) then exit; - result := HitMonster(mon, dmg, (xi*v)*10, (yi*v)*10-3, SpawnerUID, HIT_SOME); - if result and (v <> 0) then mon.Push((xi*v), (yi*v)); - {$IF DEFINED(D2F_DEBUG)} - //if result then e_WriteLog(Format(' MONSTER #%u HIT', [LongWord(mon.UID)]), MSG_NOTIFY); - {$ENDIF} - end; - - // get nearest player along hitray - // return `true` if instant hit was detected - function playerPossibleHit (): Boolean; - var - i: Integer; - aabb: AABB2D; - tmin: Single; - begin - result := false; - for i := 0 to High(gPlayers) do - begin - if (gPlayers[i] <> nil) and gPlayers[i].Live then - begin - aabb := gPlayers[i].mapAABB; - // inside? - if aabb.contains(x, y) then - begin - if doPlayerHit(i) then begin result := true; exit; end; - end - else if (aabb.intersects(hitray, @tmin)) then - begin - // intersect - if (tmin <= 0) then - begin - if doPlayerHit(i) then begin result := true; exit; end; - end - else - begin - appendHitTimePlr(tmin, i); - end; - end; - end; - end; - end; - - function monsPossibleHitInstant (mon: TMonster): Boolean; - var - aabb: AABB2D; - begin - result := false; // don't stop - aabb := mon.mapAABB; - if aabb.contains(x, y) then - begin - result := doMonsterHit(mon); - end; - end; - - function monsPossibleHit (mon: TMonster): Boolean; - var - aabb: AABB2D; - tmin: Single; - begin - result := false; // don't stop - if not wgunMonHash.put(Integer(mon.UID), 1) then - begin - // new monster; calculate hitpoint - aabb := mon.mapAABB; - if (aabb.intersects(hitray, @tmin)) then - begin - if (tmin < 0) then tmin := 1.0; - appendHitTimeMon(tmin, mon); - end; - end; - end; - -var - a: Integer; - x2, y2: Integer; - dx, dy: Integer; - xe, ye: Integer; - s, c: Extended; - xx, yy, d: Integer; - prevX, prevY: Integer; - leftToNextMonsterQuery: Integer = 0; - i: Integer; - t1: Boolean; - {$IF DEFINED(GWEP_HITSCAN_TRACE_BITMAP_CHECKER)} - w, h: Word; - {$ENDIF} - wallWasHit: Boolean = false; - wallHitX: Integer = 0; - wallHitY: Integer = 0; - didHit: Boolean = false; - mptWX: Integer = 0; - mptWY: Integer = 0; - mptHit: Integer = -1; - {$IF DEFINED(D2F_DEBUG)} - stt: UInt64; - {$ENDIF} -begin - if not gwep_debug_fast_trace then - begin - g_Weapon_gunOld(x, y, xd, yd, v, dmg, SpawnerUID, CheckTrigger); - exit; - end; - - wgunMonHash.reset(); //FIXME: clear hash on level change - wgunHitHeap.clear(); - wgunHitTimeUsed := 0; - - a := GetAngle(x, y, xd, yd)+180; - - SinCos(DegToRad(-a), s, c); - - if Abs(s) < 0.01 then s := 0; - if Abs(c) < 0.01 then c := 0; - - x2 := x+Round(c*gMapInfo.Width); - y2 := y+Round(s*gMapInfo.Width); - - hitray := Ray2D.Create(x, y, x2, y2); - - e_WriteLog(Format('GUN TRACE: (%d,%d) to (%d,%d)', [x, y, x2, y2]), MSG_NOTIFY); - - {$IF DEFINED(GWEP_HITSCAN_TRACE_BITMAP_CHECKER)} - t1 := (gWalls <> nil); - w := gMapInfo.Width; - h := gMapInfo.Height; - {$ENDIF} - - dx := x2-x; - dy := y2-y; - - if (xd = 0) and (yd = 0) then Exit; - - if dx > 0 then xi := 1 else if dx < 0 then xi := -1 else xi := 0; - if dy > 0 then yi := 1 else if dy < 0 then yi := -1 else yi := 0; - - // check instant hits - xx := x; - yy := y; - if (dx < 0) then Dec(xx); - if (dy < 0) then Dec(yy); - - dx := Abs(dx); - dy := Abs(dy); - - if playerPossibleHit() then exit; // instant hit - if g_Mons_ForEachAliveAt(xx, yy, 3, 3, monsPossibleHitInstant) then exit; // instant hit - - if dx > dy then d := dx else d := dy; - - //blood vel, for Monster.Damage() - //vx := (dx*10 div d)*xi; - //vy := (dy*10 div d)*yi; - - {$IF DEFINED(D2F_DEBUG)} - mptHit := g_Map_traceToNearestWall(x, y, x2, y2, @mptWX, @mptWY); - e_WriteLog(Format('tree trace: (%d,%d)', [mptWX, mptWY]), MSG_NOTIFY); - {$ENDIF} - - {$IF not DEFINED(GWEP_HITSCAN_TRACE_BITMAP_CHECKER)} - wallWasHit := (mptHit >= 0); - wallHitX := mptWX; - wallHitY := mptWY; - t1 := false; - {$ENDIF} - - {$IF DEFINED(D2F_DEBUG)} - stt := curTimeMicro(); - {$ENDIF} - // find wall, collect monsters - begin - xe := 0; - ye := 0; - xx := x; - yy := y; - prevX := xx; - prevY := yy; - for i := 1 to d do - begin - prevX := xx; - prevY := yy; - xe += dx; - ye += dy; - if (xe > d) then begin xe -= d; xx += xi; end; - if (ye > d) then begin ye -= d; yy += yi; end; - - // wtf?! - //if (yy > h) or (yy < 0) then break; - //if (xx > w) or (xx < 0) then break; - - {$IF DEFINED(GWEP_HITSCAN_TRACE_BITMAP_CHECKER)} - if t1 and (xx >= 0) and (yy >= 0) and (xx < w) and (yy < h) then - begin - if ByteBool(gCollideMap[yy, xx] and MARK_BLOCKED) then - begin - wallWasHit := true; - wallHitX := prevX; - wallHitY := prevY; - end; - end; - {$ELSE} - if (abs(prevX-wallHitX) < 2) and (abs(prevY-wallHitY) < 2) then t1 := true; - {$ENDIF} - - if (leftToNextMonsterQuery <> 0) and not wallWasHit then - begin - Dec(leftToNextMonsterQuery); - end - else - begin - // check monsters - g_Mons_ForEachAliveAt(xx-HHGridSize div 2, yy-HHGridSize div 2, HHGridSize+HHGridSize div 2, HHGridSize+HHGridSize div 2, monsPossibleHit); - leftToNextMonsterQuery := HHGridSize; // again - {$IF DEFINED(GWEP_HITSCAN_TRACE_BITMAP_CHECKER)} - if wallWasHit then break; - {$ELSE} - if t1 then break; - {$ENDIF} - end; - end; - - if not wallWasHit then - begin - wallHitX := prevX; - wallHitY := prevY; - end; - end; - - // here, we collected all monsters and players in `wgunHitHeap` and `wgunHitTime` - // also, if `wallWasHit` is true, then `wallHitX` and `wallHitY` contains wall coords - while (wgunHitHeap.count > 0) do - begin - // has some entities to check, do it - i := wgunHitHeap.front; - wgunHitHeap.popFront(); - hitray.atTime(wgunHitTime[i].time, xe, ye); - // check if it is not behind the wall - if ((xe-x)*(xe-x)+(ye-y)*(ye-y) < (wallHitX-x)*(wallHitX-x)+(wallHitY-y)*(wallHitY-y)) then - begin - if (wgunHitTime[i].mon <> nil) then - begin - didHit := doMonsterHit(wgunHitTime[i].mon); - end - else - begin - didHit := doPlayerHit(wgunHitTime[i].plridx); - end; - if didHit then - begin - // need new coords for trigger - wallHitX := xe; - wallHitY := ye; - wallWasHit := false; // no sparks - break; - end; - end; - end; - - // need sparks? - if wallWasHit then - begin - {$IF DEFINED(GWEP_HITSCAN_TRACE_BITMAP_CHECKER)} - if (mptHit < 0) then - begin - e_WriteLog('OOPS: tree trace failed, but pixel trace found the wall!', MSG_WARNING); - raise Exception.Create('map tree trace fucked'); - end - else - begin - {$IF DEFINED(D2F_DEBUG)} - //e_WriteLog(Format(' trace: (%d,%d)', [wallHitX, wallHitY]), MSG_NOTIFY); - {$ENDIF} - wallHitX := mptWX; - wallHitY := mptWY; - end; - {$ENDIF} - {$IF DEFINED(D2F_DEBUG)} - stt := curTimeMicro()-stt; - e_WriteLog(Format('*** new trace time: %u microseconds', [LongWord(stt)]), MSG_NOTIFY); - {$ENDIF} - g_GFX_Spark(wallHitX, wallHitY, 2+Random(2), 180+a, 0, 0); - if g_Game_IsServer and g_Game_IsNet then MH_SEND_Effect(wallHitX, wallHitY, 180+a, NET_GFX_SPARK); - end - else - begin - {$IF DEFINED(D2F_DEBUG)} - stt := curTimeMicro()-stt; - e_WriteLog(Format('*** new trace time: %u microseconds', [LongWord(stt)]), MSG_NOTIFY); - {$ENDIF} - end; - - if CheckTrigger and g_Game_IsServer then g_Triggers_PressL(X, Y, wallHitX, wallHitY, SpawnerUID, ACTIVATE_SHOT); -end; -*) - - +//!!!FIXME!!! procedure g_Weapon_gun (const x, y, xd, yd, v, dmg: Integer; SpawnerUID: Word; CheckTrigger: Boolean); +(* var hitray: Ray2D; xi, yi: Integer; @@ -1755,7 +1438,9 @@ var result := false; // don't stop if (dist*dist < wallDistSq) then appendHitTimeMon(dist, mon); end; +*) +(* var a: Integer; x2, y2: Integer; @@ -1770,6 +1455,7 @@ var {$IF DEFINED(D2F_DEBUG)} stt: UInt64; {$ENDIF} +*) begin (* if not gwep_debug_fast_trace then @@ -1779,6 +1465,7 @@ begin end; *) +(* wgunMonHash.reset(); //FIXME: clear hash on level change wgunHitHeap.clear(); wgunHitTimeUsed := 0; @@ -1872,6 +1559,7 @@ begin end; if CheckTrigger and g_Game_IsServer then g_Triggers_PressL(X, Y, wallHitX, wallHitY, SpawnerUID, ACTIVATE_SHOT); +*) end; @@ -2648,7 +2336,7 @@ begin else tf := 3; - if (gTime mod tf = 0) then + if (gTime mod LongWord(tf) = 0) then begin Anim := TAnimation.Create(TextureID, False, 2 + Random(2)); Anim.Alpha := 0; diff --git a/src/game/z_aabbtree.pas b/src/game/z_aabbtree.pas deleted file mode 100644 index 88c7b88..0000000 --- a/src/game/z_aabbtree.pas +++ /dev/null @@ -1,1822 +0,0 @@ -(* 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 ../shared/a_modes.inc} -{.$DEFINE aabbtree_many_asserts} -{$DEFINE aabbtree_query_count} -{.$DEFINE aabbtree_use_floats} -unit z_aabbtree; - -interface - -uses - e_log, g_grid; - - -// ////////////////////////////////////////////////////////////////////////// // -type - {$IFDEF aabbtree_use_floats}TreeNumber = Single;{$ELSE}TreeNumber = Integer;{$ENDIF} - - -// ////////////////////////////////////////////////////////////////////////// // -type - Ray2D = record - public - origX, origY: Single; - dirX, dirY: Single; - - function getOrigN (idx: Integer): Single; inline; - function getDirN (idx: Integer): Single; inline; - - public - constructor Create (ax, ay: Single; aangle: Single); overload; - constructor Create (ax0, ay0, ax1, ay1: Single); overload; - constructor Create (constref aray: Ray2D); overload; - - procedure copyFrom (constref aray: Ray2D); inline; - - procedure normalizeDir (); inline; - - procedure setXYAngle (ax, ay: Single; aangle: Single); inline; - procedure setX0Y0X1Y1 (ax0, ay0, ax1, ay1: Single); inline; - - procedure atTime (time: Single; out rx, ry: Integer); inline; - - property orig[idx: Integer]: Single read getOrigN; - property dir[idx: Integer]: Single read getDirN; - end; - -// ////////////////////////////////////////////////////////////////////////// // -type - AABB2D = record - public - minX, minY, maxX, maxY: TreeNumber; - - private - function getvalid (): Boolean; inline; - function getcenterX (): TreeNumber; inline; - function getcenterY (): TreeNumber; inline; - function getextentX (): TreeNumber; inline; - function getextentY (): TreeNumber; inline; - function getMinN (idx: Integer): TreeNumber; inline; - function getMaxN (idx: Integer): TreeNumber; inline; - - public - constructor Create (x0, y0, x1, y1: TreeNumber); overload; - constructor Create (constref aabb: AABB2D); overload; - constructor Create (constref aabb0, aabb1: AABB2D); overload; - - constructor CreateWH (ax, ay, w, h: TreeNumber); - - procedure copyFrom (constref aabb: AABB2D); inline; - procedure setDims (x0, y0, x1, y1: TreeNumber); inline; - - procedure setMergeTwo (constref aabb0, aabb1: AABB2D); inline; - - function volume (): TreeNumber; inline; - - procedure merge (constref aabb: AABB2D); inline; - - // return true if the current AABB contains the AABB given in parameter - function contains (constref aabb: AABB2D): Boolean; inline; overload; - function contains (ax, ay: TreeNumber): Boolean; inline; overload; - - // return true if the current AABB is overlapping with the AABB in parameter - // two AABBs overlap if they overlap in the two axes at the same time - function overlaps (constref aabb: AABB2D): Boolean; inline; overload; - - // ray direction must be normalized - function intersects (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload; - function intersects (ax, ay, bx, by: Single; tmino: PSingle=nil): Boolean; inline; overload; - function intersects (constref ray: Ray2D; maxtime: Single; tmino: PSingle=nil): Boolean; inline; overload; - - property valid: Boolean read getvalid; - property centerX: TreeNumber read getcenterX; - property centerY: TreeNumber read getcenterY; - property extentX: TreeNumber read getextentX; - property extentY: TreeNumber read getextentY; - - property min[idx: Integer]: TreeNumber read getMinN; - property max[idx: Integer]: TreeNumber read getMaxN; - end; - - -// ////////////////////////////////////////////////////////////////////////// // -(* Dynamic AABB tree (bounding volume hierarchy) - * based on the code from ReactPhysics3D physics library, http://www.reactphysics3d.com - * Copyright (c) 2010-2016 Daniel Chappuis - * - * This software is provided 'as-is', without any express or implied warranty. - * In no event will the authors be held liable for any damages arising from the - * use of this software. - * - * Permission is granted to anyone to use this software for any purpose, - * including commercial applications, and to alter it and redistribute it - * freely, subject to the following restrictions: - * - * 1. The origin of this software must not be misrepresented; you must not claim - * that you wrote the original software. If you use this software in a - * product, an acknowledgment in the product documentation would be - * appreciated but is not required. - * - * 2. Altered source versions must be plainly marked as such, and must not be - * misrepresented as being the original software. - * - * 3. This notice may not be removed or altered from any source distribution. - *) -// ////////////////////////////////////////////////////////////////////////// // -(* - * This class implements a dynamic AABB tree that is used for broad-phase - * collision detection. This data structure is inspired by Nathanael Presson's - * dynamic tree implementation in BulletPhysics. The following implementation is - * based on the one from Erin Catto in Box2D as described in the book - * "Introduction to Game Physics with Box2D" by Ian Parberry. - *) -// ////////////////////////////////////////////////////////////////////////// // -// Dynamic AABB Tree: can be used to speed up broad phase in various engines -type - generic TDynAABBTreeBase = class(TObject) - public - type TTreeFlesh = ITP; - - private - type - PTreeNode = ^TTreeNode; - TTreeNode = record - public - const NullTreeNode = -1; - const Left = 0; - const Right = 1; - public - // a node is either in the tree (has a parent) or in the free nodes list (has a next node) - parentId: Integer; - //nextNodeId: Integer; - // a node is either a leaf (has data) or is an internal node (has children) - children: array [0..1] of Integer; // left and right child of the node (children[0] = left child) - // height of the node in the tree (-1 for free nodes) - height: SmallInt; - // fat axis aligned bounding box (AABB) corresponding to the node - aabb: AABB2D; - //TODO: `flesh` can be united with `children` - flesh: TTreeFlesh; - fleshX, fleshY: TreeNumber; - tag: Integer; // just a user-defined tag - public - // return true if the node is a leaf of the tree - procedure clear (); inline; - function leaf (): Boolean; inline; - function isfree (): Boolean; inline; - property nextNodeId: Integer read parentId write parentId; - //property flesh: Integer read children[0] write children[0]; - - procedure dumpToLog (); - end; - - TVisitCheckerCB = function (node: PTreeNode): Boolean of object; - //TVisitVisitorCB = function (abody: TTreeFlesh; atag: Integer): Boolean is nested; - - const ModeNoChecks = 0; - const ModeAABB = 1; - const ModePoint = 2; - - public - // return `true` to stop - type TForEachLeafCB = function (abody: TTreeFlesh; constref aabb: AABB2D): Boolean is nested; // WARNING! don't modify AABB here! - - public - // in the broad-phase collision detection (dynamic AABB tree), the AABBs are - // also inflated in direction of the linear motion of the body by mutliplying the - // followin constant with the linear velocity and the elapsed time between two frames - {$IFDEF aabbtree_use_floats} - const LinearMotionGapMultiplier = 1.7; - {$ELSE} - const LinearMotionGapMultiplier = 17; // *10 - {$ENDIF} - - public - // called when a overlapping node has been found during the call to forEachAABBOverlap() - // return `true` to stop - type TQueryOverlapCB = function (abody: TTreeFlesh; atag: Integer): Boolean is nested; - type TSegQueryCallback = function (abody: TTreeFlesh; var ray: Ray2D): Single is nested; // return hit time - - PSegmentQueryResult = ^TSegmentQueryResult; - TSegmentQueryResult = record - time: Single; // <0: nothing was hit - flesh: TTreeFlesh; - - constructor Create (fuckyoufpc: Boolean); - procedure reset (); inline; - function valid (): Boolean; inline; - end; - - private - mNodes: array of TTreeNode; // nodes of the tree - mRootNodeId: Integer; // id of the root node of the tree - mFreeNodeId: Integer; // id of the first node of the list of free (allocated) nodes in the tree that we can use - mAllocCount: Integer; // number of allocated nodes in the tree - mNodeCount: Integer; // number of nodes in the tree - - // extra AABB Gap used to allow the collision shape to move a little bit - // without triggering a large modification of the tree which can be costly - mExtraGap: TreeNumber; - - chkAABB: AABB2D; // for checkers - qSRes: PSegmentQueryResult; // for queries - // for segment query - curax, curay: Single; - curbx, curby: Single; - dirx, diry: Single; - traceRay: Ray2D; - sqcb: TSegQueryCallback; - vstack: array of Integer; // for `visit()` - vstused: Integer; // to support recursive queries - - function checkerAABB (node: PTreeNode): Boolean; - function checkerPoint (node: PTreeNode): Boolean; - function checkerRay (node: PTreeNode): Boolean; - function visitorRay (flesh: TTreeFlesh; tag: Integer): Boolean; - - type TQueryOverlapDg = function (abody: TTreeFlesh; atag: Integer): Boolean of object; - - private - function allocateNode (): Integer; - procedure releaseNode (nodeId: Integer); - procedure insertLeafNode (nodeId: Integer); - procedure removeLeafNode (nodeId: Integer); - function balanceSubTreeAtNode (nodeId: Integer): Integer; - function computeHeight (nodeId: Integer): Integer; - function insertObjectInternal (constref aabb: AABB2D; staticObject: Boolean): Integer; - procedure setup (); - function visit (constref caabb: AABB2D; mode: Integer; checker: TVisitCheckerCB; visitor: TQueryOverlapCB; visdg: TQueryOverlapDg; tagmask: Integer): Integer; - - function forEachNode (nodeId: Integer; dg: TForEachLeafCB): Boolean; - - public - {$IFDEF aabbtree_query_count} - mNodesVisited, mNodesDeepVisited: Integer; - {$ENDIF} - - public - constructor Create (extraAABBGap: TreeNumber=0); - destructor Destroy (); override; - - // clear all the nodes and reset the tree - procedure reset (); - - function forEachLeaf (dg: TForEachLeafCB): Boolean; // WARNING! don't modify AABB/tree here! - procedure getRootAABB (out aabb: AABB2D); - - function isValidId (id: Integer): Boolean; inline; - function getNodeObjectId (nodeid: Integer): TTreeFlesh; inline; - procedure getNodeFatAABB (out aabb: AABB2D; nodeid: Integer); inline; - - // returns `false` if nodeid is not leaf - function getNodeXY (nodeid: Integer; out x, y: Integer): Boolean; inline; - - // return `false` for invalid flesh - function getFleshAABB (out aabb: AABB2D; flesh: TTreeFlesh; tag: Integer): Boolean; virtual; abstract; - - // insert an object into the tree - // this method creates a new leaf node in the tree and returns the id of the corresponding node or -1 on error - // AABB for static object will not be "fat" (simple optimization) - // WARNING! inserting the same object several times *WILL* break everything! - function insertObject (flesh: TTreeFlesh; tag: Integer=-1; staticObject: Boolean=false): Integer; - - // remove an object from the tree - // WARNING: ids of removed objects can be reused on later insertions! - procedure removeObject (nodeId: Integer); - - (** update the dynamic tree after an object has moved. - * - * if the new AABB of the object that has moved is still inside its fat AABB, then nothing is done. - * otherwise, the corresponding node is removed and reinserted into the tree. - * the method returns true if the object has been reinserted into the tree. - * the `dispX` and `dispY` parameters are the linear velocity of the AABB multiplied by the elapsed time between two frames. - * if the `forceReinsert` parameter is `true`, we force a removal and reinsertion of the node - * (this can be useful if the shape AABB has become much smaller than the previous one for instance). - * - * note that you should call this method if body's AABB was modified, even if the body wasn't moved. - * - * if `forceReinsert` = `true` and both `dispX` and `dispY` are zeroes, convert object to "static" (don't extrude AABB). - * - * return `true` if the tree was modified. - *) - function updateObject (nodeId: Integer; dispX, dispY: TreeNumber; forceReinsert: Boolean=false): Boolean; overload; - function updateObject (nodeId: Integer; forceReinsert: Boolean=false): Boolean; overload; - - function aabbQuery (ax, ay, aw, ah: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh; - function pointQuery (ax, ay: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh; - function segmentQuery (out qr: TSegmentQueryResult; const ax, ay, bx, by: TreeNumber; cb: TSegQueryCallback; tagmask: Integer=-1): Boolean; - - function computeTreeHeight (): Integer; // compute the height of the tree - - property extraGap: TreeNumber read mExtraGap write mExtraGap; - property nodeCount: Integer read mNodeCount; - property nodeAlloced: Integer read mAllocCount; - {$IFDEF aabbtree_query_count} - property nodesVisited: Integer read mNodesVisited; - property nodesDeepVisited: Integer read mNodesDeepVisited; - {$ELSE} - const nodesVisited = 0; - const nodesDeepVisited = 0; - {$ENDIF} - end; - - -function dtMinI (a, b: Integer): Integer; inline; -function dtMaxI (a, b: Integer): Integer; inline; - -function dtMinF (a, b: TreeNumber): TreeNumber; inline; -function dtMaxF (a, b: TreeNumber): TreeNumber; inline; - -function minSingle (a, b: Single): Single; inline; -function maxSingle (a, b: Single): Single; inline; - - -implementation - -uses - SysUtils; - - -// ////////////////////////////////////////////////////////////////////////// // -function dtMinI (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end; -function dtMaxI (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end; - -function dtMinF (a, b: TreeNumber): TreeNumber; inline; begin if (a < b) then result := a else result := b; end; -function dtMaxF (a, b: TreeNumber): TreeNumber; inline; begin if (a > b) then result := a else result := b; end; - -function minSingle (a, b: Single): Single; inline; begin if (a < b) then result := a else result := b; end; -function maxSingle (a, b: Single): Single; inline; begin if (a > b) then result := a else result := b; end; - - -// ////////////////////////////////////////////////////////////////////////// // -constructor Ray2D.Create (ax, ay: Single; aangle: Single); begin setXYAngle(ax, ay, aangle); end; -constructor Ray2D.Create (ax0, ay0, ax1, ay1: Single); begin setX0Y0X1Y1(ax0, ay0, ax1, ay1); end; -constructor Ray2D.Create (constref aray: Ray2D); overload; begin copyFrom(aray); end; - - -function Ray2D.getOrigN (idx: Integer): Single; inline; begin if (idx = 0) then result := origX else if (idx = 1) then result := origY else result := 0; end; -function Ray2D.getDirN (idx: Integer): Single; inline; begin if (idx = 0) then result := dirX else if (idx = 1) then result := dirY else result := 0; end; - - -procedure Ray2D.copyFrom (constref aray: Ray2D); inline; -begin - origX := aray.origX; - origY := aray.origY; - dirX := aray.dirX; - dirY := aray.dirY; -end; - -procedure Ray2D.normalizeDir (); inline; -var - invlen: Single; -begin - invlen := 1.0/sqrt(dirX*dirX+dirY*dirY); - dirX *= invlen; - dirY *= invlen; -end; - -procedure Ray2D.setXYAngle (ax, ay: Single; aangle: Single); inline; -begin - origX := ax; - origY := ay; - dirX := cos(aangle); - dirY := sin(aangle); -end; - -procedure Ray2D.setX0Y0X1Y1 (ax0, ay0, ax1, ay1: Single); inline; -begin - origX := ax0; - origY := ay0; - dirX := ax1-ax0; - dirY := ay1-ay0; - normalizeDir(); -end; - - -procedure Ray2D.atTime (time: Single; out rx, ry: Integer); inline; -begin - rx := round(origX+dirX*time); - ry := round(origY+dirY*time); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -constructor AABB2D.Create (x0, y0, x1, y1: TreeNumber); overload; -begin - setDims(x0, y0, x1, y1); -end; - -constructor AABB2D.Create (constref aabb: AABB2D); overload; -begin - copyFrom(aabb); -end; - -constructor AABB2D.Create (constref aabb0, aabb1: AABB2D); overload; -begin - setMergeTwo(aabb0, aabb1); -end; - -constructor AABB2D.CreateWH (ax, ay, w, h: TreeNumber); -begin - minX := ax; - minY := ay; - maxX := ax+w-1; - maxY := ay+h-1; -end; - -function AABB2D.getvalid (): Boolean; inline; begin result := (minX <= maxX) and (minY <= maxY); end; - -{$IFDEF aabbtree_use_floats} -function AABB2D.getcenterX (): TreeNumber; inline; begin result := (minX+maxX)/2.0; end; -function AABB2D.getcenterY (): TreeNumber; inline; begin result := (minY+maxY)/2.0; end; -{$ELSE} -function AABB2D.getcenterX (): TreeNumber; inline; begin result := (minX+maxX) div 2; end; -function AABB2D.getcenterY (): TreeNumber; inline; begin result := (minY+maxY) div 2; end; -{$ENDIF} -function AABB2D.getextentX (): TreeNumber; inline; begin result := maxX-minX+1; end; -function AABB2D.getextentY (): TreeNumber; inline; begin result := maxY-minY+1; end; - -function AABB2D.getMinN (idx: Integer): TreeNumber; inline; begin if (idx = 0) then result := minX else if (idx = 1) then result := minY else result := 0; end; -function AABB2D.getMaxN (idx: Integer): TreeNumber; inline; begin if (idx = 0) then result := maxX else if (idx = 1) then result := maxY else result := 0; end; - -procedure AABB2D.copyFrom (constref aabb: AABB2D); inline; -begin - minX := aabb.minX; - minY := aabb.minY; - maxX := aabb.maxX; - maxY := aabb.maxY; - {$IF DEFINED(D2F_DEBUG)} - if not valid then raise Exception.Create('copyFrom: result is fucked'); - {$ENDIF} -end; - - -procedure AABB2D.setDims (x0, y0, x1, y1: TreeNumber); inline; -begin - minX := dtMinF(x0, x1); - minY := dtMinF(y0, y1); - maxX := dtMaxF(x0, x1); - maxY := dtMaxF(y0, y1); - {$IF DEFINED(D2F_DEBUG)} - if not valid then raise Exception.Create('setDims: result is fucked'); - {$ENDIF} -end; - - -procedure AABB2D.setMergeTwo (constref aabb0, aabb1: AABB2D); inline; -begin - {$IF DEFINED(D2F_DEBUG)} - if not aabb0.valid then raise Exception.Create('setMergeTwo: aabb0 is fucked'); - if not aabb1.valid then raise Exception.Create('setMergeTwo: aabb0 is fucked'); - {$ENDIF} - minX := dtMinF(aabb0.minX, aabb1.minX); - minY := dtMinF(aabb0.minY, aabb1.minY); - maxX := dtMaxF(aabb0.maxX, aabb1.maxX); - maxY := dtMaxF(aabb0.maxY, aabb1.maxY); - {$IF DEFINED(D2F_DEBUG)} - if not valid then raise Exception.Create('setMergeTwo: result is fucked'); - {$ENDIF} -end; - - -function AABB2D.volume (): TreeNumber; inline; -begin - result := (maxX-minX+1)*(maxY-minY+1); -end; - - -procedure AABB2D.merge (constref aabb: AABB2D); inline; -begin - {$IF DEFINED(D2F_DEBUG)} - if not aabb.valid then raise Exception.Create('merge: aabb is fucked'); - {$ENDIF} - minX := dtMinF(minX, aabb.minX); - minY := dtMinF(minY, aabb.minY); - maxX := dtMaxF(maxX, aabb.maxX); - maxY := dtMaxF(maxY, aabb.maxY); - {$IF DEFINED(D2F_DEBUG)} - if not valid then raise Exception.Create('setMergeTwo: result is fucked'); - {$ENDIF} -end; - - -function AABB2D.contains (constref aabb: AABB2D): Boolean; inline; overload; -begin - result := - (aabb.minX >= minX) and (aabb.minY >= minY) and - (aabb.maxX <= maxX) and (aabb.maxY <= maxY); -end; - - -function AABB2D.contains (ax, ay: TreeNumber): Boolean; inline; overload; -begin - result := (ax >= minX) and (ay >= minY) and (ax <= maxX) and (ay <= maxY); -end; - - -function AABB2D.overlaps (constref aabb: AABB2D): Boolean; inline; overload; -begin - result := false; - // exit with no intersection if found separated along any axis - if (maxX < aabb.minX) or (minX > aabb.maxX) then exit; - if (maxY < aabb.minY) or (minY > aabb.maxY) then exit; - result := true; -end; - - -// something to consider here is that 0 * inf =nan which occurs when the ray starts exactly on the edge of a box -// https://tavianator.com/fast-branchless-raybounding-box-intersections-part-2-nans/ -{ -function AABB2D.intersects (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload; -var - dinv, t1, t2, tmp: Single; - tmin, tmax: Single; -begin - // ok with coplanars - tmin := -1.0e100; - tmax := 1.0e100; - // do X - if (ray.dirX <> 0.0) then - begin - dinv := 1.0/ray.dirX; - t1 := (minX-ray.origX)*dinv; - t2 := (maxX-ray.origX)*dinv; - if (t1 < t2) then tmin := t1 else tmin := t2; - if (t1 > t2) then tmax := t1 else tmax := t2; - end; - // do Y - if (ray.dirY <> 0.0) then - begin - dinv := 1.0/ray.dirY; - t1 := (minY-ray.origY)*dinv; - t2 := (maxY-ray.origY)*dinv; - // tmin - if (t1 < t2) then tmp := t1 else tmp := t2; // min(t1, t2) - if (tmax < tmp) then tmp := tmax; // min(tmax, tmp) - if (tmin > tmp) then tmin := tmp; // max(tmin, tmp) - // tmax - if (t1 > t2) then tmp := t1 else tmp := t2; // max(t1, t2) - if (tmin > tmp) then tmp := tmin; // max(tmin, tmp) - if (tmax < tmp) then tmax := tmp; // min(tmax, tmp) - end; - if (tmin > 0) then tmp := tmin else tmp := 0; - if (tmax > tmp) then - begin - if (tmino <> nil) then tmino^ := tmin; - if (tmaxo <> nil) then tmaxo^ := tmax; - result := true; - end - else - begin - result := false; - end; -end; -} - - -function AABB2D.intersects (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload; -var - tmin, tmax, t1, t2, invd: Single; - i: Integer; -begin - tmin := -1.0e100; - tmax := 1.0e100; - for i := 0 to 1 do - begin - if (ray.dir[i] <> 0.0) then - begin - //t1 := (self.min[i]-ray.orig[i])/ray.dir[i]; - //t2 := (self.max[i]-ray.orig[i])/ray.dir[i]; - invd := 1.0/ray.dir[i]; - t1 := (self.min[i]-ray.orig[i])*invd; - t2 := (self.max[i]-ray.orig[i])*invd; - tmin := maxSingle(tmin, minSingle(t1, t2)); - tmax := minSingle(tmax, maxSingle(t1, t2)); - end - else if (ray.orig[i] <= self.min[i]) or (ray.orig[i] >= self.max[i]) then - begin - result := false; - exit; - end; - end; - - result := (tmax > tmin) and (tmax > 0.0); - if result then - begin - if (tmino <> nil) then tmino^ := tmin; - if (tmaxo <> nil) then tmaxo^ := tmin; - end; -end; - - -function AABB2D.intersects (ax, ay, bx, by: Single; tmino: PSingle=nil): Boolean; inline; overload; -var - tmin: Single; - ray: Ray2D; -begin - result := true; - if (tmino <> nil) then tmino^ := 0.0; - // it may be faster to first check if start or end point is inside AABB (this is sometimes enough for dyntree) - if (ax >= minX) and (ay >= minY) and (ax <= maxX) and (ay <= maxY) then exit; // a - if (bx >= minX) and (by >= minY) and (bx <= maxX) and (by <= maxY) then exit; // b - // nope, do it hard way - ray := Ray2D.Create(ax, ay, bx, by); - if not intersects(ray, @tmin) then begin if (tmino <> nil) then tmino^ := tmin; result := false; exit; end; - if (tmino <> nil) then tmino^ := tmin; - if (tmin < 0) then exit; // inside, just in case - bx -= ax; - by -= ay; - result := (tmin*tmin <= bx*bx+by*by); -end; - - -function AABB2D.intersects (constref ray: Ray2D; maxtime: Single; tmino: PSingle=nil): Boolean; inline; overload; -var - tmin: Single; -begin - result := true; - if (ray.origX >= minX) and (ray.origY >= minY) and (ray.origX <= maxX) and (ray.origY <= maxY) then - begin - if (tmino <> nil) then tmino^ := 0.0; - exit; - end; - if not intersects(ray, @tmin) then begin if (tmino <> nil) then tmino^ := -1.0; result := false; exit; end; - if (tmin < 0) then tmin := 0; // inside - if (tmino <> nil) then tmino^ := tmin; - result := (tmin <= maxtime); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -constructor TDynAABBTreeBase.TSegmentQueryResult.Create (fuckyoufpc: Boolean); begin time := -1; flesh := Default(ITP); end; -procedure TDynAABBTreeBase.TSegmentQueryResult.reset (); inline; begin time := -1; flesh := Default(ITP); end; -function TDynAABBTreeBase.TSegmentQueryResult.valid (): Boolean; inline; begin result := (time >= 0) and (flesh <> Default(ITP)); end; - - -// ////////////////////////////////////////////////////////////////////////// // -function TDynAABBTreeBase.TTreeNode.leaf (): Boolean; inline; begin result := (height = 0); end; -function TDynAABBTreeBase.TTreeNode.isfree (): Boolean; inline; begin result := (height = -1); end; - -procedure TDynAABBTreeBase.TTreeNode.clear (); inline; -begin - parentId := 0; - children[0] := 0; - children[1] := 0; - flesh := Default(ITP); - tag := 0; - height := 0; - aabb.minX := 0; - aabb.minY := 0; - aabb.maxX := 0; - aabb.maxY := 0; -end; - -procedure TDynAABBTreeBase.TTreeNode.dumpToLog (); -begin - e_WriteLog(Format('NODE: parentId=%d; children=[%d,%d]; height=%d; tag=%d; fleshX=%d; fleshY=%d; aabb=(%d,%d)-(%d,%d)', - [parentId, children[0], children[1], Integer(height), tag, fleshX, fleshY, aabb.minX, aabb.minY, aabb.maxX, aabb.maxY]), - MSG_NOTIFY); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -// allocate and return a node to use in the tree -function TDynAABBTreeBase.allocateNode (): Integer; -var - i, newsz, freeNodeId: Integer; - node: PTreeNode; -begin - // if there is no more allocated node to use - if (mFreeNodeId = TTreeNode.NullTreeNode) then - begin - {$IFDEF aabbtree_many_asserts}assert(mNodeCount = mAllocCount);{$ENDIF} - // allocate more nodes in the tree - if (mAllocCount <= 16384) then newsz := mAllocCount*2 else newsz := mAllocCount+16384; - SetLength(mNodes, newsz); - mAllocCount := newsz; - // initialize the allocated nodes - for i := mNodeCount to mAllocCount-1 do - begin - mNodes[i].nextNodeId := i+1; - mNodes[i].height := -1; - end; - mNodes[mAllocCount-1].nextNodeId := TTreeNode.NullTreeNode; - mFreeNodeId := mNodeCount; - end; - // get the next free node - freeNodeId := mFreeNodeId; - {$IFDEF aabbtree_many_asserts}assert(freeNodeId < mAllocCount);{$ENDIF} - node := @mNodes[freeNodeId]; - mFreeNodeId := node.nextNodeId; - node.clear(); - node.parentId := TTreeNode.NullTreeNode; - node.height := 0; - Inc(mNodeCount); - result := freeNodeId; - - //e_WriteLog(Format('tree: allocated node #%d', [result]), MSG_NOTIFY); -end; - - -// release a node -procedure TDynAABBTreeBase.releaseNode (nodeId: Integer); -begin - {$IFDEF aabbtree_many_asserts}assert(mNodeCount > 0);{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert((nodeId >= 0) and (nodeId < mAllocCount));{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].height >= 0);{$ENDIF} - mNodes[nodeId].nextNodeId := mFreeNodeId; - mNodes[nodeId].height := -1; - mNodes[nodeId].flesh := Default(ITP); - mFreeNodeId := nodeId; - Dec(mNodeCount); - - //e_WriteLog(Format('tree: released node #%d', [nodeId]), MSG_NOTIFY); -end; - - -// insert a leaf node in the tree -// the process of inserting a new leaf node in the dynamic tree is described in the book "Introduction to Game Physics with Box2D" by Ian Parberry -procedure TDynAABBTreeBase.insertLeafNode (nodeId: Integer); -var - newNodeAABB, mergedAABBs, currentAndLeftAABB, currentAndRightAABB: AABB2D; - currentNodeId: Integer; - leftChild, rightChild, siblingNode: Integer; - oldParentNode, newParentNode: Integer; - volumeAABB, mergedVolume: TreeNumber; - costS, costI, costLeft, costRight: TreeNumber; -begin - // if the tree is empty - if (mRootNodeId = TTreeNode.NullTreeNode) then - begin - mRootNodeId := nodeId; - mNodes[mRootNodeId].parentId := TTreeNode.NullTreeNode; - exit; - end; - - {$IFDEF aabbtree_many_asserts}assert(mRootNodeId <> TTreeNode.NullTreeNode);{$ENDIF} - - // find the best sibling node for the new node - newNodeAABB := AABB2D.Create(mNodes[nodeId].aabb); - currentNodeId := mRootNodeId; - while not mNodes[currentNodeId].leaf do - begin - leftChild := mNodes[currentNodeId].children[TTreeNode.Left]; - rightChild := mNodes[currentNodeId].children[TTreeNode.Right]; - - // compute the merged AABB - volumeAABB := mNodes[currentNodeId].aabb.volume; - mergedAABBs := AABB2D.Create(mNodes[currentNodeId].aabb, newNodeAABB); - mergedVolume := mergedAABBs.volume; - - // compute the cost of making the current node the sibling of the new node - costS := 2*mergedVolume; - - // compute the minimum cost of pushing the new node further down the tree (inheritance cost) - costI := 2*(mergedVolume-volumeAABB); - - // compute the cost of descending into the left child - currentAndLeftAABB := AABB2D.Create(newNodeAABB, mNodes[leftChild].aabb); - costLeft := currentAndLeftAABB.volume+costI; - if not mNodes[leftChild].leaf then costLeft -= mNodes[leftChild].aabb.volume; - - // compute the cost of descending into the right child - currentAndRightAABB := AABB2D.Create(newNodeAABB, mNodes[rightChild].aabb); - costRight := currentAndRightAABB.volume+costI; - if not mNodes[rightChild].leaf then costRight -= mNodes[rightChild].aabb.volume; - - // if the cost of making the current node a sibling of the new node is smaller than the cost of going down into the left or right child - if (costS < costLeft) and (costS < costRight) then break; - - // it is cheaper to go down into a child of the current node, choose the best child - //currentNodeId = (costLeft < costRight ? leftChild : rightChild); - if (costLeft < costRight) then currentNodeId := leftChild else currentNodeId := rightChild; - end; - - siblingNode := currentNodeId; - - // create a new parent for the new node and the sibling node - oldParentNode := mNodes[siblingNode].parentId; - newParentNode := allocateNode(); - mNodes[newParentNode].parentId := oldParentNode; - mNodes[newParentNode].aabb.setMergeTwo(mNodes[siblingNode].aabb, newNodeAABB); - mNodes[newParentNode].height := mNodes[siblingNode].height+1; - {$IFDEF aabbtree_many_asserts}assert(mNodes[newParentNode].height > 0);{$ENDIF} - - // if the sibling node was not the root node - if (oldParentNode <> TTreeNode.NullTreeNode) then - begin - {$IFDEF aabbtree_many_asserts}assert(not mNodes[oldParentNode].leaf);{$ENDIF} - if (mNodes[oldParentNode].children[TTreeNode.Left] = siblingNode) then - begin - mNodes[oldParentNode].children[TTreeNode.Left] := newParentNode; - end - else - begin - mNodes[oldParentNode].children[TTreeNode.Right] := newParentNode; - end; - mNodes[newParentNode].children[TTreeNode.Left] := siblingNode; - mNodes[newParentNode].children[TTreeNode.Right] := nodeId; - mNodes[siblingNode].parentId := newParentNode; - mNodes[nodeId].parentId := newParentNode; - end - else - begin - // if the sibling node was the root node - mNodes[newParentNode].children[TTreeNode.Left] := siblingNode; - mNodes[newParentNode].children[TTreeNode.Right] := nodeId; - mNodes[siblingNode].parentId := newParentNode; - mNodes[nodeId].parentId := newParentNode; - mRootNodeId := newParentNode; - end; - - // move up in the tree to change the AABBs that have changed - currentNodeId := mNodes[nodeId].parentId; - {$IFDEF aabbtree_many_asserts}assert(not mNodes[currentNodeId].leaf);{$ENDIF} - while (currentNodeId <> TTreeNode.NullTreeNode) do - begin - // balance the sub-tree of the current node if it is not balanced - currentNodeId := balanceSubTreeAtNode(currentNodeId); - {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF} - - {$IFDEF aabbtree_many_asserts}assert(not mNodes[currentNodeId].leaf);{$ENDIF} - leftChild := mNodes[currentNodeId].children[TTreeNode.Left]; - rightChild := mNodes[currentNodeId].children[TTreeNode.Right]; - {$IFDEF aabbtree_many_asserts}assert(leftChild <> TTreeNode.NullTreeNode);{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert(rightChild <> TTreeNode.NullTreeNode);{$ENDIF} - - // recompute the height of the node in the tree - mNodes[currentNodeId].height := dtMaxI(mNodes[leftChild].height, mNodes[rightChild].height)+1; - {$IFDEF aabbtree_many_asserts}assert(mNodes[currentNodeId].height > 0);{$ENDIF} - - // recompute the AABB of the node - mNodes[currentNodeId].aabb.setMergeTwo(mNodes[leftChild].aabb, mNodes[rightChild].aabb); - - currentNodeId := mNodes[currentNodeId].parentId; - end; - - {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF} -end; - - -// remove a leaf node from the tree -procedure TDynAABBTreeBase.removeLeafNode (nodeId: Integer); -var - currentNodeId, parentNodeId, grandParentNodeId, siblingNodeId: Integer; - leftChildId, rightChildId: Integer; -begin - {$IFDEF aabbtree_many_asserts}assert((nodeId >= 0) and (nodeId < mAllocCount));{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF} - - // if we are removing the root node (root node is a leaf in this case) - if (mRootNodeId = nodeId) then begin mRootNodeId := TTreeNode.NullTreeNode; exit; end; - - parentNodeId := mNodes[nodeId].parentId; - grandParentNodeId := mNodes[parentNodeId].parentId; - - if (mNodes[parentNodeId].children[TTreeNode.Left] = nodeId) then - begin - siblingNodeId := mNodes[parentNodeId].children[TTreeNode.Right]; - end - else - begin - siblingNodeId := mNodes[parentNodeId].children[TTreeNode.Left]; - end; - - // if the parent of the node to remove is not the root node - if (grandParentNodeId <> TTreeNode.NullTreeNode) then - begin - // destroy the parent node - if (mNodes[grandParentNodeId].children[TTreeNode.Left] = parentNodeId) then - begin - mNodes[grandParentNodeId].children[TTreeNode.Left] := siblingNodeId; - end - else - begin - {$IFDEF aabbtree_many_asserts}assert(mNodes[grandParentNodeId].children[TTreeNode.Right] = parentNodeId);{$ENDIF} - mNodes[grandParentNodeId].children[TTreeNode.Right] := siblingNodeId; - end; - mNodes[siblingNodeId].parentId := grandParentNodeId; - releaseNode(parentNodeId); - - // now, we need to recompute the AABBs of the node on the path back to the root and make sure that the tree is still balanced - currentNodeId := grandParentNodeId; - while (currentNodeId <> TTreeNode.NullTreeNode) do - begin - // balance the current sub-tree if necessary - currentNodeId := balanceSubTreeAtNode(currentNodeId); - - {$IFDEF aabbtree_many_asserts}assert(not mNodes[currentNodeId].leaf);{$ENDIF} - - // get the two children of the current node - leftChildId := mNodes[currentNodeId].children[TTreeNode.Left]; - rightChildId := mNodes[currentNodeId].children[TTreeNode.Right]; - - // recompute the AABB and the height of the current node - mNodes[currentNodeId].aabb.setMergeTwo(mNodes[leftChildId].aabb, mNodes[rightChildId].aabb); - mNodes[currentNodeId].height := dtMaxI(mNodes[leftChildId].height, mNodes[rightChildId].height)+1; - {$IFDEF aabbtree_many_asserts}assert(mNodes[currentNodeId].height > 0);{$ENDIF} - - currentNodeId := mNodes[currentNodeId].parentId; - end; - end - else - begin - // if the parent of the node to remove is the root node, the sibling node becomes the new root node - mRootNodeId := siblingNodeId; - mNodes[siblingNodeId].parentId := TTreeNode.NullTreeNode; - releaseNode(parentNodeId); - end; -end; - - -// balance the sub-tree of a given node using left or right rotations -// the rotation schemes are described in the book "Introduction to Game Physics with Box2D" by Ian Parberry -// this method returns the new root node id -function TDynAABBTreeBase.balanceSubTreeAtNode (nodeId: Integer): Integer; -var - nodeA, nodeB, nodeC, nodeF, nodeG: PTreeNode; - nodeBId, nodeCId, nodeFId, nodeGId: Integer; - balanceFactor: Integer; -begin - {$IFDEF aabbtree_many_asserts}assert(nodeId <> TTreeNode.NullTreeNode);{$ENDIF} - - nodeA := @mNodes[nodeId]; - - // if the node is a leaf or the height of A's sub-tree is less than 2 - if (nodeA.leaf) or (nodeA.height < 2) then begin result := nodeId; exit; end; // do not perform any rotation - - // get the two children nodes - nodeBId := nodeA.children[TTreeNode.Left]; - nodeCId := nodeA.children[TTreeNode.Right]; - {$IFDEF aabbtree_many_asserts}assert((nodeBId >= 0) and (nodeBId < mAllocCount));{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert((nodeCId >= 0) and (nodeCId < mAllocCount));{$ENDIF} - nodeB := @mNodes[nodeBId]; - nodeC := @mNodes[nodeCId]; - - // compute the factor of the left and right sub-trees - balanceFactor := nodeC.height-nodeB.height; - - // if the right node C is 2 higher than left node B - if (balanceFactor > 1) then - begin - {$IFDEF aabbtree_many_asserts}assert(not nodeC.leaf);{$ENDIF} - - nodeFId := nodeC.children[TTreeNode.Left]; - nodeGId := nodeC.children[TTreeNode.Right]; - {$IFDEF aabbtree_many_asserts}assert((nodeFId >= 0) and (nodeFId < mAllocCount));{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert((nodeGId >= 0) and (nodeGId < mAllocCount));{$ENDIF} - nodeF := @mNodes[nodeFId]; - nodeG := @mNodes[nodeGId]; - - nodeC.children[TTreeNode.Left] := nodeId; - nodeC.parentId := nodeA.parentId; - nodeA.parentId := nodeCId; - - if (nodeC.parentId <> TTreeNode.NullTreeNode) then - begin - if (mNodes[nodeC.parentId].children[TTreeNode.Left] = nodeId) then - begin - mNodes[nodeC.parentId].children[TTreeNode.Left] := nodeCId; - end - else - begin - {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeC.parentId].children[TTreeNode.Right] = nodeId);{$ENDIF} - mNodes[nodeC.parentId].children[TTreeNode.Right] := nodeCId; - end; - end - else - begin - mRootNodeId := nodeCId; - end; - - {$IFDEF aabbtree_many_asserts}assert(not nodeC.leaf);{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert(not nodeA.leaf);{$ENDIF} - - // if the right node C was higher than left node B because of the F node - if (nodeF.height > nodeG.height) then - begin - nodeC.children[TTreeNode.Right] := nodeFId; - nodeA.children[TTreeNode.Right] := nodeGId; - nodeG.parentId := nodeId; - - // recompute the AABB of node A and C - nodeA.aabb.setMergeTwo(nodeB.aabb, nodeG.aabb); - nodeC.aabb.setMergeTwo(nodeA.aabb, nodeF.aabb); - - // recompute the height of node A and C - nodeA.height := dtMaxI(nodeB.height, nodeG.height)+1; - nodeC.height := dtMaxI(nodeA.height, nodeF.height)+1; - {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert(nodeC.height > 0);{$ENDIF} - end - else - begin - // if the right node C was higher than left node B because of node G - nodeC.children[TTreeNode.Right] := nodeGId; - nodeA.children[TTreeNode.Right] := nodeFId; - nodeF.parentId := nodeId; - - // recompute the AABB of node A and C - nodeA.aabb.setMergeTwo(nodeB.aabb, nodeF.aabb); - nodeC.aabb.setMergeTwo(nodeA.aabb, nodeG.aabb); - - // recompute the height of node A and C - nodeA.height := dtMaxI(nodeB.height, nodeF.height)+1; - nodeC.height := dtMaxI(nodeA.height, nodeG.height)+1; - {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert(nodeC.height > 0);{$ENDIF} - end; - - // return the new root of the sub-tree - result := nodeCId; - exit; - end; - - // if the left node B is 2 higher than right node C - if (balanceFactor < -1) then - begin - {$IFDEF aabbtree_many_asserts}assert(not nodeB.leaf);{$ENDIF} - - nodeFId := nodeB.children[TTreeNode.Left]; - nodeGId := nodeB.children[TTreeNode.Right]; - {$IFDEF aabbtree_many_asserts}assert((nodeFId >= 0) and (nodeFId < mAllocCount));{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert((nodeGId >= 0) and (nodeGId < mAllocCount));{$ENDIF} - nodeF := @mNodes[nodeFId]; - nodeG := @mNodes[nodeGId]; - - nodeB.children[TTreeNode.Left] := nodeId; - nodeB.parentId := nodeA.parentId; - nodeA.parentId := nodeBId; - - if (nodeB.parentId <> TTreeNode.NullTreeNode) then - begin - if (mNodes[nodeB.parentId].children[TTreeNode.Left] = nodeId) then - begin - mNodes[nodeB.parentId].children[TTreeNode.Left] := nodeBId; - end - else - begin - {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeB.parentId].children[TTreeNode.Right] = nodeId);{$ENDIF} - mNodes[nodeB.parentId].children[TTreeNode.Right] := nodeBId; - end; - end - else - begin - mRootNodeId := nodeBId; - end; - - {$IFDEF aabbtree_many_asserts}assert(not nodeB.leaf);{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert(not nodeA.leaf);{$ENDIF} - - // if the left node B was higher than right node C because of the F node - if (nodeF.height > nodeG.height) then - begin - nodeB.children[TTreeNode.Right] := nodeFId; - nodeA.children[TTreeNode.Left] := nodeGId; - nodeG.parentId := nodeId; - - // recompute the AABB of node A and B - nodeA.aabb.setMergeTwo(nodeC.aabb, nodeG.aabb); - nodeB.aabb.setMergeTwo(nodeA.aabb, nodeF.aabb); - - // recompute the height of node A and B - nodeA.height := dtMaxI(nodeC.height, nodeG.height)+1; - nodeB.height := dtMaxI(nodeA.height, nodeF.height)+1; - {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert(nodeB.height > 0);{$ENDIF} - end - else - begin - // if the left node B was higher than right node C because of node G - nodeB.children[TTreeNode.Right] := nodeGId; - nodeA.children[TTreeNode.Left] := nodeFId; - nodeF.parentId := nodeId; - - // recompute the AABB of node A and B - nodeA.aabb.setMergeTwo(nodeC.aabb, nodeF.aabb); - nodeB.aabb.setMergeTwo(nodeA.aabb, nodeG.aabb); - - // recompute the height of node A and B - nodeA.height := dtMaxI(nodeC.height, nodeF.height)+1; - nodeB.height := dtMaxI(nodeA.height, nodeG.height)+1; - {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert(nodeB.height > 0);{$ENDIF} - end; - - // return the new root of the sub-tree - result := nodeBId; - exit; - end; - - // if the sub-tree is balanced, return the current root node - result := nodeId; -end; - - -// compute the height of a given node in the tree -function TDynAABBTreeBase.computeHeight (nodeId: Integer): Integer; -var - node: PTreeNode; - leftHeight, rightHeight: Integer; -begin - {$IFDEF aabbtree_many_asserts}assert((nodeId >= 0) and (nodeId < mAllocCount));{$ENDIF} - node := @mNodes[nodeId]; - - // if the node is a leaf, its height is zero - if (node.leaf) then begin result := 0; exit; end; - - // compute the height of the left and right sub-tree - leftHeight := computeHeight(node.children[TTreeNode.Left]); - rightHeight := computeHeight(node.children[TTreeNode.Right]); - - // return the height of the node - result := 1+dtMaxI(leftHeight, rightHeight); -end; - - -// internally add an object into the tree -function TDynAABBTreeBase.insertObjectInternal (constref aabb: AABB2D; staticObject: Boolean): Integer; -var - nodeId: Integer; - node: PTreeNode; -begin - // get the next available node (or allocate new ones if necessary) - nodeId := allocateNode(); - - node := @mNodes[nodeId]; - - // create the fat aabb to use in the tree - node.aabb := AABB2D.Create(aabb); - if (not staticObject) then - begin - node.aabb.minX -= mExtraGap; - node.aabb.minY -= mExtraGap; - node.aabb.maxX += mExtraGap; - node.aabb.maxY += mExtraGap; - end; - - // set the height of the node in the tree - node.height := 0; - - // insert the new leaf node in the tree - insertLeafNode(nodeId); - - {$IFDEF aabbtree_many_asserts}node := @mNodes[nodeId];{$ENDIF} - {$IFDEF aabbtree_many_asserts}assert(node.leaf);{$ENDIF} - - // return the id of the node - result := nodeId; -end; - - -// initialize the tree -procedure TDynAABBTreeBase.setup (); -var - i: Integer; -begin - mRootNodeId := TTreeNode.NullTreeNode; - mNodeCount := 0; - mAllocCount := 8192; - vstused := 0; - - SetLength(mNodes, mAllocCount); - //memset(mNodes, 0, mAllocCount*TTreeNode.sizeof); - for i := 0 to mAllocCount-1 do mNodes[i].clear(); - - // initialize the allocated nodes - for i := 0 to mAllocCount-1 do - begin - mNodes[i].nextNodeId := i+1; - mNodes[i].height := -1; - end; - mNodes[mAllocCount-1].nextNodeId := TTreeNode.NullTreeNode; - mFreeNodeId := 0; -end; - - -// also, checks if the tree structure is valid (for debugging purpose) -function TDynAABBTreeBase.forEachNode (nodeId: Integer; dg: TForEachLeafCB): Boolean; -var - pNode: PTreeNode; - leftChild, rightChild, height: Integer; - aabb: AABB2D; -begin - result := false; - if (nodeId = TTreeNode.NullTreeNode) then exit; - // if it is the root - if (nodeId = mRootNodeId) then assert(mNodes[nodeId].parentId = TTreeNode.NullTreeNode); - // get the children nodes - pNode := @mNodes[nodeId]; - assert(pNode.height >= 0); - if (not pNode.aabb.valid) then - begin - {$IFDEF aabbtree_use_floats} - e_WriteLog(Format('AABB:(%f,%f)-(%f,%f); volume=%f; valid=%d; height=%d; leaf=%d', [pNode.aabb.minX, pNode.aabb.minY, pNode.aabb.maxX, pNode.aabb.maxY, pNode.aabb.volume, Integer(pNode.aabb.valid), pNode.height, Integer(pNode.leaf)]), MSG_NOTIFY); - {$ELSE} - e_WriteLog(Format('AABB:(%d,%d)-(%d,%d); volume=%d; valid=%d; height=%d; leaf=%d', [pNode.aabb.minX, pNode.aabb.minY, pNode.aabb.maxX, pNode.aabb.maxY, pNode.aabb.volume, Integer(pNode.aabb.valid), pNode.height, Integer(pNode.leaf)]), MSG_NOTIFY); - {$ENDIF} - if pNode.leaf then - begin - getFleshAABB(aabb, pNode.flesh, pNode.tag); - {$IFDEF aabbtree_use_floats} - e_WriteLog(Format(' LEAF AABB:(%f,%f)-(%f,%f); valid=%d; volume=%f', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, Integer(aabb.valid), aabb.volume]), MSG_NOTIFY); - {$ELSE} - e_WriteLog(Format(' LEAF AABB:(%d,%d)-(%d,%d); valid=%d; volume=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, Integer(aabb.valid), aabb.volume]), MSG_NOTIFY); - {$ENDIF} - end; - end; - assert(pNode.aabb.valid); - assert(pNode.aabb.volume > 0); - // if the current node is a leaf - if (pNode.leaf) then - begin - assert(pNode.height = 0); - if assigned(dg) then result := dg(pNode.flesh, pNode.aabb); - end - else - begin - leftChild := pNode.children[TTreeNode.Left]; - rightChild := pNode.children[TTreeNode.Right]; - // check that the children node Ids are valid - assert((0 <= leftChild) and (leftChild < mAllocCount)); - assert((0 <= rightChild) and (rightChild < mAllocCount)); - // check that the children nodes have the correct parent node - assert(mNodes[leftChild].parentId = nodeId); - assert(mNodes[rightChild].parentId = nodeId); - // check the height of node - height := 1+dtMaxI(mNodes[leftChild].height, mNodes[rightChild].height); - assert(mNodes[nodeId].height = height); - // check the AABB of the node - aabb := AABB2D.Create(mNodes[leftChild].aabb, mNodes[rightChild].aabb); - assert(aabb.minX = mNodes[nodeId].aabb.minX); - assert(aabb.minY = mNodes[nodeId].aabb.minY); - assert(aabb.maxX = mNodes[nodeId].aabb.maxX); - assert(aabb.maxY = mNodes[nodeId].aabb.maxY); - // recursively check the children nodes - result := forEachNode(leftChild, dg); - if not result then result := forEachNode(rightChild, dg); - end; -end; - - -// also, checks if the tree structure is valid (for debugging purpose) -function TDynAABBTreeBase.forEachLeaf (dg: TForEachLeafCB): Boolean; -begin - // recursively check each node - result := forEachNode(mRootNodeId, dg); -end; - - -// return `true` from visitor to stop immediately -// checker should check if this node should be considered to further checking -// returns tree node if visitor says stop or -1 -function TDynAABBTreeBase.visit (constref caabb: AABB2D; mode: Integer; checker: TVisitCheckerCB; visitor: TQueryOverlapCB; visdg: TQueryOverlapDg; tagmask: Integer): Integer; -const - StackGran = 1024; -var - oldvstused: Integer; - vsp: Integer; - vstk: array of Integer; - nodeId: Integer; - node: PTreeNode; - doNode: Boolean = false; -begin - if not assigned(checker) then begin result := -1; exit; end; - //if not assigned(visitor) and not assigned(visdg) then raise Exception.Create('dyntree: empty visitors aren''t supported'); - oldvstused := vstused; - if (vstused+StackGran > Length(vstack)) then SetLength(vstack, vstused+StackGran); - vsp := vstused; - vstk := vstack; - - {$IFDEF aabbtree_query_count} - mNodesVisited := 0; - mNodesDeepVisited := 0; - {$ENDIF} - - // start from root node - // we can't have nested functions in generics, sorry - {$IF FALSE} - spush(mRootNodeId); - {$ELSE} - if (vsp >= Length(vstk)) then SetLength(vstk, vsp+StackGran); - vstk[vsp] := mRootNodeId; - Inc(vsp); - {$ENDIF} - - // while there are still nodes to visit - while (vsp > oldvstused) do - begin - // get the next node id to visit - // we can't have nested functions in generics, sorry - {$IF FALSE} - nodeId := spop(); - {$ELSE} - Dec(vsp); - nodeId := vstk[vsp]; - {$ENDIF} - // skip it if it is a nil node - if (nodeId = TTreeNode.NullTreeNode) then continue; - {$IFDEF aabbtree_query_count}Inc(mNodesVisited);{$ENDIF} - // get the corresponding node - node := @mNodes[nodeId]; - // should we investigate this node? - case mode of - ModeNoChecks: doNode := checker(node); - ModeAABB: - begin - //doNode := caabb.overlaps(node.aabb); - // this gives small speedup (or not...) - // exit with no intersection if found separated along any axis - if (caabb.maxX < node.aabb.minX) or (caabb.minX > node.aabb.maxX) then doNode := false - else if (caabb.maxY < node.aabb.minY) or (caabb.minY > node.aabb.maxY) then doNode := false - else doNode := true; - end; - ModePoint: - begin - //doNode := node.aabb.contains(caabb.minX, caabb.minY); - // this gives small speedup - doNode := (caabb.minX >= node.aabb.minX) and (caabb.minY >= node.aabb.minY) and (caabb.minX <= node.aabb.maxX) and (caabb.minY <= node.aabb.maxY); - end; - end; - if doNode then - begin - // if the node is a leaf - if (node.leaf) then - begin - // call visitor on it - {$IFDEF aabbtree_query_count}Inc(mNodesDeepVisited);{$ENDIF} - if (tagmask = -1) or ((node.tag and tagmask) <> 0) then - begin - doNode := false; - // update object vars from cache, so recursive calls to `visit()` will work - vstack := vstk; - vstused := vsp; - // call callbacks - if assigned(visitor) then doNode := visitor(node.flesh, node.tag); - if assigned(visdg) and visdg(node.flesh, node.tag) then doNode := true; - // do some sanity checks - if (vstused <> vsp) then raise Exception.Create('internal error in dyntree visitor'); - // should we exit? - if doNode then - begin - result := nodeId; - vstack := vstk; - vstused := oldvstused; - exit; - end; - end; - end - else - begin - // if the node is not a leaf, we need to visit its children - // we can't have nested functions in generics, sorry - {$IF FALSE} - spush(node.children[TTreeNode.Left]); - spush(node.children[TTreeNode.Right]); - {$ELSE} - if (vsp+2 > Length(vstk)) then SetLength(vstk, vsp+StackGran); - vstk[vsp] := node.children[TTreeNode.Left]; - Inc(vsp); - vstk[vsp] := node.children[TTreeNode.Right]; - Inc(vsp); - {$ENDIF} - end; - end; - end; - - result := -1; // oops - vstack := vstk; - vstused := oldvstused; -end; - - -// add `extraAABBGap` to bounding boxes so slight object movement won't cause tree rebuilds -// extra AABB Gap used to allow the collision shape to move a little bit without triggering a large modification of the tree which can be costly -constructor TDynAABBTreeBase.Create (extraAABBGap: TreeNumber=0); -begin - mExtraGap := extraAABBGap; - mNodes := nil; - SetLength(vstack, 2048); - vstused := 0; - setup(); -end; - - -destructor TDynAABBTreeBase.Destroy (); -begin - mNodes := nil; - vstack := nil; - inherited; -end; - - -// clear all the nodes and reset the tree -procedure TDynAABBTreeBase.reset (); -begin - mNodes := nil; - setup(); -end; - - -function TDynAABBTreeBase.computeTreeHeight (): Integer; begin result := computeHeight(mRootNodeId); end; - - -// return the root AABB of the tree -procedure TDynAABBTreeBase.getRootAABB (out aabb: AABB2D); -begin - {$IFDEF aabbtree_many_asserts}assert((mRootNodeId >= 0) and (mRootNodeId < mAllocCount));{$ENDIF} - aabb := mNodes[mRootNodeId].aabb; -end; - - -// does the given id represents a valid object? -// WARNING: ids of removed objects can be reused on later insertions! -function TDynAABBTreeBase.isValidId (id: Integer): Boolean; -begin - result := (id >= 0) and (id < mAllocCount) and (mNodes[id].leaf); -end; - - -// get object by nodeid; can return nil for invalid ids -function TDynAABBTreeBase.getNodeObjectId (nodeid: Integer): TTreeFlesh; -begin - if (nodeid >= 0) and (nodeid < mAllocCount) and (mNodes[nodeid].leaf) then result := mNodes[nodeid].flesh else result := Default(ITP); -end; - -// get fat object AABB by nodeid; returns random shit for invalid ids -procedure TDynAABBTreeBase.getNodeFatAABB (out aabb: AABB2D; nodeid: Integer); -begin - if (nodeid >= 0) and (nodeid < mAllocCount) and (not mNodes[nodeid].isfree) then aabb := AABB2D.Create(mNodes[nodeid].aabb) else aabb := AABB2D.Create(0, 0, 0, 0); -end; - -function TDynAABBTreeBase.getNodeXY (nodeid: Integer; out x, y: Integer): Boolean; inline; -begin - if (nodeid >= 0) and (nodeid < mAllocCount) and (mNodes[nodeid].leaf) then - begin - result := true; - {$IFDEF aabbtree_use_floats} - x := round(mNodes[nodeid].fleshX); - y := round(mNodes[nodeid].fleshY); - {$ELSE} - x := mNodes[nodeid].fleshX; - y := mNodes[nodeid].fleshY; - {$ENDIF} - end - else - begin - result := false; - x := 0; - y := 0; - //if (nodeid >= 0) and (nodeid < mAllocCount) then mNodes[nodeid].dumpToLog(); - end; -end; - - -// insert an object into the tree -// this method creates a new leaf node in the tree and returns the id of the corresponding node or -1 on error -// AABB for static object will not be "fat" (simple optimization) -// WARNING! inserting the same object several times *WILL* break everything! -function TDynAABBTreeBase.insertObject (flesh: TTreeFlesh; tag: Integer; staticObject: Boolean=false): Integer; -var - aabb: AABB2D; - nodeId, fx, fy: Integer; -begin - if not getFleshAABB(aabb, flesh, tag) then - begin - {$IFDEF aabbtree_use_floats} - e_WriteLog(Format('trying to insert FUCKED FLESH:(%f,%f)-(%f,%f); volume=%f; valid=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, aabb.volume, Integer(aabb.valid)]), MSG_WARNING); - {$ELSE} - e_WriteLog(Format('trying to insert FUCKED FLESH:(%d,%d)-(%d,%d); volume=%d; valid=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, aabb.volume, Integer(aabb.valid)]), MSG_WARNING); - {$ENDIF} - //raise Exception.Create('trying to insert invalid flesh in dyntree'); - result := -1; - exit; - end; - if not aabb.valid then - begin - {$IFDEF aabbtree_use_floats} - e_WriteLog(Format('trying to insert FUCKED AABB:(%f,%f)-(%f,%f); volume=%f; valid=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, aabb.volume, Integer(aabb.valid)]), MSG_WARNING); - {$ELSE} - e_WriteLog(Format('trying to insert FUCKED AABB:(%d,%d)-(%d,%d); volume=%d; valid=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, aabb.volume, Integer(aabb.valid)]), MSG_WARNING); - {$ENDIF} - raise Exception.Create('trying to insert invalid aabb in dyntree'); - result := -1; - exit; - end; - //e_WriteLog(Format('inserting AABB:(%f,%f)-(%f,%f); volume=%f; valid=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, aabb.volume, Integer(aabb.valid)]), MSG_NOTIFY); - fx := aabb.minX; - fy := aabb.minY; - nodeId := insertObjectInternal(aabb, staticObject); - {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF} - mNodes[nodeId].flesh := flesh; - mNodes[nodeId].tag := tag; - mNodes[nodeId].fleshX := fx; - mNodes[nodeId].fleshY := fy; - result := nodeId; -end; - - -// remove an object from the tree -// WARNING: ids of removed objects can be reused on later insertions! -procedure TDynAABBTreeBase.removeObject (nodeId: Integer); -begin - if (nodeId < 0) or (nodeId >= mAllocCount) or (not mNodes[nodeId].leaf) then raise Exception.Create('invalid node id in TDynAABBTreeBase'); - // remove the node from the tree - removeLeafNode(nodeId); - releaseNode(nodeId); -end; - - -function TDynAABBTreeBase.updateObject (nodeId: Integer; forceReinsert: Boolean=false): Boolean; overload; -var - newAABB: AABB2D; - dispX, dispY: TreeNumber; -begin - if (nodeId < 0) or (nodeId >= mAllocCount) or (not mNodes[nodeId].leaf) then raise Exception.Create('invalid node id in TDynAABBTreeBase.updateObject'); - - if not getFleshAABB(newAABB, mNodes[nodeId].flesh, mNodes[nodeId].tag) then raise Exception.Create('invalid flesh dimensions in TDynAABBTreeBase.updateObject'); - if not newAABB.valid then raise Exception.Create('invalid flesh aabb in TDynAABBTreeBase.updateObject'); - - dispX := newAABB.minX-mNodes[nodeId].fleshX; - dispY := newAABB.minY-mNodes[nodeId].fleshY; - - if (dispX < -16) then dispX := -16 else if (dispX > 16) then dispX := 16; - if (dispY < -16) then dispY := -16 else if (dispY > 16) then dispY := 16; - - result := updateObject(nodeId, dispX, dispY, forceReinsert); -end; - -function TDynAABBTreeBase.updateObject (nodeId: Integer; dispX, dispY: TreeNumber; forceReinsert: Boolean=false): Boolean; overload; -var - newAABB: AABB2D; - fx, fy: Integer; - node: PTreeNode; -begin - if (nodeId < 0) or (nodeId >= mAllocCount) or (not mNodes[nodeId].leaf) then raise Exception.Create('invalid node id in TDynAABBTreeBase.updateObject'); - - if not getFleshAABB(newAABB, mNodes[nodeId].flesh, mNodes[nodeId].tag) then raise Exception.Create('invalid flesh dimensions in TDynAABBTreeBase.updateObject'); - if not newAABB.valid then raise Exception.Create('invalid flesh aabb in TDynAABBTreeBase.updateObject'); - - fx := newAABB.minX; - fy := newAABB.minY; - - // if the new AABB is still inside the fat AABB of the node - if (not forceReinsert) and (mNodes[nodeId].aabb.contains(newAABB)) then - begin - node := @mNodes[nodeId]; - node.fleshX := fx; - node.fleshY := fy; - result := false; - exit; - end; - - // if the new AABB is outside the fat AABB, we remove the corresponding node - removeLeafNode(nodeId); - - node := @mNodes[nodeId]; - - // compute the fat AABB by inflating the AABB with a constant gap - node.aabb.copyFrom(newAABB); - node.fleshX := fx; - node.fleshY := fy; - - if (not forceReinsert) and ((dispX <> 0) or (dispY <> 0)) then - begin - node.aabb.minX -= mExtraGap; - node.aabb.minY += mExtraGap; - node.aabb.maxX += mExtraGap; - node.aabb.maxY += mExtraGap; - end; - - // inflate the fat AABB in direction of the linear motion of the AABB - if (dispX < 0) then - begin - node.aabb.minX += LinearMotionGapMultiplier*dispX {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF}; - end - else - begin - node.aabb.maxX += LinearMotionGapMultiplier*dispX {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF}; - end; - - if (dispY < 0) then - begin - node.aabb.minY += LinearMotionGapMultiplier*dispY {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF}; - end - else - begin - node.aabb.maxY += LinearMotionGapMultiplier*dispY {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF}; - end; - - {$IFDEF aabbtree_many_asserts}assert(node.aabb.contains(newAABB));{$ENDIF} - - // reinsert the node into the tree - insertLeafNode(nodeId); - - result := true; -end; - - -function TDynAABBTreeBase.checkerAABB (node: PTreeNode): Boolean; -begin - result := chkAABB.overlaps(node.aabb); -end; - - -// report all shapes overlapping with the AABB given in parameter -function TDynAABBTreeBase.aabbQuery (ax, ay, aw, ah: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh; -var - nid: Integer; - oldaabb: AABB2D; -begin - result := Default(ITP); - if not assigned(cb) then exit; - if (aw < 1) or (ah < 1) then exit; - //chkAABB := AABB2D.Create(ax, ay, ax+aw, ay+ah); - oldaabb := chkAABB; - chkAABB.minX := ax; - chkAABB.minY := ay; - chkAABB.maxX := ax+aw; - chkAABB.maxY := ay+ah; - nid := visit(chkAABB, ModeAABB, checkerAABB, cb, nil, tagmask); - chkAABB := oldaabb; - if (nid >= 0) then result := mNodes[nid].flesh else result := Default(ITP); -end; - - -function TDynAABBTreeBase.checkerPoint (node: PTreeNode): Boolean; -begin - result := node.aabb.contains(chkAABB.minX, chkAABB.minY); -end; - - -// report body that contains the given point, or nil -function TDynAABBTreeBase.pointQuery (ax, ay: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh; -var - nid: Integer; - oldaabb: AABB2D; -begin - oldaabb := chkAABB; - chkAABB := AABB2D.Create(ax, ay, ax+1, ay+1); - nid := visit(chkAABB, ModePoint, checkerPoint, cb, nil, tagmask); - {$IFDEF aabbtree_many_asserts}assert((nid < 0) or ((nid >= 0) and (nid < mAllocCount) and (mNodes[nid].leaf)));{$ENDIF} - chkAABB := oldaabb; - if (nid >= 0) then result := mNodes[nid].flesh else result := Default(ITP); -end; - - -function TDynAABBTreeBase.checkerRay (node: PTreeNode): Boolean; -//var tmin: Single = 0; -begin - {$IF FALSE} - result := node.aabb.intersects(curax, curay, curbx, curby, @tmin); - e_WriteLog(Format('intersect: (%f,%f)-(%f,%f) (%d,%d)-(%d,%d) tmin=%f res=%d', [ - minSingle(curax, curbx), - minSingle(curay, curby), - maxSingle(curax, curbx), - maxSingle(curay, curby), - node.aabb.minX, node.aabb.minY, - node.aabb.maxX, node.aabb.maxY, - tmin, - Integer(result), - ]), MSG_NOTIFY); - {$ELSE} - result := false; - if (node.aabb.maxX < minSingle(curax, curbx)) or (node.aabb.maxY < minSingle(curay, curby)) then exit; - if (node.aabb.minX > maxSingle(curax, curbx)) or (node.aabb.minY > maxSingle(curay, curby)) then exit; - result := node.aabb.intersects(traceRay, qSRes.time{, @tmin}); - { - e_WriteLog(Format('intersect: (%f,%f)-(%f,%f) (%d,%d)-(%d,%d) tmin=%f res=%d frac=%f', [ - curax, curay, curbx, curby, - node.aabb.minX, node.aabb.minY, - node.aabb.maxX, node.aabb.maxY, - tmin, - Integer(result), - qSRes.time - ]), MSG_NOTIFY); - } - {$ENDIF} -end; - - -function TDynAABBTreeBase.visitorRay (flesh: TTreeFlesh; tag: Integer): Boolean; -var - hitFraction: Single; - ray: Ray2D; -begin - ray.origX := curax; - ray.origY := curay; - ray.dirX := dirx; - ray.dirY := diry; - hitFraction := sqcb(flesh, ray); - // if the user returned a hitFraction of zero, it means that the raycasting should stop here - if (hitFraction = 0.0) then - begin - qSRes.time := 0; - qSRes.flesh := flesh; - result := true; - exit; - end; - // if the user returned a positive fraction - if (hitFraction > 0.0) then - begin - // we update the maxFraction value and the ray AABB using the new maximum fraction - if (hitFraction < qSRes.time) then - begin - qSRes.time := hitFraction; - qSRes.flesh := flesh; - // fix curb here - //curb := cura+dir*hitFraction; - curbx := curax+dirx*hitFraction; - curby := curay+diry*hitFraction; - end; - end; - result := false; // continue -end; - - -// segment querying method -function TDynAABBTreeBase.segmentQuery (out qr: TSegmentQueryResult; const ax, ay, bx, by: TreeNumber; cb: TSegQueryCallback; tagmask: Integer=-1): Boolean; -var - oldcurax, oldcuray: Single; - oldcurbx, oldcurby: Single; - olddirx, olddiry: Single; - invlen: Single; - osres: PSegmentQueryResult; - osqcb: TSegQueryCallback; - oldray: Ray2D; -begin - qr := TSegmentQueryResult.Create(false); - - if (ax = bx) and (ay = by) then begin result := false; exit; end; - - oldcurax := curax; - oldcuray := curay; - oldcurbx := curbx; - oldcurby := curby; - olddirx := dirx; - olddiry := diry; - oldray := traceRay; - - qr.time := 1.0e100; // infinity - //qr.time := sqrt((bx-ax)*(bx-ax)+(by-ay)*(by-ay))+1.0; - curax := ax; - curay := ay; - curbx := bx; - curby := by; - - dirx := curbx-curax; - diry := curby-curay; - // normalize - invlen := 1.0/sqrt(dirx*dirx+diry*diry); - dirx *= invlen; - diry *= invlen; - - traceRay.origX := curax; - traceRay.origY := curay; - traceRay.dirX := dirx; - traceRay.dirY := diry; - - //chkAABB := AABB2D.Create(0, 0, 1, 1); - osres := qSRes; - qSRes := @qr; - osqcb := sqcb; - sqcb := cb; - visit(chkAABB, ModeNoChecks, checkerRay, nil, visitorRay, tagmask); - qSRes := osres; - sqcb := osqcb; - - curax := oldcurax; - curay := oldcuray; - curbx := oldcurbx; - curby := oldcurby; - dirx := olddirx; - diry := olddiry; - traceRay := oldray; - - if qr.valid and (qr.time <= (bx-ax)*(bx-ax)+(by-ay)*(by-ay)) then - begin - result := true; - end - else - begin - result := false; - qr.flesh := nil; - end; -end; - - -end. diff --git a/src/shared/a_modes.inc b/src/shared/a_modes.inc index 9c5c74c..4853063 100644 --- a/src/shared/a_modes.inc +++ b/src/shared/a_modes.inc @@ -56,9 +56,11 @@ {$IF DEFINED(D2F_DEBUG)} {$STACKFRAMES ON} + {$HINTS OFF} {$ELSE} {$STACKFRAMES OFF} {$ENDIF} +{$WARNINGS ON} {$IFDEF MSWINDOWS} -- 2.29.2