DEADSOFTWARE

`Grid.forEachAtPoint()` converted to no-callback
authorKetmar Dark <ketmar@ketmar.no-ip.org>
Thu, 18 Jan 2018 12:46:55 +0000 (14:46 +0200)
committerKetmar Dark <ketmar@ketmar.no-ip.org>
Thu, 18 Jan 2018 12:48:26 +0000 (14:48 +0200)
src/game/g_grid.pas
src/game/g_holmes.pas
src/game/g_map.pas

index 41f03adea7bcf5fbd0bd7f3f6b402e840c4b955d..02624b7f9eafd40c7133a49fb534699a1cd780d2 100644 (file)
@@ -144,7 +144,7 @@ type
     mProxyFree: TBodyProxyId; // free
     mProxyCount: Integer; // currently used
     mProxyMaxCount: Integer;
-    mInQuery: Boolean;
+    //mInQuery: Boolean;
 
   public
     dbgShowTraceLog: Boolean;
@@ -200,7 +200,8 @@ type
     //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 object on the first hit or nil
-    function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
+    //function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1{; exittag: PInteger=nil}): ITP;
+    function forEachAtPoint (x, y: Integer; tagmask: Integer=-1; allowDisabled: Boolean=false; firstHit: Boolean=false): Integer;
 
     function atCellInPoint (x, y: Integer): TAtPointEnumerator;
 
@@ -1340,7 +1341,7 @@ end;
 
 // ////////////////////////////////////////////////////////////////////////// //
 // no callback: return `true` on the first hit
-function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
+function TBodyGridBase.forEachAtPoint (x, y: Integer; tagmask: Integer=-1; allowDisabled: Boolean=false; firstHit: Boolean=false): Integer;
 var
   f: Integer;
   idx, curci: Integer;
@@ -1348,9 +1349,9 @@ var
   px: PBodyProxyRec;
   lq: LongWord;
   ptag: Integer;
+  presobj: PITP;
 begin
-  result := Default(ITP);
-  if (exittag <> nil) then exittag^ := 0;
+  result := 0;
   tagmask := tagmask and TagFullMask;
   if (tagmask = 0) then exit;
 
@@ -1390,7 +1391,7 @@ begin
   while (curci <> -1) do
   begin
     {$IF DEFINED(D2F_DEBUG_XXQ)}
-    if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
+    //if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
     {$ENDIF}
     cc := @mCells[curci];
     for f := 0 to GridCellBucketSize-1 do
@@ -1398,32 +1399,19 @@ begin
       if (cc.bodies[f] = -1) then break;
       px := @mProxies[cc.bodies[f]];
       {$IF DEFINED(D2F_DEBUG_XXQ)}
-      if (assigned(cb)) then e_WriteLog(Format('  proxy #%d; qm:%u; tag:%08x; tagflag:%d  %u', [cc.bodies[f], px.mQueryMark, px.mTag, (px.mTag and tagmask), LongWord(px.mObj)]), MSG_NOTIFY);
+      //if (assigned(cb)) then e_WriteLog(Format('  proxy #%d; qm:%u; tag:%08x; tagflag:%d  %u', [cc.bodies[f], px.mQueryMark, px.mTag, (px.mTag and tagmask), LongWord(px.mObj)]), MSG_NOTIFY);
       {$ENDIF}
-      // shit. has to do it this way, so i can change tag in callback
-      if (px.mQueryMark <> lq) then
+      if (px.mQueryMark = lq) then continue;
+      px.mQueryMark := lq;
+      ptag := px.mTag;
+      if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
+      if ((ptag and tagmask) = 0) then continue;
+      if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
       begin
-        px.mQueryMark := lq;
-        ptag := px.mTag;
-        if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
-           (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
-        begin
-          if assigned(cb) then
-          begin
-            if cb(px.mObj, ptag) then
-            begin
-              result := px.mObj;
-              if (exittag <> nil) then exittag^ := ptag;
-              exit;
-            end;
-          end
-          else
-          begin
-            result := px.mObj;
-            if (exittag <> nil) then exittag^ := ptag;
-            exit;
-          end;
-        end;
+        presobj := PITP(framePool.alloc(sizeof(ITP)));
+        Move(px.mObj, presobj^, sizeof(ITP));
+        Inc(result);
+        if (firstHit) then begin {mInQuery := false;} exit; end;
       end;
     end;
     curci := cc.next;
@@ -1451,6 +1439,13 @@ var
 begin
   result := 0;
   if (w < 1) or (h < 1) then exit;
+
+  if (w = 1) and (h = 1) then
+  begin
+    result := forEachAtPoint(x, y, tagmask, allowDisabled, firstHit);
+    exit;
+  end;
+
   tagmask := tagmask and TagFullMask;
   if (tagmask = 0) then exit;
 
@@ -1480,8 +1475,8 @@ begin
   if (sx > ex) or (sy > ey) then exit; // just in case
 
   // has something to do
-  if mInQuery then raise Exception.Create('recursive queries aren''t supported');
-  mInQuery := true;
+  //if mInQuery then raise Exception.Create('recursive queries aren''t supported');
+  //mInQuery := true;
 
   // increase query counter
   Inc(mLastQuery);
@@ -1519,7 +1514,7 @@ begin
           presobj := PITP(framePool.alloc(sizeof(ITP)));
           Move(px.mObj, presobj^, sizeof(ITP));
           Inc(result);
-          if (firstHit) then begin mInQuery := false; exit; end;
+          if (firstHit) then begin {mInQuery := false;} exit; end;
           (*
           if assigned(cb) then
           begin
@@ -1538,7 +1533,7 @@ begin
     end;
   end;
 
-  mInQuery := false;
+  //mInQuery := false;
 end;
 
 
@@ -1576,8 +1571,8 @@ begin
   lw := TLineWalker.Create(0, 0, gw*mTileSize-1, gh*mTileSize-1);
   if not lw.setup(x0, y0, x1, y1) then exit; // out of screen
 
-  if mInQuery then raise Exception.Create('recursive queries aren''t supported');
-  mInQuery := true;
+  //if mInQuery then raise Exception.Create('recursive queries aren''t supported');
+  //mInQuery := true;
 
   // increase query counter
   Inc(mLastQuery);
@@ -1608,7 +1603,7 @@ begin
           if cb(px.mObj, ptag) then
           begin
             result := px.mObj;
-            mInQuery := false;
+            //mInQuery := false;
             exit;
           end;
         end;
@@ -1619,7 +1614,7 @@ begin
     // done processing cells, move to next tile
   until lw.stepToNextTile();
 
-  mInQuery := false;
+  //mInQuery := false;
 end;
 
 
@@ -1661,8 +1656,8 @@ begin
   // just in case
   if (cx0 > cx1) or (cy0 > cy1) then exit;
 
-  if mInQuery then raise Exception.Create('recursive queries aren''t supported');
-  mInQuery := true;
+  //if mInQuery then raise Exception.Create('recursive queries aren''t supported');
+  //mInQuery := true;
 
   // increase query counter
   Inc(mLastQuery);
@@ -1704,7 +1699,7 @@ begin
               begin
                 ex := ax0;
                 ey := ay0;
-                mInQuery := false;
+                //mInQuery := false;
                 exit;
               end;
             end;
@@ -1728,7 +1723,7 @@ begin
     end;
   end;
 
-  mInQuery := false;
+  //mInQuery := false;
 end;
 
 
@@ -1749,6 +1744,7 @@ var
   {$IF DEFINED(D2F_DEBUG_OTR)}
   s: AnsiString = '';
   {$ENDIF}
+  pmark: PoolMark;
 begin
   result := false;
   ex := ax1;
@@ -1758,7 +1754,9 @@ begin
   tagmask := tagmask and TagFullMask;
   if (tagmask = 0) then exit;
 
-  if (forEachAtPoint(ax0, ay0, nil, tagmask) = nil) then exit;
+  pmark := framePool.mark();
+  if (forEachAtPoint(ax0, ay0, tagmask, false, true) = 0) then exit;
+  framePool.release(pmark);
 
   minx := mMinX;
   miny := mMinY;
@@ -1916,8 +1914,8 @@ begin
   //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln('*** traceRay: (%s,%s)-(%s,%s)', [x0, y0, x1, y1]);
   {$ENDIF}
 
-  if mInQuery then raise Exception.Create('recursive queries aren''t supported');
-  mInQuery := true;
+  //if mInQuery then raise Exception.Create('recursive queries aren''t supported');
+  //mInQuery := true;
 
   // increase query counter
   Inc(mLastQuery);
@@ -1968,7 +1966,7 @@ begin
             ex := ax0;
             ey := ay0;
             result := px.mObj;
-            mInQuery := false;
+            //mInQuery := false;
             {$IF DEFINED(D2F_DEBUG)}
             if assigned(dbgRayTraceTileHitCB) then e_LogWriteln('  INSIDE!');
             {$ENDIF}
@@ -1998,12 +1996,12 @@ begin
     end;
     // done processing cells; exit if we registered a hit
     // next cells can't have better candidates, obviously
-    if wasHit then begin mInQuery := false; exit; end;
+    if wasHit then begin {mInQuery := false;} exit; end;
     firstCell := false;
     // move to next tile
   until lw.stepToNextTile();
 
-  mInQuery := false;
+  //mInQuery := false;
 end;
 
 
index 60aa34b159d10418be898938321f893d87d8c09c..142e2be2a4f1933ef463ead57b5256bae6574503 100644 (file)
@@ -19,7 +19,7 @@ unit g_holmes;
 interface
 
 uses
-  {$IFDEF USE_MEMPOOL}mempool,{$ENDIF} geom,
+  mempool, geom,
   e_log, e_input,
   g_textures, g_basic, e_graphics, g_phys, g_grid, g_player, g_monsters,
   g_window, g_map, g_triggers, g_items, g_game, g_panel, g_console, g_gfx,
@@ -1515,7 +1515,7 @@ procedure dbgToggleTraceBox (arg: Integer=-1); begin if (arg < 0) then showTrace
 procedure dbgToggleHolmesPause (arg: Integer=-1); begin if (arg < 0) then g_Game_HolmesPause(not gPauseHolmes) else g_Game_HolmesPause(arg > 0); end;
 
 procedure cbAtcurSelectMonster ();
-  function monsAtDump (mon: TMonster; tag: Integer): Boolean;
+  function monsAtDump (mon: TMonster{; tag: Integer}): Boolean;
   begin
     result := true; // stop
     e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), TMsgType.Notify);
@@ -1525,6 +1525,9 @@ procedure cbAtcurSelectMonster ();
 var
   plr: TPlayer;
   x, y, w, h: Integer;
+  pmark: PoolMark;
+  hitcount: Integer;
+  pmon: PMonster;
 begin
   monMarkedUID := -1;
   if (Length(gPlayers) > 0) then
@@ -1540,24 +1543,49 @@ begin
     end;
   end;
   //e_WriteLog('===========================', MSG_NOTIFY);
-  monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump);
+  pmark := framePool.mark();
+  hitcount := monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY);
+  pmon := PMonster(framePool.getPtr(pmark));
+  while (hitcount > 0) do
+  begin
+    monsAtDump(pmon^);
+    Inc(pmon);
+    Dec(hitcount);
+  end;
+  framePool.release(pmark);
   //e_WriteLog('---------------------------', MSG_NOTIFY);
 end;
 
 procedure cbAtcurDumpMonsters ();
-  function monsAtDump (mon: TMonster; tag: Integer): Boolean;
+  function monsAtDump (mon: TMonster{; tag: Integer}): Boolean;
   begin
     result := false; // don't stop
     e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), TMsgType.Notify);
   end;
+var
+  pmark: PoolMark;
+  hitcount: Integer;
+  pmon: PMonster;
 begin
-  e_WriteLog('===========================', TMsgType.Notify);
-  monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump);
-  e_WriteLog('---------------------------', TMsgType.Notify);
+  pmark := framePool.mark();
+  hitcount := monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY);
+  if (hitcount > 0) then
+  begin
+    e_WriteLog('===========================', TMsgType.Notify);
+    pmon := PMonster(framePool.getPtr(pmark));
+    while (hitcount > 0) do
+    begin
+      monsAtDump(pmon^);
+      Inc(pmon);
+      Dec(hitcount);
+    end;
+    e_WriteLog('---------------------------', TMsgType.Notify);
+  end;
+  framePool.release(pmark);
 end;
 
 procedure cbAtcurDumpWalls ();
-  function wallToggle (pan: TPanel; tag: Integer): Boolean;
+  function wallToggle (pan: TPanel{; tag: Integer}): Boolean;
   begin
     result := false; // don't stop
     if (platMarkedGUID = -1) then platMarkedGUID := pan.guid;
@@ -1568,11 +1596,26 @@ var
   hasTrigs: Boolean = false;
   f: Integer;
   trig: PTrigger;
+  pmark: PoolMark;
+  hitcount: Integer;
+  ppan: PPanel;
 begin
   platMarkedGUID := -1;
-  e_WriteLog('=== TOGGLE WALL ===', TMsgType.Notify);
-  mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor));
-  e_WriteLog('--- toggle wall ---', TMsgType.Notify);
+  pmark := framePool.mark();
+  hitcount := mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, (GridTagWall or GridTagDoor));
+  if (hitcount > 0) then
+  begin
+    e_WriteLog('=== TOGGLE WALL ===', TMsgType.Notify);
+    ppan := PPanel(framePool.getPtr(pmark));
+    while (hitcount > 0) do
+    begin
+      wallToggle(ppan^);
+      Inc(ppan);
+      Dec(hitcount);
+    end;
+    e_WriteLog('--- toggle wall ---', TMsgType.Notify);
+  end;
+  framePool.release(pmark);
   if showTriggers then
   begin
     for f := 0 to High(gTriggers) do
@@ -1589,16 +1632,29 @@ begin
 end;
 
 procedure cbAtcurToggleWalls ();
-  function wallToggle (pan: TPanel; tag: Integer): Boolean;
+  function wallToggle (pan: TPanel{; tag: Integer}): Boolean;
   begin
     result := false; // don't stop
     //e_WriteLog(Format('wall #%d(%d); enabled=%d (%d); (%d,%d)-(%d,%d)', [pan.arrIdx, pan.proxyId, Integer(pan.Enabled), Integer(mapGrid.proxyEnabled[pan.proxyId]), pan.X, pan.Y, pan.Width, pan.Height]), MSG_NOTIFY);
     if pan.Enabled then g_Map_DisableWallGUID(pan.guid) else g_Map_EnableWallGUID(pan.guid);
   end;
+var
+  pmark: PoolMark;
+  hitcount: Integer;
+  ppan: PPanel;
 begin
   //e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
-  mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor));
   //e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
+  pmark := framePool.mark();
+  hitcount := mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, (GridTagWall or GridTagDoor));
+  ppan := PPanel(framePool.getPtr(pmark));
+  while (hitcount > 0) do
+  begin
+    wallToggle(ppan^);
+    Inc(ppan);
+    Dec(hitcount);
+  end;
+  framePool.release(pmark);
 end;
 
 
index 8e1068263bf2267005b9ab8f3f8adca6e0398eb4..29ece6fafd845f590715a7502689b9fc1dc2630a 100644 (file)
@@ -594,6 +594,21 @@ begin
 end;
 
 
+function xxPanAtPointChecker (pan: TPanel; panelType: Word): Boolean; inline;
+begin
+  if ((pan.tag and GridTagLift) <> 0) then
+  begin
+    // stop if the lift of the right type
+    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)));
+    exit;
+  end;
+  result := true; // otherwise, stop anyway, 'cause `forEachAtPoint()` is guaranteed to call this only for correct panels
+end;
+
 function g_Map_HasAnyPanelAtPoint (x, y: Integer; panelType: Word): Boolean;
 
   function checker (pan: TPanel; tag: Integer): Boolean;
@@ -622,6 +637,9 @@ function g_Map_HasAnyPanelAtPoint (x, y: Integer; panelType: Word): Boolean;
 
 var
   tagmask: Integer = 0;
+  pmark: PoolMark;
+  hitcount: Integer;
+  ppan: PPanel;
 begin
   result := false;
 
@@ -634,24 +652,41 @@ begin
   if WordBool(PanelType and PANEL_BLOCKMON) then tagmask := tagmask or GridTagBlockMon;
 
   if (tagmask = 0) then exit;// just in case
+
+  pmark := framePool.mark();
   if ((tagmask and GridTagLift) <> 0) then
   begin
     // slow
-    result := (mapGrid.forEachAtPoint(x, y, checker, tagmask) <> nil);
+    hitcount := mapGrid.forEachAtPoint(x, y, tagmask);
+    ppan := PPanel(framePool.getPtr(pmark));
+    while (hitcount > 0) do
+    begin
+      if (xxPanAtPointChecker(ppan^, PanelType)) then begin result := true; break; end;
+      Inc(ppan);
+      Dec(hitcount);
+    end;
   end
   else
   begin
     // fast
-    result := (mapGrid.forEachAtPoint(x, y, nil, tagmask) <> nil);
+    result := (mapGrid.forEachAtPoint(x, y, tagmask, false, true) <> 0); // firsthit
   end;
+  framePool.release(pmark);
 end;
 
 
 function g_Map_PanelAtPoint (x, y: Integer; tagmask: Integer=-1): TPanel;
+var
+  pmark: PoolMark;
+  hitcount: Integer;
 begin
   result := nil;
   if (tagmask = 0) then exit;
-  result := mapGrid.forEachAtPoint(x, y, nil, tagmask);
+  //result := mapGrid.forEachAtPoint(x, y, nil, tagmask);
+  pmark := framePool.mark();
+  hitcount := mapGrid.forEachAtPoint(x, y, tagmask, false, true); // firsthit
+  if (hitcount <> 0) then result := PPanel(framePool.getPtr(pmark))^;
+  framePool.release(pmark);
 end;
 
 
@@ -3433,14 +3468,16 @@ begin
   topx := x;
   topy := y;
   // started outside of the liquid?
-  if (mapGrid.forEachAtPoint(x, y, nil, MaskLiquid) = nil) then begin result := false; exit; end;
+  //if (mapGrid.forEachAtPoint(x, y, nil, MaskLiquid) = nil) then begin result := false; exit; end;
+  if (g_Map_PanelAtPoint(x, y, MaskLiquid) = nil) then begin result := false; exit; end;
   if (dx = 0) and (dy = 0) then begin result := false; exit; end; // sanity check
   result := true;
   while true do
   begin
     Inc(x, dx);
     Inc(y, dy);
-    if (mapGrid.forEachAtPoint(x, y, nil, MaskLiquid) = nil) then exit; // out of the water, just exit
+    //if (mapGrid.forEachAtPoint(x, y, nil, MaskLiquid) = nil) then exit; // out of the water, just exit
+    if (g_Map_PanelAtPoint(x, y, MaskLiquid) = nil) then exit; // out of the water, just exit
     topx := x;
     topy := y;
   end;