DEADSOFTWARE

fixed bug in grid updates for moving objects
authorKetmar Dark <ketmar@ketmar.no-ip.org>
Wed, 23 Aug 2017 16:45:57 +0000 (19:45 +0300)
committerKetmar Dark <ketmar@ketmar.no-ip.org>
Wed, 23 Aug 2017 18:23:56 +0000 (21:23 +0300)
  and God says: thou should check all corners!

src/game/g_grid.pas
src/game/g_holmes.pas
src/game/g_map.pas
src/game/g_monsters.pas
src/game/g_window.pas

index 27b553a30b26e98a9ad63dbfeb63aa2c890dee54..81f19c12af6fbfc64072bbd7dbb35510ef8cf6b2 100644 (file)
@@ -541,6 +541,7 @@ end;
 function TBodyGridBase.allocCell (): Integer;
 var
   idx: Integer;
+  pc: PGridCell;
 begin
   if (mFreeCell < 0) then
   begin
@@ -550,14 +551,16 @@ begin
     for idx := mFreeCell to High(mCells) do
     begin
       mCells[idx].bodies[0] := -1;
+      mCells[idx].bodies[High(TGridCell.bodies)] := -1; // 'has free room' flag
       mCells[idx].next := idx+1;
     end;
     mCells[High(mCells)].next := -1; // last cell
   end;
   result := mFreeCell;
-  mFreeCell := mCells[result].next;
-  mCells[result].next := -1;
-  mCells[result].bodies[0] := -1;
+  pc := @mCells[result];
+  mFreeCell := pc.next;
+  pc.next := -1;
+  //pc.bodies[0] := -1;
   Inc(mUsedCells);
   //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
 end;
@@ -567,9 +570,12 @@ procedure TBodyGridBase.freeCell (idx: Integer);
 begin
   if (idx >= 0) and (idx < Length(mCells)) then
   begin
-    //if mCells[idx].body = -1 then exit; // the thing that should not be
-    mCells[idx].bodies[0] := -1;
-    mCells[idx].next := mFreeCell;
+    with mCells[idx] do
+    begin
+      bodies[0] := -1;
+      bodies[High(TGridCell.bodies)] := -1; // 'has free room' flag
+      next := mFreeCell;
+    end;
     mFreeCell := idx;
     Dec(mUsedCells);
   end;
@@ -663,23 +669,27 @@ begin
   if (pc <> -1) then
   begin
     pi := @mCells[pc];
-    f := 0;
-    for f := 0 to High(TGridCell.bodies) do
+    if (pi.bodies[High(TGridCell.bodies)] = -1) then
     begin
-      if (pi.bodies[f] = -1) then
+      // can add here
+      for f := 0 to High(TGridCell.bodies) do
       begin
-        // can add here
-        pi.bodies[f] := bodyId;
-        if (f+1 < Length(TGridCell.bodies)) then pi.bodies[f+1] := -1;
-        exit;
+        if (pi.bodies[f] = -1) then
+        begin
+          pi.bodies[f] := bodyId;
+          if (f+1 < Length(TGridCell.bodies)) then pi.bodies[f+1] := -1;
+          exit;
+        end;
       end;
+      raise Exception.Create('internal error in grid inserter');
     end;
   end;
   // either no room, or no cell at all
   cidx := allocCell();
-  mCells[cidx].bodies[0] := bodyId;
-  mCells[cidx].bodies[1] := -1;
-  mCells[cidx].next := pc;
+  pi := @mCells[cidx];
+  pi.bodies[0] := bodyId;
+  pi.bodies[1] := -1;
+  pi.next := pc;
   mGrid[grida] := cidx;
 end;
 
@@ -693,23 +703,21 @@ begin
 end;
 
 
-// absolutely not tested
+// assume that we cannot have one object added to bucket twice
 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
 var
-  f: Integer;
-  pidx, idx, tmp: Integer;
+  f, c: Integer;
+  pidx, cidx: Integer;
   pc: PGridCell;
 begin
   result := false; // never stop
   // find and remove cell
-  pidx := -1;
-  idx := mGrid[grida];
-  while (idx >= 0) do
+  pidx := -1; // previous cell index
+  cidx := mGrid[grida]; // current cell index
+  while (cidx <> -1) do
   begin
-    tmp := mCells[idx].next;
-    pc := @mCells[idx];
-    f := 0;
-    while (f < High(TGridCell.bodies)) do
+    pc := @mCells[cidx];
+    for f := 0 to High(TGridCell.bodies) do
     begin
       if (pc.bodies[f] = bodyId) then
       begin
@@ -717,28 +725,22 @@ begin
         if (f = 0) and (pc.bodies[1] = -1) then
         begin
           // this cell contains no elements, remove it
-          tmp := mCells[idx].next;
-          if (pidx = -1) then mGrid[grida] := tmp else mCells[pidx].next := tmp;
-          freeCell(idx);
-        end
-        else
+          if (pidx = -1) then mGrid[grida] := pc.next else mCells[pidx].next := pc.next;
+          freeCell(cidx);
+          exit;
+        end;
+        // remove element from bucket
+        for c := f to High(TGridCell.bodies)-1 do
         begin
-          // remove element from bucket
-          Inc(f);
-          while (f < High(TGridCell.bodies)) do
-          begin
-            pc.bodies[f-1] := pc.bodies[f];
-            if (pc.bodies[f] = -1) then break;
-            Inc(f);
-          end;
-          pc.bodies[High(TGridCell.bodies)] := -1; // just in case
+          pc.bodies[c] := pc.bodies[c+1];
+          if (pc.bodies[c] = -1) then break;
         end;
-        exit; // assume that we cannot have one object added to bucket twice
+        pc.bodies[High(TGridCell.bodies)] := -1; // "has free room" flag
+        exit;
       end;
-      Inc(f);
     end;
-    pidx := idx;
-    idx := tmp;
+    pidx := cidx;
+    cidx := pc.next;
   end;
 end;
 
@@ -805,10 +807,16 @@ begin
   end;
 end;
 
+//TODO: optimize for horizontal/vertical moves
 procedure TBodyGridBase.moveBody (body: TBodyProxyId; nx, ny: Integer);
 var
   px: PBodyProxyRec;
   x0, y0: Integer;
+  ogx0, ogx1, ogy0, ogy1: Integer; // old grid rect
+  ngx0, ngx1, ngy0, ngy1: Integer; // new grid rect
+  gx, gy: Integer;
+  gw, gh: Integer;
+  pw, ph: Integer;
 begin
   if (body < 0) or (body > High(mProxies)) then exit; // just in case
   // check if tile coords was changed
@@ -816,20 +824,103 @@ begin
   x0 := px.mX;
   y0 := px.mY;
   if (nx = x0) and (ny = y0) then exit;
-  if (nx div mTileSize <> x0 div mTileSize) or (ny div mTileSize <> y0 div mTileSize) then
+  // map -> grid
+  Dec(x0, mMinX);
+  Dec(y0, mMinX);
+  Dec(nx, mMinX);
+  Dec(ny, mMinX);
+  // check for heavy work
+  pw := px.mWidth;
+  ph := px.mHeight;
+  ogx0 := x0 div mTileSize;
+  ogy0 := y0 div mTileSize;
+  ngx0 := nx div mTileSize;
+  ngy0 := ny div mTileSize;
+  ogx1 := (x0+pw-1) div mTileSize;
+  ogy1 := (y0+ph-1) div mTileSize;
+  ngx1 := (nx+pw-1) div mTileSize;
+  ngy1 := (ny+ph-1) div mTileSize;
+  if (ogx0 <> ngx0) or (ogy0 <> ngy0) or (ogx1 <> ngx1) or (ogy1 <> ngy1) then
   begin
     // crossed tile boundary, do heavy work
-    removeInternal(body);
-    px.mX := nx;
-    px.mY := ny;
-    insertInternal(body);
-  end
-  else
-  begin
-    // nothing to do with the grid, just fix coordinates
-    px.mX := nx;
-    px.mY := ny;
+    gw := mWidth;
+    gh := mHeight;
+    // cycle with old rect, remove body where it is necessary
+    // optimized for horizontal moves
+    //e_WriteLog(Format('og:(%d,%d)-(%d,%d); ng:(%d,%d)-(%d,%d)', [ogx0, ogy0, ogx1, ogy1, ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
+    // remove stale marks
+    if not ((ogy0 >= gh) or (ogy1 < 0)) and
+       not ((ogx0 >= gw) or (ogx1 < 0)) then
+    begin
+      if (ogx0 < 0) then ogx0 := 0;
+      if (ogy0 < 0) then ogy0 := 0;
+      if (ogx1 > gw-1) then ogx1 := gw-1;
+      if (ogy1 > gh-1) then ogy1 := gh-1;
+      //e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0, ogy0, ogx1, ogy1]), MSG_NOTIFY);
+      for gx := ogx0 to ogx1 do
+      begin
+        if (gx < ngx0) or (gx > ngx1) then
+        begin
+          // this column is completely outside of new rect
+          for gy := ogy0 to ogy1 do
+          begin
+            //e_WriteLog(Format('  remove:(%d,%d)', [gx, gy]), MSG_NOTIFY);
+            remover(gy*gw+gx, body);
+          end;
+        end
+        else
+        begin
+          // heavy checks
+          for gy := ogy0 to ogy1 do
+          begin
+            if (gy < ngy0) or (gy > ngy1) then
+            begin
+              //e_WriteLog(Format('  remove:(%d,%d)', [gx, gy]), MSG_NOTIFY);
+              remover(gy*gw+gx, body);
+            end;
+          end;
+        end;
+      end;
+    end;
+    // cycle with new rect, add body where it is necessary
+    if not ((ngy0 >= gh) or (ngy1 < 0)) and
+       not ((ngx0 >= gw) or (ngx1 < 0)) then
+    begin
+      if (ngx0 < 0) then ngx0 := 0;
+      if (ngy0 < 0) then ngy0 := 0;
+      if (ngx1 > gw-1) then ngx1 := gw-1;
+      if (ngy1 > gh-1) then ngy1 := gh-1;
+      //e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
+      for gx := ngx0 to ngx1 do
+      begin
+        if (gx < ogx0) or (gx > ogx1) then
+        begin
+          // this column is completely outside of old rect
+          for gy := ngy0 to ngy1 do
+          begin
+            //e_WriteLog(Format('  insert:(%d,%d)', [gx, gy]), MSG_NOTIFY);
+            inserter(gy*gw+gx, body);
+          end;
+        end
+        else
+        begin
+          // heavy checks
+          for gy := ngy0 to ngy1 do
+          begin
+            if (gy < ogy0) or (gy > ogy1) then
+            begin
+              //e_WriteLog(Format('  insert:(%d,%d)', [gx, gy]), MSG_NOTIFY);
+              inserter(gy*gw+gx, body);
+            end;
+          end;
+        end;
+      end;
+    end;
+    // done
   end;
+  // update coordinates
+  px.mX := nx+mMinX;
+  px.mY := ny+mMinY;
 end;
 
 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; nw, nh: Integer);
index d03d7b42840010d4b9ace73684791a7c494b4af3..39669fa1d8dd922c7a08c7cc2ed3080993c94137 100644 (file)
@@ -37,15 +37,15 @@ type
       WheelDown = $0010;
 
       // event types
-      Motion = 0;
+      Release = 0;
       Press = 1;
-      Release = 2;
+      Motion = 2;
 
   public
     kind: Byte; // motion, press, release
     x, y: Integer;
     dx, dy: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion
-    but: Word; // current pressed button or 0
+    but: Word; // current pressed/released button, or 0 for motion
     bstate: Word; // button state
     kstate: Word; // keyboard state (see THKeyEvent);
   end;
@@ -53,9 +53,21 @@ type
   THKeyEvent = record
   public
     const
+      // modifiers
       ModCtrl = $0001;
       ModAlt = $0002;
       ModShift = $0004;
+
+      // event types
+      Release = 0;
+      Press = 1;
+
+  public
+    kind: Byte;
+    scan: Word; // SDL_SCANCODE_XXX
+    sym: Word; // SDLK_XXX
+    bstate: Word; // button state
+    kstate: Word; // keyboard state
   end;
 
 
@@ -80,7 +92,7 @@ var
 implementation
 
 uses
-  SysUtils, GL,
+  SysUtils, GL, SDL2,
   MAPDEF, g_options;
 
 
@@ -90,6 +102,7 @@ var
   msY: Integer = -666;
   msB: Word = 0; // button state
   kbS: Word = 0; // keyboard modifiers state
+  showMonsInfo: Boolean = false;
 
 
 // ////////////////////////////////////////////////////////////////////////// //
@@ -252,9 +265,36 @@ procedure plrDebugDraw ();
   procedure drawMonsterInfo (mon: TMonster);
   var
     mx, my, mw, mh: Integer;
-    emx, emy, emw, emh: Integer;
-    enemy: TMonster;
-    eplr: TPlayer;
+
+    procedure drawMonsterTargetLine ();
+    var
+      emx, emy, emw, emh: Integer;
+      enemy: TMonster;
+      eplr: TPlayer;
+      ex, ey: Integer;
+    begin
+      if (g_GetUIDType(mon.MonsterTargetUID) = UID_PLAYER) then
+      begin
+        eplr := g_Player_Get(mon.MonsterTargetUID);
+        if (eplr <> nil) then eplr.getMapBox(emx, emy, emw, emh) else exit;
+      end
+      else if (g_GetUIDType(mon.MonsterTargetUID) = UID_MONSTER) then
+      begin
+        enemy := g_Monsters_ByUID(mon.MonsterTargetUID);
+        if (enemy <> nil) then enemy.getMapBox(emx, emy, emw, emh) else exit;
+      end
+      else
+      begin
+        exit;
+      end;
+      mon.getMapBox(mx, my, mw, mh);
+      drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, 255, 0, 0, 128);
+      if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
+      begin
+        drawLine(mx+mw div 2, my+mh div 2, ex, ey, 0, 255, 0, 128);
+      end;
+    end;
+
   begin
     if (mon = nil) then exit;
     mon.getMapBox(mx, my, mw, mh);
@@ -262,7 +302,7 @@ procedure plrDebugDraw ();
 
     monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
 
-    if ((kbS and THKeyEvent.ModCtrl) <> 0) then
+    if showMonsInfo then
     begin
       //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
       shadeRect(mx-4, my-7*8-6, 110, 7*8+6, 128);
@@ -282,29 +322,9 @@ procedure plrDebugDraw ();
       // target
       drawText6(mx, my, Format('TgtUID:%u', [mon.MonsterTargetUID]), 255, 127, 0); my -= 8;
       drawText6(mx, my, Format('TgtTime:%d', [mon.MonsterTargetTime]), 255, 127, 0); my -= 8;
-
-      mon.getMapBox(mx, my, mw, mh);
-    end;
-
-    if (g_GetUIDType(mon.MonsterTargetUID) = UID_PLAYER) then
-    begin
-      eplr := g_Player_Get(mon.MonsterTargetUID);
-      if (eplr <> nil) then
-      begin
-        eplr.getMapBox(emx, emy, emw, emh);
-        drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, 255, 0, 0, 128);
-      end;
-    end
-    else if (g_GetUIDType(mon.MonsterTargetUID) = UID_MONSTER) then
-    begin
-      enemy := g_Monsters_ByUID(mon.MonsterTargetUID);
-      if (enemy <> nil) then
-      begin
-        enemy.getMapBox(emx, emy, emw, emh);
-        drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, 255, 0, 0, 128);
-      end;
     end;
 
+    drawMonsterTargetLine();
     {
     property MonsterRemoved: Boolean read FRemoved write FRemoved;
     property MonsterPain: Integer read FPain write FPain;
@@ -360,6 +380,33 @@ end;
 function g_Holmes_KeyEvent (var ev: THKeyEvent): Boolean;
 begin
   result := false;
+  msB := ev.bstate;
+  kbS := ev.kstate;
+  case ev.scan of
+    SDL_SCANCODE_LCTRL, SDL_SCANCODE_RCTRL,
+    SDL_SCANCODE_LALT, SDL_SCANCODE_RALT,
+    SDL_SCANCODE_LSHIFT, SDL_SCANCODE_RSHIFT:
+      result := true;
+  end;
+  // press
+  if (ev.kind = THKeyEvent.Press) then
+  begin
+    // M-M: one monster think step
+    if (ev.scan = SDL_SCANCODE_M) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
+    begin
+      result := true;
+      gmon_debug_think := false;
+      gmon_debug_one_think_step := true; // do one step
+      exit;
+    end;
+    // M-I: toggle monster info
+    if (ev.scan = SDL_SCANCODE_I) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
+    begin
+      result := true;
+      showMonsInfo := not showMonsInfo;
+      exit;
+    end;
+  end;
 end;
 
 
index 6bae3695568f44127da5ec7890efb32c1a15a2be..bf4bd8a7cf90fb01805877988977279cfc6f494c 100644 (file)
@@ -1130,7 +1130,7 @@ var
     pan: TPanel;
   begin
     tag := panelTypeToTag(tag);
-    for idx := High(panels) downto 0 do
+    for idx := 0 to High(panels) do
     begin
       pan := panels[idx];
       pan.tag := tag;
index 4c354c30a1b3c60c086eaff684015df2d3bc0be0..ea7222f3194fb0006e04a62ade5769fbd8f07e3e 100644 (file)
@@ -241,6 +241,7 @@ var
 
 var
   gmon_debug_think: Boolean = true;
+  gmon_debug_one_think_step: Boolean = false;
 
 
 implementation
@@ -1290,8 +1291,9 @@ begin
 
   gMon := True; // Äëÿ ðàáîòû BlockMon'à
 
-  if (gmon_debug_think) then
+  if gmon_debug_think or gmon_debug_one_think_step then
   begin
+    gmon_debug_one_think_step := false;
     for a := 0 to High(gMonsters) do
     begin
       if (gMonsters[a] = nil) then continue;
index 1ac9c9e097f6300ae7d8b33874e657a05d41f52b..8b8919633da10cb3f2908cf0730e0ad809c45deb 100644 (file)
@@ -394,6 +394,7 @@ var
   uc: UnicodeChar;
   //joy: Integer;
   msev: THMouseEvent;
+  kbev: THKeyEvent;
 
   function buildBut (b: Byte): Word;
   begin
@@ -425,25 +426,35 @@ begin
       Result := WindowEventHandler(ev.window);
 
     SDL_QUITEV:
-    begin
-      if gExit <> EXIT_QUIT then
       begin
-        if not wLoadingProgress then
+        if gExit <> EXIT_QUIT then
         begin
-          g_Game_Free();
-          g_Game_Quit();
-        end
-        else
-          wLoadingQuit := True;
+          if not wLoadingProgress then
+          begin
+            g_Game_Free();
+            g_Game_Quit();
+          end
+          else
+            wLoadingQuit := True;
+        end;
+        Result := True;
       end;
-      Result := True;
-    end;
 
-    SDL_KEYDOWN:
-    begin
-      key := ev.key.keysym.scancode;
-      KeyPress(key);
-    end;
+    SDL_KEYDOWN,
+    SDL_KEYUP:
+      begin
+        key := ev.key.keysym.scancode;
+        if (g_holmes_enabled) then
+        begin
+          if (ev.type_ = SDL_KEYDOWN) then kbev.kind := THKeyEvent.Press else kbev.kind := THKeyEvent.Release;
+          kbev.scan := ev.key.keysym.scancode;
+          kbev.sym := ev.key.keysym.sym;
+          kbev.bstate := curMsButState;
+          kbev.kstate := curKbState;
+          if g_Holmes_keyEvent(kbev) then exit;
+        end;
+        if (ev.type_ = SDL_KEYDOWN) then KeyPress(key);
+      end;
 
     SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP:
       begin
@@ -495,13 +506,12 @@ begin
       end;
 
     SDL_TEXTINPUT:
-    begin
-      Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
-      keychr := Word(uc);
-      if (keychr > 127) then
-        keychr := WCharToCP1251(keychr);
-      CharPress(Chr(keychr));
-    end;
+      begin
+        Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
+        keychr := Word(uc);
+        if (keychr > 127) then keychr := WCharToCP1251(keychr);
+        CharPress(Chr(keychr));
+      end;
 
     // other key presses and joysticks are handled in e_input
   end;