DEADSOFTWARE

map ray tracer now using grid instead of tree
authorKetmar Dark <ketmar@ketmar.no-ip.org>
Mon, 21 Aug 2017 23:07:27 +0000 (02:07 +0300)
committerKetmar Dark <ketmar@ketmar.no-ip.org>
Mon, 21 Aug 2017 23:10:10 +0000 (02:10 +0300)
src/game/g_basic.pas
src/game/g_gfx.pas
src/game/g_grid.pas
src/game/g_map.pas
src/game/g_weapons.pas

index 8e1ae926769f02fa83676e5a685bd9274417d124..1f3add5d538fe6837f5ca0d3a942207da171fcb2 100644 (file)
@@ -201,7 +201,8 @@ begin
   Result := True;
   *)
 
-  if (g_Map_traceToNearestWall(x1, y1, x2, y2, @wallHitX, @wallHitY) >= 0) then
+  //result := false;
+  if g_Map_traceToNearestWall(x1, y1, x2, y2, @wallHitX, @wallHitY) then
   begin
     // check distance
     //result := ((wallHitX-x1)*(wallHitX-x1)+(wallHitY-y1)*(wallHitY-y1) > (x2-x1)*(x2-x1)+(y2-y1)*(y2-y1));
index e96350ebad5d913f5aab3ca4da94d85074916c9b..d6244b7561687a9bcea64545a8adde9873ef0ccc 100644 (file)
@@ -96,8 +96,8 @@ const
   STATE_STICK  = 2;
 
 var
-  Particles: Array of TParticle;
-  OnceAnims: Array of TOnceAnim;
+  Particles: array of TParticle;
+  OnceAnims: array of TOnceAnim;
   MaxParticles: Integer;
   CurrentParticle: Integer;
 
@@ -291,6 +291,7 @@ var
 begin
   Particles := nil;
   SetLength(Particles, MaxParticles);
+  for a := 0 to High(Particles) do Particles[a].State := STATE_FREE;
   CurrentParticle := 0;
 
   if OnceAnims <> nil then
@@ -756,13 +757,16 @@ begin
 end;
 
 procedure g_GFX_SetMax(Count: Integer);
+var
+  a: Integer;
 begin
-  if Count > 50000 then
-    Count := 50000;
+  if Count > 50000 then Count := 50000;
+  if (Count < 1) then Count := 1;
 
   SetLength(Particles, Count);
+  for a := 0 to High(Particles) do Particles[a].State := STATE_FREE;
   MaxParticles := Count;
-  if CurrentParticle >= Count then
+  //if CurrentParticle >= Count then
     CurrentParticle := 0;
 end;
 
index 8ff01a629340b582ad58c0cb40046f8b80c251a3..661e341866708dcc7874ec9dedf7ad0721626d7f 100644 (file)
@@ -27,6 +27,7 @@ type
   generic TBodyGridBase<ITP> = class(TObject)
   public
     type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
+    type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: Integer): Boolean is nested; // return `true` to stop
 
   private
     const
@@ -39,7 +40,7 @@ type
       TBodyProxyRec = record
       private
         mX, mY, mWidth, mHeight: Integer; // aabb
-        mQueryMark: DWord; // was this object visited at this query?
+        mQueryMark: LongWord; // was this object visited at this query?
         mObj: ITP;
         mTag: Integer;
         nextLink: TBodyProxyId; // next free or nothing
@@ -67,7 +68,7 @@ type
     mGrid: array of Integer; // mWidth*mHeight, index in mCells
     mCells: array of TGridCell; // cell pool
     mFreeCell: Integer; // first free cell index or -1
-    mLastQuery: DWord;
+    mLastQuery: LongWord;
     mUsedCells: Integer;
     mProxies: array of TBodyProxyRec;
     mProxyFree: TBodyProxyId; // free
@@ -77,6 +78,7 @@ type
     mUData: TBodyProxyId; // for inserter/remover
     mTagMask: Integer; // for iterator
     mItCB: TGridQueryCB; // for iterator
+    mQueryInProcess: Boolean;
 
   private
     function allocCell: Integer;
@@ -105,8 +107,13 @@ type
     procedure resizeBody (body: TBodyProxyId; sx, sy: Integer);
     procedure moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer);
 
+    //WARNING: can't do recursive queries
     function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1): Boolean;
 
+    //WARNING: can't do recursive queries
+    // cb with `(nil)` will be called before processing new tile
+    function traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): Boolean; overload;
+
     procedure dumpStats ();
   end;
 
@@ -173,6 +180,7 @@ begin
   mUData := 0;
   mTagMask := -1;
   mItCB := nil;
+  mQueryInProcess := false;
   e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
 end;
 
@@ -311,6 +319,133 @@ begin
 end;
 
 
+// ////////////////////////////////////////////////////////////////////////// //
+function TBodyGridBase.traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): Boolean;
+var
+  i: Integer;
+  dx, dy: Integer;
+  xerr, yerr, d: LongWord;
+  incx, incy: Integer;
+  x, y: Integer;
+  maxx, maxy: Integer;
+  tsize: Integer; // tile size
+  gw, gh: Integer;
+  lastGA: Integer = -1;
+  ga: Integer = -1; // last used grid address
+  ccidx: Integer = -1;
+  curci: Integer = -1;
+  cc: PGridCell = nil;
+  hasUntried: Boolean;
+  f: Integer;
+  px: PBodyProxyRec;
+  lq: LongWord;
+  prevX, prevY: Integer;
+  minx, miny: Integer;
+begin
+  result := False;
+
+  if (tagmask = 0) then exit;
+
+  // make coords (0,0)-based
+  minx := mMinX;
+  miny := mMinY;
+  Dec(x0, minx);
+  Dec(y0, miny);
+  Dec(x1, minx);
+  Dec(y1, miny);
+
+  xerr := 0;
+  yerr := 0;
+  dx := x1-x0;
+  dy := y1-y0;
+
+  if (dx > 0) then incx := 1 else if (dx < 0) then incx := -1 else incx := 0;
+  if (dy > 0) then incy := 1 else if (dy < 0) then incy := -1 else incy := 0;
+
+  dx := abs(dx);
+  dy := abs(dy);
+
+  if (dx > dy) then d := dx else d := dy;
+
+  x := x0;
+  y := y0;
+
+  // increase query counter
+  Inc(mLastQuery);
+  if (mLastQuery = 0) then
+  begin
+    // just in case of overflow
+    mLastQuery := 1;
+    for i := 0 to High(mProxies) do mProxies[i].mQueryMark := 0;
+  end;
+  lq := mLastQuery;
+
+  tsize := mTileSize;
+  gw := mWidth;
+  gh := mHeight;
+  maxx := gw*tsize-1;
+  maxy := gh*tsize-1;
+
+  for i := 1 to d do
+  begin
+    prevX := x;
+    prevY := y;
+    Inc(xerr, dx); if (xerr > d) then begin Dec(xerr, d); Inc(x, incx); end;
+    Inc(yerr, dy); if (yerr > d) then begin Dec(yerr, d); Inc(y, incy); end;
+
+    if (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy) then
+    begin
+      ga := (y div tsize)*gw+(x div tsize);
+      if (lastGA <> ga) then
+      begin
+        // new cell
+        lastGA := ga;
+        ccidx := mGrid[lastGA];
+        if (ccidx <> -1) then
+        begin
+          result := cb(nil, 0, x+minx, y+miny, prevX+minx, prevY+miny);
+          if result then exit;
+        end;
+      end;
+    end
+    else
+    begin
+      ccidx := -1;
+    end;
+
+    if (ccidx <> -1) then
+    begin
+      curci := ccidx;
+      hasUntried := false;
+      while (curci <> -1) do
+      begin
+        cc := @mCells[curci];
+        for f := 0 to High(TGridCell.bodies) do
+        begin
+          if (cc.bodies[f] = -1) then break;
+          px := @mProxies[cc.bodies[f]];
+          if (px.mQueryMark <> lq) and ((px.mTag and tagmask) <> 0) then
+          begin
+            if (x+minx >= px.mX) and (y+miny >= px.mY) and (x+minx < px.mX+px.mWidth) and (y+miny < px.mY+px.mHeight) then
+            begin
+              px.mQueryMark := lq;
+              result := cb(px.mObj, px.mTag, x+minx, y+miny, prevX+minx, prevY+miny);
+              if result then exit;
+            end
+            else
+            begin
+              hasUntried := true;
+            end;
+          end;
+        end;
+        curci := cc.next;
+      end;
+      if not hasUntried then ccidx := -1; // don't process this cell anymore
+    end;
+  end;
+end;
+
+
 function TBodyGridBase.inserter (grida: Integer): Boolean;
 var
   cidx: Integer;
@@ -358,14 +493,11 @@ end;
 procedure TBodyGridBase.insert (body: TBodyProxyId);
 var
   px: PBodyProxyRec;
-  oudata: Integer;
 begin
   if (body < 0) or (body > High(mProxies)) then exit; // just in case
   px := @mProxies[body];
-  oudata := mUData;
   mUData := body;
   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter);
-  mUData := oudata;
 end;
 
 
@@ -430,29 +562,32 @@ end;
 procedure TBodyGridBase.remove (body: TBodyProxyId);
 var
   px: PBodyProxyRec;
-  oudata: Integer;
 begin
   if (body < 0) or (body > High(mProxies)) then exit; // just in case
   px := @mProxies[body];
-  oudata := mUData;
   mUData := body;
   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover);
-  mUData := oudata;
 end;
 
 
 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=0): TBodyProxyId;
 begin
+  if mQueryInProcess then raise Exception.Create('grid doesn''t support recursive queries');
+  mQueryInProcess := true;
   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
   insert(result);
+  mQueryInProcess := false;
 end;
 
 
 procedure TBodyGridBase.removeBody (aObj: TBodyProxyId);
 begin
   if (aObj < 0) or (aObj > High(mProxies)) then exit; // just in case
+  if mQueryInProcess then raise Exception.Create('grid doesn''t support recursive queries');
+  mQueryInProcess := true;
   remove(aObj);
   freeProxy(aObj);
+  mQueryInProcess := false;
 end;
 
 
@@ -462,6 +597,8 @@ var
 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;
+  if mQueryInProcess then raise Exception.Create('grid doesn''t support recursive queries');
+  mQueryInProcess := true;
   remove(body);
   px := @mProxies[body];
   Inc(px.mX, dx);
@@ -469,6 +606,7 @@ begin
   Inc(px.mWidth, sx);
   Inc(px.mHeight, sy);
   insert(body);
+  mQueryInProcess := false;
 end;
 
 procedure TBodyGridBase.moveBody (body: TBodyProxyId; dx, dy: Integer);
@@ -528,12 +666,13 @@ end;
 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1): Boolean;
 var
   idx: Integer;
-  otagmask: Integer;
-  ocb: TGridQueryCB;
 begin
   result := false;
   if not assigned(cb) then exit;
 
+  if mQueryInProcess then raise Exception.Create('grid doesn''t support recursive queries');
+  mQueryInProcess := true;
+
   // increase query counter
   Inc(mLastQuery);
   if (mLastQuery = 0) then
@@ -544,13 +683,10 @@ begin
   end;
   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
 
-  otagmask := mTagMask;
   mTagMask := tagmask;
-  ocb := mItCB;
   mItCB := cb;
   result := forGridRect(x, y, w, h, iterator);
-  mTagMask := otagmask;
-  mItCB := ocb;
+  mQueryInProcess := false;
 end;
 
 
index d6f9657de2ad3afd05557ee0e8bed17aa68589c3..d4fbcf1830150dc64250d74e257e790b0635fc5b 100644 (file)
@@ -92,7 +92,7 @@ procedure g_Map_LoadState(Var Mem: TBinMemoryReader);
 procedure g_Map_DrawPanelShadowVolumes(lightX: Integer; lightY: Integer; radius: Integer);
 
 // returns wall index in `gWalls` or -1
-function g_Map_traceToNearestWall (x0, y0, x1, y1: Integer; hitx: PInteger=nil; hity: PInteger=nil): Integer;
+function g_Map_traceToNearestWall (x0, y0, x1, y1: Integer; hitx: PInteger=nil; hity: PInteger=nil): Boolean;
 
 type
   TForEachPanelCB = function (pan: TPanel): Boolean; // return `true` to stop
@@ -292,7 +292,8 @@ end;
 
 
 // wall index in `gWalls` or -1
-function g_Map_traceToNearestWall (x0, y0, x1, y1: Integer; hitx: PInteger=nil; hity: PInteger=nil): Integer;
+(*
+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
@@ -356,6 +357,53 @@ begin
     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, lastDist: Integer;
+  wasHit: Boolean = false;
+
+  // pan=nil: before processing new tile
+  function sqchecker (pan: TPanel; tag: Integer; x, y, prevx, prevy: Integer): Boolean;
+  var
+    dist: 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;
+      dist := (prevx-x0)*(prevx-x0)+(prevy-y0)*(prevy-y0);
+      if (dist < lastDist) then
+      begin
+        wasHit := true;
+        lastDist := dist;
+        lastX := prevx;
+        lastY := prevy;
+      end;
+    end;
+  end;
+
+begin
+  result := false;
+  if (gMapGrid = nil) then exit;
+  lastDist := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0)+1;
+  lastX := 0;
+  lastY := 0;
+  result := gMapGrid.traceRay(x0, y0, x1, y1, sqchecker, (GridTagWall or GridTagDoor));
+  if (hitx <> nil) then hitx^ := lastX;
+  if (hity <> nil) then hity^ := lastY;
+end;
 
 
 function g_Map_ForEachPanelAt (x, y: Integer; cb: TForEachPanelCB; panelType: Word): Boolean;
@@ -369,20 +417,19 @@ function g_Map_ForEachPanelAt (x, y: Integer; cb: TForEachPanelCB; panelType: Wo
       if not pan.Enabled then exit;
     end;
 
+    result := (x >= pan.X) and (y >= pan.Y) and (x < pan.X+pan.Width) and (y < pan.Y+pan.Height);
+    if not result then exit;
+
     if ((tag and GridTagLift) <> 0) then
     begin
       result :=
         ((WordBool(PanelType and PANEL_LIFTUP) and (pan.LiftType = 0)) or
          (WordBool(PanelType and PANEL_LIFTDOWN) and (pan.LiftType = 1)) or
          (WordBool(PanelType and PANEL_LIFTLEFT) and (pan.LiftType = 2)) or
-         (WordBool(PanelType and PANEL_LIFTRIGHT) and (pan.LiftType = 3))) and
-         (x >= pan.X) and (y >= pan.Y) and (x < pan.X+pan.Width) and (y < pan.Y+pan.Height);
-      if result then result := cb(pan);;
-      exit;
+         (WordBool(PanelType and PANEL_LIFTRIGHT) and (pan.LiftType = 3)));
     end;
 
     // other shit
-    result := (x >= pan.X) and (y >= pan.Y) and (x < pan.X+pan.Width) and (y < pan.Y+pan.Height);
     if result then result := cb(pan);
   end;
 
@@ -391,8 +438,6 @@ var
 begin
   result := false;
   if not assigned(cb) then exit;
-  //if (mapTree = nil) then exit;
-  //function TDynAABBTreeBase.pointQuery (ax, ay: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh;
 
   if WordBool(PanelType and (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_OPENDOOR)) then tagmask := tagmask or (GridTagWall or GridTagDoor);
   if WordBool(PanelType and PANEL_WATER) then tagmask := tagmask or GridTagWater;
index d52abc5fb519b33ed746296c632eae8a64cc6a3f..46b0d776582796efaacb7644d012fe1c49d86c64 100644 (file)
@@ -1763,7 +1763,7 @@ var
   xe, ye: Integer;
   s, c: Extended;
   i: Integer;
-  wallHitIdx: Integer = -1;
+  wallHitFlag: Boolean = false;
   wallHitX: Integer = 0;
   wallHitY: Integer = 0;
   didHit: Boolean = false;
@@ -1806,8 +1806,8 @@ begin
   stt := curTimeMicro();
   {$ENDIF}
 
-  wallHitIdx := g_Map_traceToNearestWall(x, y, x2, y2, @wallHitX, @wallHitY);
-  if (wallHitIdx >= 0) then
+  wallHitFlag := g_Map_traceToNearestWall(x, y, x2, y2, @wallHitX, @wallHitY);
+  if wallHitFlag then
   begin
     x2 := wallHitX;
     y2 := wallHitY;
@@ -1848,13 +1848,13 @@ begin
       // need new coords for trigger
       wallHitX := xe;
       wallHitY := ye;
-      wallHitIdx := -1; // no sparks
+      wallHitFlag := false; // no sparks
       break;
     end;
   end;
 
   // need sparks?
-  if (wallHitIdx >= 0) then
+  if wallHitFlag then
   begin
     {$IF DEFINED(D2F_DEBUG)}
     stt := curTimeMicro()-stt;