src/game/g_holmes.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 unit g_holmes;
  18
  19 interface
  20
  21 uses
  22   {$IFDEF USE_MEMPOOL}mempool,{$ENDIF} geom,
  23   e_log, e_input,
  24   g_textures, g_basic, e_graphics, g_phys, g_grid, g_player, g_monsters,
  25   g_window, g_map, g_triggers, g_items, g_game, g_panel, g_console, g_gfx,
  26   xprofiler,
  27   sdlcarcass, glgfx, gh_ui;
  28
  29
  30 procedure g_Holmes_Draw ();
  31 procedure g_Holmes_DrawUI ();
  32
  33 procedure g_Holmes_MouseEvent (var ev: THMouseEvent);
  34 procedure g_Holmes_KeyEvent (var ev: THKeyEvent);
  35
  36 // hooks for player
  37 procedure g_Holmes_plrViewPos (viewPortX, viewPortY: Integer);
  38 procedure g_Holmes_plrViewSize (viewPortW, viewPortH: Integer);
  39 procedure g_Holmes_plrLaser (ax0, ay0, ax1, ay1: Integer);
  40
  41
  42 var
  43   g_holmes_enabled: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}false{$ENDIF};
  44
  45
  46 implementation
  47
  48 uses
  49   {rttiobj,} typinfo, e_texture,
  50   SysUtils, Classes, GL, SDL2,
  51   MAPDEF, g_main, g_options,
  52   utils, hashtable, xparser;
  53
  54
  55 var
  56   //globalInited: Boolean = false;
  57   msX: Integer = -666;
  58   msY: Integer = -666;
  59   msB: Word = 0; // button state
  60   kbS: Word = 0; // keyboard modifiers state
  61   showGrid: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
  62   showMonsInfo: Boolean = false;
  63   showMonsLOS2Plr: Boolean = false;
  64   showAllMonsCells: Boolean = false;
  65   showMapCurPos: Boolean = false;
  66   showLayersWindow: Boolean = false;
  67   showOutlineWindow: Boolean = false;
  68   showTriggers: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
  69   showTraceBox: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
  70
  71
  72 // ////////////////////////////////////////////////////////////////////////// //
  73 {$INCLUDE g_holmes.inc}
  74 {$INCLUDE g_holmes_ol.inc} // outliner
  75
  76
  77 // ////////////////////////////////////////////////////////////////////////// //
  78 {$INCLUDE g_holmes_cmd.inc}
  79 procedure holmesInitCommands (); forward;
  80 procedure holmesInitBinds (); forward;
  81
  82
  83 // ////////////////////////////////////////////////////////////////////////// //
  84 var
  85   g_ol_nice: Boolean = false;
  86   g_ol_fill_walls: Boolean = false;
  87   g_ol_rlayer_back: Boolean = false;
  88   g_ol_rlayer_step: Boolean = false;
  89   g_ol_rlayer_wall: Boolean = false;
  90   g_ol_rlayer_door: Boolean = false;
  91   g_ol_rlayer_acid1: Boolean = false;
  92   g_ol_rlayer_acid2: Boolean = false;
  93   g_ol_rlayer_water: Boolean = false;
  94   g_ol_rlayer_fore: Boolean = false;
  95
  96
  97 // ////////////////////////////////////////////////////////////////////////// //
  98 var
  99   winHelp: TUITopWindow = nil;
 100   winOptions: TUITopWindow = nil;
 101   winLayers: TUITopWindow = nil;
 102   winOutlines: TUITopWindow = nil;
 103
 104
 105 procedure createHelpWindow (); forward;
 106 procedure createOptionsWindow (); forward;
 107 procedure createLayersWindow (); forward;
 108 procedure createOutlinesWindow (); forward;
 109
 110
 111 procedure toggleLayersWindowCB (me: TUIControl; checked: Integer);
 112 begin
 113   if showLayersWindow then
 114   begin
 115     if (winLayers = nil) then createLayersWindow();
 116     uiAddWindow(winLayers);
 117   end
 118   else
 119   begin
 120     uiRemoveWindow(winLayers);
 121   end;
 122 end;
 123
 124
 125 procedure toggleOutlineWindowCB (me: TUIControl; checked: Integer);
 126 begin
 127   if showOutlineWindow then
 128   begin
 129     if (winOutlines = nil) then createOutlinesWindow();
 130     uiAddWindow(winOutlines);
 131   end
 132   else
 133   begin
 134     uiRemoveWindow(winOutlines);
 135   end;
 136 end;
 137
 138
 139 procedure createHelpWindow ();
 140 var
 141   llb: TUISimpleText;
 142   slist: array of AnsiString = nil;
 143   cmd: PHolmesCommand;
 144   bind: THolmesBinding;
 145   f, maxkeylen: Integer;
 146   s: AnsiString;
 147 begin
 148   for cmd in cmdlist do cmd.helpmark := false;
 149
 150   maxkeylen := 0;
 151   for bind in keybinds do
 152   begin
 153     if (Length(bind.key) = 0) then continue;
 154     if cmdlist.get(bind.cmdName, cmd) then
 155     begin
 156       if (Length(cmd.help) > 0) then
 157       begin
 158         cmd.helpmark := true;
 159         if (maxkeylen < Length(bind.key)) then maxkeylen := Length(bind.key);
 160       end;
 161     end;
 162   end;
 163
 164   for cmd in cmdlist do
 165   begin
 166     if not cmd.helpmark then continue;
 167     if (Length(cmd.help) = 0) then continue;
 168     f := 0;
 169     while (f < Length(slist)) and (CompareText(slist[f], cmd.section) <> 0) do Inc(f);
 170     if (f = Length(slist)) then
 171     begin
 172       SetLength(slist, Length(slist)+1);
 173       slist[High(slist)] := cmd.section;
 174     end;
 175   end;
 176
 177   llb := TUISimpleText.Create(0, 0);
 178   for f := 0 to High(slist) do
 179   begin
 180     if (f > 0) then llb.appendItem('');
 181     llb.appendItem(slist[f], true, true);
 182     for cmd in cmdlist do
 183     begin
 184       if not cmd.helpmark then continue;
 185       if (CompareText(cmd.section, slist[f]) <> 0) then continue;
 186       for bind in keybinds do
 187       begin
 188         if (Length(bind.key) = 0) then continue;
 189         if (cmd.name = bind.cmdName) then
 190         begin
 191           s := bind.key;
 192           while (Length(s) < maxkeylen) do s += ' ';
 193           s := '  '+s+' -- '+cmd.help;
 194           llb.appendItem(s);
 195         end;
 196       end;
 197     end;
 198   end;
 199
 200   maxkeylen := 0;
 201   for bind in msbinds do
 202   begin
 203     if (Length(bind.key) = 0) then continue;
 204     if cmdlist.get(bind.cmdName, cmd) then
 205     begin
 206       if (Length(cmd.help) > 0) then
 207       begin
 208         cmd.helpmark := true;
 209         if (maxkeylen < Length(bind.key)) then maxkeylen := Length(bind.key);
 210       end;
 211     end;
 212   end;
 213
 214   llb.appendItem('');
 215   llb.appendItem('mouse', true, true);
 216   for bind in msbinds do
 217   begin
 218     if (Length(bind.key) = 0) then continue;
 219     if cmdlist.get(bind.cmdName, cmd) then
 220     begin
 221       if (Length(cmd.help) > 0) then
 222       begin
 223         s := bind.key;
 224         while (Length(s) < maxkeylen) do s += ' ';
 225         s := '  '+s+' -- '+cmd.help;
 226         llb.appendItem(s);
 227       end;
 228     end;
 229   end;
 230
 231   winHelp := TUITopWindow.Create('Holmes Help', 10, 10);
 232   winHelp.escClose := true;
 233   winHelp.appendChild(llb);
 234   winHelp.centerInScreen();
 235 end;
 236
 237
 238 procedure winLayersClosed (me: TUIControl; dummy: Integer); begin showLayersWindow := false; end;
 239 procedure winOutlinesClosed (me: TUIControl; dummy: Integer); begin showOutlineWindow := false; end;
 240
 241 procedure createLayersWindow ();
 242 var
 243   llb: TUICBListBox;
 244 begin
 245   llb := TUICBListBox.Create(0, 0);
 246   llb.appendItem('background', @g_rlayer_back);
 247   llb.appendItem('steps', @g_rlayer_step);
 248   llb.appendItem('walls', @g_rlayer_wall);
 249   llb.appendItem('doors', @g_rlayer_door);
 250   llb.appendItem('acid1', @g_rlayer_acid1);
 251   llb.appendItem('acid2', @g_rlayer_acid2);
 252   llb.appendItem('water', @g_rlayer_water);
 253   llb.appendItem('foreground', @g_rlayer_fore);
 254   winLayers := TUITopWindow.Create('layers', 10, 10);
 255   winLayers.escClose := true;
 256   winLayers.appendChild(llb);
 257   winLayers.closeCB := winLayersClosed;
 258 end;
 259
 260
 261 procedure createOutlinesWindow ();
 262 var
 263   llb: TUICBListBox;
 264 begin
 265   llb := TUICBListBox.Create(0, 0);
 266   llb.appendItem('background', @g_ol_rlayer_back);
 267   llb.appendItem('steps', @g_ol_rlayer_step);
 268   llb.appendItem('walls', @g_ol_rlayer_wall);
 269   llb.appendItem('doors', @g_ol_rlayer_door);
 270   llb.appendItem('acid1', @g_ol_rlayer_acid1);
 271   llb.appendItem('acid2', @g_ol_rlayer_acid2);
 272   llb.appendItem('water', @g_ol_rlayer_water);
 273   llb.appendItem('foreground', @g_ol_rlayer_fore);
 274   llb.appendItem('OPTIONS', nil);
 275   llb.appendItem('fill walls', @g_ol_fill_walls);
 276   llb.appendItem('contours', @g_ol_nice);
 277   winOutlines := TUITopWindow.Create('outlines', 100, 10);
 278   winOutlines.escClose := true;
 279   winOutlines.appendChild(llb);
 280   winOutlines.closeCB := winOutlinesClosed;
 281 end;
 282
 283
 284 procedure createOptionsWindow ();
 285 var
 286   llb: TUICBListBox;
 287 begin
 288   llb := TUICBListBox.Create(0, 0);
 289   llb.appendItem('map grid', @showGrid);
 290   llb.appendItem('cursor position on map', @showMapCurPos);
 291   llb.appendItem('monster info', @showMonsInfo);
 292   llb.appendItem('monster LOS to player', @showMonsLOS2Plr);
 293   llb.appendItem('monster cells (SLOW!)', @showAllMonsCells);
 294   llb.appendItem('draw triggers (SLOW!)', @showTriggers);
 295   llb.appendItem('WINDOWS', nil);
 296   llb.appendItem('layers window', @showLayersWindow, toggleLayersWindowCB);
 297   llb.appendItem('outline window', @showOutlineWindow, toggleOutlineWindowCB);
 298   winOptions := TUITopWindow.Create('Holmes Options', 100, 100);
 299   winOptions.escClose := true;
 300   winOptions.appendChild(llb);
 301   winOptions.centerInScreen();
 302 end;
 303
 304
 305 procedure toggleLayersWindow (arg: Integer=-1);
 306 begin
 307   if (arg < 0) then showLayersWindow := not showLayersWindow else showLayersWindow := (arg > 0);
 308   toggleLayersWindowCB(nil, 0);
 309 end;
 310
 311 procedure toggleOutlineWindow (arg: Integer=-1);
 312 begin
 313   if (arg < 0) then showOutlineWindow := not showOutlineWindow else showOutlineWindow := (arg > 0);
 314   toggleOutlineWindowCB(nil, 0);
 315 end;
 316
 317 procedure toggleHelpWindow (arg: Integer=-1);
 318 begin
 319   if (winHelp = nil) then createHelpWindow();
 320        if (arg < 0) then begin if not uiVisibleWindow(winHelp) then uiAddWindow(winHelp) else uiRemoveWindow(winHelp); end
 321   else if (arg = 0) then begin if uiVisibleWindow(winHelp) then uiRemoveWindow(winHelp); end
 322   else begin if not uiVisibleWindow(winHelp) then uiAddWindow(winHelp); end
 323 end;
 324
 325 procedure toggleOptionsWindow (arg: Integer=-1);
 326 begin
 327   if (winOptions = nil) then createOptionsWindow();
 328        if (arg < 0) then begin if not uiVisibleWindow(winOptions) then uiAddWindow(winOptions) else uiRemoveWindow(winOptions); end
 329   else if (arg = 0) then begin if uiVisibleWindow(winOptions) then uiRemoveWindow(winOptions); end
 330   else begin if not uiVisibleWindow(winOptions) then uiAddWindow(winOptions); end
 331 end;
 332
 333
 334 // ////////////////////////////////////////////////////////////////////////// //
 335 var
 336   vpSet: Boolean = false;
 337   vpx, vpy: Integer;
 338   vpw, vph: Integer;
 339   laserSet: Boolean = false;
 340   laserX0, laserY0, laserX1, laserY1: Integer;
 341   monMarkedUID: Integer = -1;
 342   platMarkedGUID: Integer = -1;
 343
 344
 345 procedure g_Holmes_plrViewPos (viewPortX, viewPortY: Integer);
 346 begin
 347   vpSet := true;
 348   vpx := viewPortX;
 349   vpy := viewPortY;
 350 end;
 351
 352 procedure g_Holmes_plrViewSize (viewPortW, viewPortH: Integer);
 353 begin
 354   vpSet := true;
 355   vpw := viewPortW;
 356   vph := viewPortH;
 357 end;
 358
 359 procedure g_Holmes_plrLaser (ax0, ay0, ax1, ay1: Integer);
 360 begin
 361   laserSet := true;
 362   laserX0 := ax0;
 363   laserY0 := ay0;
 364   laserX1 := ax1;
 365   laserY1 := ay1;
 366   laserSet := laserSet; // shut up, fpc!
 367 end;
 368
 369
 370 function pmsCurMapX (): Integer; inline; begin result := round(msX/g_dbg_scale)+vpx; end;
 371 function pmsCurMapY (): Integer; inline; begin result := round(msY/g_dbg_scale)+vpy; end;
 372
 373
 374 procedure plrDebugMouse (var ev: THMouseEvent);
 375 begin
 376   //e_WriteLog(Format('mouse: x=%d; y=%d; but=%d; bstate=%d', [msx, msy, but, bstate]), MSG_NOTIFY);
 377   if (gPlayer1 = nil) or not vpSet then exit;
 378   //if (ev.kind <> THMouseEvent.Press) then exit;
 379   //e_WriteLog(Format('mev: %d', [Integer(ev.kind)]), MSG_NOTIFY);
 380   msbindExecute(ev);
 381 end;
 382
 383
 384 {$IFDEF HOLMES_OLD_OUTLINES}
 385 var
 386   edgeBmp: array of Byte = nil;
 387
 388
 389 procedure drawOutlines ();
 390 var
 391   r, g, b: Integer;
 392
 393   procedure clearEdgeBmp ();
 394   begin
 395     SetLength(edgeBmp, (gWinSizeX+4)*(gWinSizeY+4));
 396     FillChar(edgeBmp[0], Length(edgeBmp)*sizeof(edgeBmp[0]), 0);
 397   end;
 398
 399   procedure drawPanel (pan: TPanel);
 400   var
 401     sx, len, y0, y1: Integer;
 402   begin
 403     if (pan = nil) or (pan.Width < 1) or (pan.Height < 1) then exit;
 404     if (pan.X+pan.Width <= vpx-1) or (pan.Y+pan.Height <= vpy-1) then exit;
 405     if (pan.X >= vpx+vpw+1) or (pan.Y >= vpy+vph+1) then exit;
 406     if g_ol_nice or g_ol_fill_walls then
 407     begin
 408       sx := pan.X-(vpx-1);
 409       len := pan.Width;
 410       if (len > gWinSizeX+4) then len := gWinSizeX+4;
 411       if (sx < 0) then begin len += sx; sx := 0; end;
 412       if (sx+len > gWinSizeX+4) then len := gWinSizeX+4-sx;
 413       if (len < 1) then exit;
 414       assert(sx >= 0);
 415       assert(sx+len <= gWinSizeX+4);
 416       y0 := pan.Y-(vpy-1);
 417       y1 := y0+pan.Height;
 418       if (y0 < 0) then y0 := 0;
 419       if (y1 > gWinSizeY+4) then y1 := gWinSizeY+4;
 420       while (y0 < y1) do
 421       begin
 422         FillChar(edgeBmp[y0*(gWinSizeX+4)+sx], len*sizeof(edgeBmp[0]), 1);
 423         Inc(y0);
 424       end;
 425     end
 426     else
 427     begin
 428       drawRect(pan.X, pan.Y, pan.Width, pan.Height, r, g, b);
 429     end;
 430   end;
 431
 432 var
 433   lsx: Integer = -1;
 434   lex: Integer = -1;
 435   lsy: Integer = -1;
 436
 437   procedure flushLine ();
 438   begin
 439     if (lsy > 0) and (lsx > 0) then
 440     begin
 441       if (lex = lsx) then
 442       begin
 443         glBegin(GL_POINTS);
 444           glVertex2f(lsx-1+vpx+0.37, lsy-1+vpy+0.37);
 445         glEnd();
 446       end
 447       else
 448       begin
 449         glBegin(GL_LINES);
 450           glVertex2f(lsx-1+vpx+0.37, lsy-1+vpy+0.37);
 451           glVertex2f(lex-0+vpx+0.37, lsy-1+vpy+0.37);
 452         glEnd();
 453       end;
 454     end;
 455     lsx := -1;
 456     lex := -1;
 457   end;
 458
 459   procedure startLine (y: Integer);
 460   begin
 461     flushLine();
 462     lsy := y;
 463   end;
 464
 465   procedure putPixel (x: Integer);
 466   begin
 467     if (x < 1) then exit;
 468     if (lex+1 <> x) then flushLine();
 469     if (lsx < 0) then lsx := x;
 470     lex := x;
 471   end;
 472
 473   procedure drawEdges ();
 474   var
 475     x, y: Integer;
 476     a: PByte;
 477   begin
 478     glDisable(GL_BLEND);
 479     glDisable(GL_TEXTURE_2D);
 480     glLineWidth(1);
 481     glPointSize(1);
 482     glDisable(GL_LINE_SMOOTH);
 483     glDisable(GL_POLYGON_SMOOTH);
 484     glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
 485     for y := 1 to vph do
 486     begin
 487       a := @edgeBmp[y*(gWinSizeX+4)+1];
 488       startLine(y);
 489       for x := 1 to vpw do
 490       begin
 491         if (a[0] <> 0) then
 492         begin
 493           if (a[-1] = 0) or (a[1] = 0) or (a[-(gWinSizeX+4)] = 0) or (a[gWinSizeX+4] = 0) or
 494              (a[-(gWinSizeX+4)-1] = 0) or (a[-(gWinSizeX+4)+1] = 0) or
 495              (a[gWinSizeX+4-1] = 0) or (a[gWinSizeX+4+1] = 0) then
 496           begin
 497             putPixel(x);
 498           end;
 499         end;
 500         Inc(a);
 501       end;
 502       flushLine();
 503     end;
 504   end;
 505
 506   procedure drawFilledWalls ();
 507   var
 508     x, y: Integer;
 509     a: PByte;
 510   begin
 511     glDisable(GL_BLEND);
 512     glDisable(GL_TEXTURE_2D);
 513     glLineWidth(1);
 514     glPointSize(1);
 515     glDisable(GL_LINE_SMOOTH);
 516     glDisable(GL_POLYGON_SMOOTH);
 517     glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
 518     for y := 1 to vph do
 519     begin
 520       a := @edgeBmp[y*(gWinSizeX+4)+1];
 521       startLine(y);
 522       for x := 1 to vpw do
 523       begin
 524         if (a[0] <> 0) then putPixel(x);
 525         Inc(a);
 526       end;
 527       flushLine();
 528     end;
 529   end;
 530
 531   procedure doWallsOld (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
 532   var
 533     f: Integer;
 534     pan: TPanel;
 535   begin
 536     r := ar;
 537     g := ag;
 538     b := ab;
 539     if g_ol_nice or g_ol_fill_walls then clearEdgeBmp();
 540     for f := 0 to High(parr) do
 541     begin
 542       pan := parr[f];
 543       if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then continue;
 544       if ((pan.PanelType and ptype) = 0) then continue;
 545       drawPanel(pan);
 546     end;
 547     if g_ol_nice then drawEdges();
 548     if g_ol_fill_walls then drawFilledWalls();
 549   end;
 550
 551 var
 552   xptag: Word;
 553
 554   function doWallCB (pan: TPanel; tag: Integer): Boolean;
 555   begin
 556     result := false; // don't stop
 557     //if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then exit;
 558     if ((pan.PanelType and xptag) = 0) then exit;
 559     drawPanel(pan);
 560   end;
 561
 562   procedure doWalls (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
 563   begin
 564     r := ar;
 565     g := ag;
 566     b := ab;
 567     xptag := ptype;
 568     if ((ptype and (PANEL_WALL or PANEL_OPENDOOR or PANEL_CLOSEDOOR)) <> 0) then ptype := GridTagWall or GridTagDoor
 569     else panelTypeToTag(ptype);
 570     if g_ol_nice or g_ol_fill_walls then clearEdgeBmp();
 571     mapGrid.forEachInAABB(vpx-1, vpy-1, vpw+2, vph+2, doWallCB, ptype);
 572     if g_ol_nice then drawEdges();
 573     if g_ol_fill_walls then drawFilledWalls();
 574   end;
 575
 576 begin
 577   if g_ol_rlayer_back then doWallsOld(gRenderBackgrounds, PANEL_BACK, 255, 127, 0);
 578   if g_ol_rlayer_step then doWallsOld(gSteps, PANEL_STEP, 192, 192, 192);
 579   if g_ol_rlayer_wall then doWallsOld(gWalls, PANEL_WALL, 255, 255, 255);
 580   if g_ol_rlayer_door then doWallsOld(gWalls, PANEL_OPENDOOR or PANEL_CLOSEDOOR, 0, 255, 0);
 581   if g_ol_rlayer_acid1 then doWallsOld(gAcid1, PANEL_ACID1, 255, 0, 0);
 582   if g_ol_rlayer_acid2 then doWallsOld(gAcid2, PANEL_ACID2, 198, 198, 0);
 583   if g_ol_rlayer_water then doWallsOld(gWater, PANEL_WATER, 0, 255, 255);
 584   if g_ol_rlayer_fore then doWallsOld(gRenderForegrounds, PANEL_FORE, 210, 210, 210);
 585 end;
 586
 587 {$ELSE}
 588 var
 589   oliner: TOutliner = nil;
 590
 591 procedure drawOutlines ();
 592 var
 593   r, g, b: Integer;
 594
 595   procedure clearOliner ();
 596   begin
 597     //if (oliner <> nil) and ((oliner.height <> vph+2) or (oliner.width <> vpw+2)) then begin oliner.Free(); oliner := nil; end;
 598     if (oliner = nil) then oliner := TOutliner.Create(vpw+2, vph+2) else oliner.setup(vpw+2, vph+2);
 599   end;
 600
 601   procedure drawOutline (ol: TOutliner; sx, sy: Integer);
 602     procedure xline (x0, x1, y: Integer);
 603     var
 604       x: Integer;
 605     begin
 606       if (g_dbg_scale < 1.0) then
 607       begin
 608         glBegin(GL_POINTS);
 609           for x := x0 to x1 do glVertex2f(sx+x+0.375, sy+y+0.375);
 610         glEnd();
 611       end
 612       else
 613       begin
 614         glBegin(GL_QUADS);
 615           glVertex2f(sx+x0+0, sy+y+0);
 616           glVertex2f(sx+x1+1, sy+y+0);
 617           glVertex2f(sx+x1+1, sy+y+1);
 618           glVertex2f(sx+x0+0, sy+y+1);
 619         glEnd();
 620       end;
 621     end;
 622   var
 623     y: Integer;
 624     sp: TOutliner.TSpanX;
 625   begin
 626     if (ol = nil) then exit;
 627     glPointSize(1);
 628     glDisable(GL_POINT_SMOOTH);
 629     for y := 0 to ol.height-1 do
 630     begin
 631       for sp in ol.eachSpanAtY(y) do
 632       begin
 633         if (g_dbg_scale <= 1.0) then
 634         begin
 635           glBegin(GL_POINTS);
 636             glVertex2f(sx+sp.x0+0.375, sy+y+0.375);
 637             glVertex2f(sx+sp.x1+0.375, sy+y+0.375);
 638           glEnd();
 639         end
 640         else
 641         begin
 642           glBegin(GL_QUADS);
 643             glVertex2f(sx+sp.x0+0, sy+y+0);
 644             glVertex2f(sx+sp.x0+1, sy+y+0);
 645             glVertex2f(sx+sp.x0+1, sy+y+1);
 646             glVertex2f(sx+sp.x0+0, sy+y+1);
 647
 648             glVertex2f(sx+sp.x1+0, sy+y+0);
 649             glVertex2f(sx+sp.x1+1, sy+y+0);
 650             glVertex2f(sx+sp.x1+1, sy+y+1);
 651             glVertex2f(sx+sp.x1+0, sy+y+1);
 652           glEnd();
 653         end;
 654       end;
 655       for sp in ol.eachSpanEdgeAtY(y, -1) do
 656       begin
 657         xline(sp.x0, sp.x1, y);
 658         {
 659         glBegin(GL_QUADS);
 660           glVertex2f(sx+sp.x0+0, sy+y+0);
 661           glVertex2f(sx+sp.x1+1, sy+y+0);
 662           glVertex2f(sx+sp.x1+1, sy+y+1);
 663           glVertex2f(sx+sp.x0+0, sy+y+1);
 664         glEnd();
 665         }
 666       end;
 667       for sp in ol.eachSpanEdgeAtY(y, +1) do
 668       begin
 669         xline(sp.x0, sp.x1, y);
 670         {
 671         glBegin(GL_QUADS);
 672           glVertex2f(sx+sp.x0+0, sy+y+0);
 673           glVertex2f(sx+sp.x1+1, sy+y+0);
 674           glVertex2f(sx+sp.x1+1, sy+y+1);
 675           glVertex2f(sx+sp.x0+0, sy+y+1);
 676         glEnd();
 677         }
 678       end;
 679     end;
 680   end;
 681
 682   procedure doWallsOld (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
 683   var
 684     f: Integer;
 685     pan: TPanel;
 686   begin
 687     r := ar;
 688     g := ag;
 689     b := ab;
 690     if g_ol_nice then clearOliner();
 691     for f := 0 to High(parr) do
 692     begin
 693       pan := parr[f];
 694       if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then continue;
 695       if ((pan.PanelType and ptype) = 0) then continue;
 696       if (pan.X > vpx+vpw+41) or (pan.Y > vpy+vph+41) then continue;
 697       if (pan.X+pan.Width < vpx-41) then continue;
 698       if (pan.Y+pan.Height < vpy-41) then continue;
 699       if g_ol_nice then
 700       begin
 701         oliner.addRect(pan.X-(vpx+1), pan.Y-(vpy+1), pan.Width, pan.Height);
 702       end;
 703       if g_ol_fill_walls then
 704       begin
 705         fillRect(pan.X, pan.Y, pan.Width, pan.Height, TGxRGBA.Create(r, g, b));
 706       end
 707       else if not g_ol_nice then
 708       begin
 709         drawRect(pan.X, pan.Y, pan.Width, pan.Height, TGxRGBA.Create(r, g, b));
 710       end;
 711     end;
 712     if g_ol_nice then
 713     begin
 714       glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
 715       drawOutline(oliner, vpx+1, vpy+1);
 716     end;
 717   end;
 718
 719 begin
 720   if (vpw < 2) or (vph < 2) then exit;
 721   if g_ol_rlayer_back then doWallsOld(gRenderBackgrounds, PANEL_BACK, 255, 127, 0);
 722   if g_ol_rlayer_step then doWallsOld(gSteps, PANEL_STEP, 192, 192, 192);
 723   if g_ol_rlayer_wall then doWallsOld(gWalls, PANEL_WALL, 255, 255, 255);
 724   if g_ol_rlayer_door then doWallsOld(gWalls, PANEL_OPENDOOR or PANEL_CLOSEDOOR, 0, 255, 0);
 725   if g_ol_rlayer_acid1 then doWallsOld(gAcid1, PANEL_ACID1, 255, 0, 0);
 726   if g_ol_rlayer_acid2 then doWallsOld(gAcid2, PANEL_ACID2, 198, 198, 0);
 727   if g_ol_rlayer_water then doWallsOld(gWater, PANEL_WATER, 0, 255, 255);
 728   if g_ol_rlayer_fore then doWallsOld(gRenderForegrounds, PANEL_FORE, 210, 210, 210);
 729 end;
 730 {$ENDIF}
 731
 732
 733 procedure plrDebugDraw ();
 734   procedure drawTileGrid ();
 735   var
 736     x, y: Integer;
 737   begin
 738     for y := 0 to (mapGrid.gridHeight div mapGrid.tileSize) do
 739     begin
 740       drawLine(mapGrid.gridX0, mapGrid.gridY0+y*mapGrid.tileSize, mapGrid.gridX0+mapGrid.gridWidth, mapGrid.gridY0+y*mapGrid.tileSize, TGxRGBA.Create(96, 96, 96));
 741     end;
 742
 743     for x := 0 to (mapGrid.gridWidth div mapGrid.tileSize) do
 744     begin
 745       drawLine(mapGrid.gridX0+x*mapGrid.tileSize, mapGrid.gridY0, mapGrid.gridX0+x*mapGrid.tileSize, mapGrid.gridY0+y*mapGrid.gridHeight, TGxRGBA.Create(96, 96, 96));
 746     end;
 747   end;
 748
 749   procedure drawAwakeCells ();
 750   var
 751     x, y: Integer;
 752   begin
 753     for y := 0 to (mapGrid.gridHeight div mapGrid.tileSize) do
 754     begin
 755       for x := 0 to (mapGrid.gridWidth div mapGrid.tileSize) do
 756       begin
 757         if awmIsSetHolmes(x*mapGrid.tileSize+mapGrid.gridX0+1, y*mapGrid.tileSize++mapGrid.gridY0+1) then
 758         begin
 759           fillRect(x*mapGrid.tileSize++mapGrid.gridX0, y*mapGrid.tileSize++mapGrid.gridY0, monsGrid.tileSize, monsGrid.tileSize, TGxRGBA.Create(128, 0, 128, 64));
 760         end;
 761       end;
 762     end;
 763   end;
 764
 765   procedure drawTraceBox ();
 766   var
 767     plr: TPlayer;
 768     px, py, pw, ph: Integer;
 769     pdx, pdy: Integer;
 770     ex, ey: Integer;
 771     pan: TPanel;
 772   begin
 773     if (Length(gPlayers) < 1) then exit;
 774     plr := gPlayers[0];
 775     if (plr = nil) then exit;
 776     plr.getMapBox(px, py, pw, ph);
 777     drawRect(px, py, pw, ph, TGxRGBA.Create(255, 0, 255, 200));
 778     pdx := pmsCurMapX-(px+pw div 2);
 779     pdy := pmsCurMapY-(py+ph div 2);
 780     drawLine(px+pw div 2, py+ph div 2, px+pw div 2+pdx, py+ph div 2+pdy, TGxRGBA.Create(255, 0, 255, 200));
 781     pan := mapGrid.traceBox(ex, ey, px, py, pw, ph, pdx, pdy, nil, GridTagObstacle);
 782     if (pan = nil) then
 783     begin
 784       drawRect(px+pdx, py+pdy, pw, ph, TGxRGBA.Create(255, 255, 255, 180));
 785     end
 786     else
 787     begin
 788       drawRect(px+pdx, py+pdy, pw, ph, TGxRGBA.Create(255, 255, 0, 180));
 789     end;
 790     drawRect(ex, ey, pw, ph, TGxRGBA.Create(255, 127, 0, 180));
 791   end;
 792
 793   procedure hilightCell (cx, cy: Integer);
 794   begin
 795     fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize, TGxRGBA.Create(0, 128, 0, 64));
 796   end;
 797
 798   procedure hilightCell1 (cx, cy: Integer);
 799   begin
 800     //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
 801     cx := cx and (not (monsGrid.tileSize-1));
 802     cy := cy and (not (monsGrid.tileSize-1));
 803     fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize, TGxRGBA.Create(255, 255, 0, 92));
 804   end;
 805
 806   function hilightWallTrc (pan: TPanel; tag: Integer; x, y, prevx, prevy: Integer): Boolean;
 807   begin
 808     result := false; // don't stop
 809     if (pan = nil) then exit; // cell completion, ignore
 810     //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
 811     fillRect(pan.X, pan.Y, pan.Width, pan.Height, TGxRGBA.Create(0, 128, 128, 64));
 812   end;
 813
 814   function monsCollector (mon: TMonster; tag: Integer): Boolean;
 815   var
 816     ex, ey: Integer;
 817     mx, my, mw, mh: Integer;
 818   begin
 819     result := false;
 820     mon.getMapBox(mx, my, mw, mh);
 821     e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 255, 0, 96);
 822     if lineAABBIntersects(laserX0, laserY0, laserX1, laserY1, mx, my, mw, mh, ex, ey) then
 823     begin
 824       e_DrawPoint(8, ex, ey, 0, 255, 0);
 825     end;
 826   end;
 827
 828   procedure drawMonsterInfo (mon: TMonster);
 829   var
 830     mx, my, mw, mh: Integer;
 831
 832     procedure drawMonsterTargetLine ();
 833     var
 834       emx, emy, emw, emh: Integer;
 835       enemy: TMonster;
 836       eplr: TPlayer;
 837       ex, ey: Integer;
 838     begin
 839       if (g_GetUIDType(mon.MonsterTargetUID) = UID_PLAYER) then
 840       begin
 841         eplr := g_Player_Get(mon.MonsterTargetUID);
 842         if (eplr <> nil) then eplr.getMapBox(emx, emy, emw, emh) else exit;
 843       end
 844       else if (g_GetUIDType(mon.MonsterTargetUID) = UID_MONSTER) then
 845       begin
 846         enemy := g_Monsters_ByUID(mon.MonsterTargetUID);
 847         if (enemy <> nil) then enemy.getMapBox(emx, emy, emw, emh) else exit;
 848       end
 849       else
 850       begin
 851         exit;
 852       end;
 853       mon.getMapBox(mx, my, mw, mh);
 854       drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, TGxRGBA.Create(255, 0, 0));
 855       if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
 856       begin
 857         drawLine(mx+mw div 2, my+mh div 2, ex, ey, TGxRGBA.Create(0, 255, 0));
 858       end;
 859     end;
 860
 861     procedure drawLOS2Plr ();
 862     var
 863       emx, emy, emw, emh: Integer;
 864       eplr: TPlayer;
 865       ex, ey: Integer;
 866     begin
 867       eplr := gPlayers[0];
 868       if (eplr = nil) then exit;
 869       eplr.getMapBox(emx, emy, emw, emh);
 870       mon.getMapBox(mx, my, mw, mh);
 871       drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, TGxRGBA.Create(255, 0, 0));
 872       {$IF DEFINED(D2F_DEBUG)}
 873       mapGrid.dbgRayTraceTileHitCB := hilightCell1;
 874       {$ENDIF}
 875       if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
 876       //if (mapGrid.traceRay(ex, ey, mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, hilightWallTrc, (GridTagWall or GridTagDoor)) <> nil) then
 877       begin
 878         drawLine(mx+mw div 2, my+mh div 2, ex, ey, TGxRGBA.Create(0, 255, 0));
 879       end;
 880       {$IF DEFINED(D2F_DEBUG)}
 881       mapGrid.dbgRayTraceTileHitCB := nil;
 882       {$ENDIF}
 883     end;
 884
 885   begin
 886     if (mon = nil) then exit;
 887     mon.getMapBox(mx, my, mw, mh);
 888     //mx += mw div 2;
 889
 890     monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
 891
 892     if showMonsInfo then
 893     begin
 894       //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
 895       darkenRect(mx-4, my-7*8-6, 110, 7*8+6, 128);
 896       my -= 8;
 897       my -= 2;
 898
 899       // type
 900       drawText6(mx, my, Format('%s(U:%u)', [monsTypeToString(mon.MonsterType), mon.UID]), TGxRGBA.Create(255, 127, 0)); my -= 8;
 901       // beh
 902       drawText6(mx, my, Format('Beh: %s', [monsBehToString(mon.MonsterBehaviour)]), TGxRGBA.Create(255, 127, 0)); my -= 8;
 903       // state
 904       drawText6(mx, my, Format('State:%s (%d)', [monsStateToString(mon.MonsterState), mon.MonsterSleep]), TGxRGBA.Create(255, 127, 0)); my -= 8;
 905       // health
 906       drawText6(mx, my, Format('Health:%d', [mon.MonsterHealth]), TGxRGBA.Create(255, 127, 0)); my -= 8;
 907       // ammo
 908       drawText6(mx, my, Format('Ammo:%d', [mon.MonsterAmmo]), TGxRGBA.Create(255, 127, 0)); my -= 8;
 909       // target
 910       drawText6(mx, my, Format('TgtUID:%u', [mon.MonsterTargetUID]), TGxRGBA.Create(255, 127, 0)); my -= 8;
 911       drawText6(mx, my, Format('TgtTime:%d', [mon.MonsterTargetTime]), TGxRGBA.Create(255, 127, 0)); my -= 8;
 912     end;
 913
 914     drawMonsterTargetLine();
 915     if showMonsLOS2Plr then drawLOS2Plr();
 916     {
 917     property MonsterRemoved: Boolean read FRemoved write FRemoved;
 918     property MonsterPain: Integer read FPain write FPain;
 919     property MonsterAnim: Byte read FCurAnim write FCurAnim;
 920     }
 921   end;
 922
 923   function highlightAllMonsterCells (mon: TMonster): Boolean;
 924   begin
 925     result := false; // don't stop
 926     monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
 927   end;
 928
 929   procedure drawSelectedPlatformCells ();
 930   var
 931     pan: TPanel;
 932   begin
 933     if not showGrid then exit;
 934     pan := g_Map_PanelByGUID(platMarkedGUID);
 935     if (pan = nil) then exit;
 936     mapGrid.forEachBodyCell(pan.proxyId, hilightCell);
 937     drawRect(pan.x, pan.y, pan.width, pan.height, TGxRGBA.Create(0, 200, 0, 200));
 938   end;
 939
 940   procedure drawTrigger (var trig: TTrigger);
 941
 942     procedure drawPanelDest (pguid: Integer);
 943     var
 944       pan: TPanel;
 945     begin
 946       pan := g_Map_PanelByGUID(pguid);
 947       if (pan = nil) then exit;
 948       drawLine(
 949         trig.trigCenter.x, trig.trigCenter.y,
 950         pan.x+pan.width div 2, pan.y+pan.height div 2,
 951         TGxRGBA.Create(255, 0, 255, 220));
 952     end;
 953
 954   var
 955     tts: AnsiString;
 956     tx: Integer;
 957   begin
 958     fillRect(trig.x, trig.y, trig.width, trig.height, TGxRGBA.Create(255, 0, 255, 96));
 959     tts := trigType2Str(trig.TriggerType);
 960     tx := trig.x+(trig.width-Length(tts)*6) div 2;
 961     darkenRect(tx-2, trig.y-10, Length(tts)*6+4, 10, 64);
 962     drawText6(tx, trig.y-9, tts, TGxRGBA.Create(255, 127, 0));
 963     tx := trig.x+(trig.width-Length(trig.mapId)*6) div 2;
 964     darkenRect(tx-2, trig.y-20, Length(trig.mapId)*6+4, 10, 64);
 965     drawText6(tx, trig.y-19, trig.mapId, TGxRGBA.Create(255, 255, 0));
 966     drawPanelDest(trig.trigPanelGUID);
 967     case trig.TriggerType of
 968       TRIGGER_NONE: begin end;
 969       TRIGGER_EXIT: begin end;
 970       TRIGGER_TELEPORT: begin end;
 971       TRIGGER_OPENDOOR: begin end;
 972       TRIGGER_CLOSEDOOR: begin end;
 973       TRIGGER_DOOR: begin end;
 974       TRIGGER_DOOR5: begin end;
 975       TRIGGER_CLOSETRAP: begin end;
 976       TRIGGER_TRAP: begin end;
 977       TRIGGER_SECRET: begin end;
 978       TRIGGER_LIFTUP: begin end;
 979       TRIGGER_LIFTDOWN: begin end;
 980       TRIGGER_LIFT: begin end;
 981       TRIGGER_TEXTURE: begin end;
 982       TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF, TRIGGER_PRESS:
 983         begin
 984           if (trig.trigDataRec.trigTWidth > 0) and (trig.trigDataRec.trigTHeight > 0) then
 985           begin
 986             fillRect(
 987               trig.trigDataRec.trigTX, trig.trigDataRec.trigTY,
 988               trig.trigDataRec.trigTWidth, trig.trigDataRec.trigTHeight,
 989               TGxRGBA.Create(0, 255, 255, 42));
 990             drawLine(
 991               trig.trigCenter.x, trig.trigCenter.y,
 992               trig.trigDataRec.trigTX+trig.trigDataRec.trigTWidth div 2,
 993               trig.trigDataRec.trigTY+trig.trigDataRec.trigTHeight div 2,
 994               TGxRGBA.Create(255, 0, 255, 220));
 995           end;
 996         end;
 997       TRIGGER_SOUND: begin end;
 998       TRIGGER_SPAWNMONSTER: begin end;
 999       TRIGGER_SPAWNITEM: begin end;
1000       TRIGGER_MUSIC: begin end;
1001       TRIGGER_PUSH: begin end;
1002       TRIGGER_SCORE: begin end;
1003       TRIGGER_MESSAGE: begin end;
1004       TRIGGER_DAMAGE: begin end;
1005       TRIGGER_HEALTH: begin end;
1006       TRIGGER_SHOT: begin end;
1007       TRIGGER_EFFECT: begin end;
1008       TRIGGER_SCRIPT: begin end;
1009     end;
1010     //trigType2Str
1011     //trigPanelId: Integer;
1012   end;
1013
1014   procedure drawTriggers ();
1015   var
1016     f: Integer;
1017   begin
1018     for f := 0 to High(gTriggers) do drawTrigger(gTriggers[f]);
1019   end;
1020
1021   procedure drawGibsBoxes ();
1022   var
1023     f: Integer;
1024     px, py, pw, ph: Integer;
1025     gib: PGib;
1026   begin
1027     for f := 0 to High(gGibs) do
1028     begin
1029       gib := @gGibs[f];
1030       if gib.alive then
1031       begin
1032         gib.getMapBox(px, py, pw, ph);
1033         drawRect(px, py, pw, ph, TGxRGBA.Create(255, 0, 255));
1034       end;
1035     end;
1036   end;
1037
1038 var
1039   scisave: TScissorSave;
1040   mon: TMonster;
1041   mx, my, mw, mh: Integer;
1042   //pan: TPanel;
1043   //ex, ey: Integer;
1044 begin
1045   if (gPlayer1 = nil) then exit;
1046
1047   scisave.save(true); // enable scissoring
1048   glPushMatrix();
1049   try
1050     //glScissor(0, gWinSizeY-gPlayerScreenSize.Y-1, vpw, vph);
1051     glScissor(0, gScreenHeight-gPlayerScreenSize.Y-1, gPlayerScreenSize.X, gPlayerScreenSize.Y);
1052
1053     glScalef(g_dbg_scale, g_dbg_scale, 1.0);
1054     glTranslatef(-vpx, -vpy, 0);
1055
1056     if (showGrid) then drawTileGrid();
1057     drawOutlines();
1058
1059     if (laserSet) then g_Mons_AlongLine(laserX0, laserY0, laserX1, laserY1, monsCollector, true);
1060
1061     if (monMarkedUID <> -1) then
1062     begin
1063       mon := g_Monsters_ByUID(monMarkedUID);
1064       if (mon <> nil) then
1065       begin
1066         mon.getMapBox(mx, my, mw, mh);
1067         e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 0, 0, 30);
1068         drawMonsterInfo(mon);
1069       end;
1070     end;
1071
1072     if showAllMonsCells and showGrid then g_Mons_ForEach(highlightAllMonsterCells);
1073     if showTriggers then drawTriggers();
1074     if showGrid then drawSelectedPlatformCells();
1075
1076     //drawAwakeCells();
1077
1078     if showTraceBox then drawTraceBox();
1079
1080     //drawGibsBoxes();
1081
1082
1083     //pan := g_Map_traceToNearest(16, 608, 16, 8, (GridTagObstacle or GridTagLiquid), @ex, @ey);
1084     (*
1085     {$IF DEFINED(D2F_DEBUG)}
1086     mapGrid.dbgRayTraceTileHitCB := hilightCell1;
1087     {$ENDIF}
1088     pan := mapGrid.traceRay(ex, ey, 16, 608, 16, 8, nil, (GridTagObstacle or GridTagLiquid));
1089     if (pan <> nil) then writeln('end=(', ex, ',', ey, ')');
1090     {$IF DEFINED(D2F_DEBUG)}
1091     mapGrid.dbgRayTraceTileHitCB := nil;
1092     {$ENDIF}
1093
1094     pan := g_Map_PanelAtPoint(16, 608, (GridTagObstacle or GridTagLiquid));
1095     if (pan <> nil) then writeln('hit!');
1096     *)
1097
1098   finally
1099     glPopMatrix();
1100     scisave.restore();
1101   end;
1102
1103   if showMapCurPos then drawText8(4, gWinSizeY-10, Format('mappos:(%d,%d)', [pmsCurMapX, pmsCurMapY]), TGxRGBA.Create(255, 255, 0));
1104 end;
1105
1106
1107 // ////////////////////////////////////////////////////////////////////////// //
1108 procedure g_Holmes_MouseEvent (var ev: THMouseEvent);
1109 var
1110   he: THMouseEvent;
1111 begin
1112   if g_Game_IsNet then exit;
1113   if not g_holmes_enabled then exit;
1114
1115   holmesInitCommands();
1116   holmesInitBinds();
1117   msX := ev.x;
1118   msY := ev.y;
1119   msB := ev.bstate;
1120   kbS := ev.kstate;
1121   msB := msB;
1122   he := ev;
1123   he.x := he.x;
1124   he.y := he.y;
1125   uiMouseEvent(he);
1126   if (not he.eaten) then plrDebugMouse(he);
1127   ev.eat();
1128 end;
1129
1130
1131 // ////////////////////////////////////////////////////////////////////////// //
1132 procedure g_Holmes_KeyEvent (var ev: THKeyEvent);
1133 var
1134   doeat: Boolean = false;
1135 {$IF DEFINED(D2F_DEBUG)}
1136   pan: TPanel;
1137   ex, ey: Integer;
1138   dx, dy: Integer;
1139 {$ENDIF}
1140
1141   procedure dummyWallTrc (cx, cy: Integer);
1142   begin
1143   end;
1144
1145 begin
1146   if g_Game_IsNet then exit;
1147   if not g_holmes_enabled then exit;
1148
1149   holmesInitCommands();
1150   holmesInitBinds();
1151
1152   msB := ev.bstate;
1153   kbS := ev.kstate;
1154   case ev.scan of
1155     SDL_SCANCODE_LCTRL, SDL_SCANCODE_RCTRL,
1156     SDL_SCANCODE_LALT, SDL_SCANCODE_RALT,
1157     SDL_SCANCODE_LSHIFT, SDL_SCANCODE_RSHIFT:
1158       doeat := true;
1159   end;
1160
1161   uiKeyEvent(ev);
1162   if (ev.eaten) then exit;
1163   if keybindExecute(ev) then begin ev.eat(); exit; end;
1164   // press
1165   if (ev.press) then
1166   begin
1167     {$IF DEFINED(D2F_DEBUG)}
1168     // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction
1169     if ((ev.scan = SDL_SCANCODE_UP) or (ev.scan = SDL_SCANCODE_DOWN) or (ev.scan = SDL_SCANCODE_LEFT) or (ev.scan = SDL_SCANCODE_RIGHT)) and
1170        ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
1171     begin
1172       ev.eat();
1173       dx := pmsCurMapX;
1174       dy := pmsCurMapY;
1175       case ev.scan of
1176         SDL_SCANCODE_UP: dy -= 120;
1177         SDL_SCANCODE_DOWN: dy += 120;
1178         SDL_SCANCODE_LEFT: dx -= 120;
1179         SDL_SCANCODE_RIGHT: dx += 120;
1180       end;
1181       {$IF DEFINED(D2F_DEBUG)}
1182       //mapGrid.dbgRayTraceTileHitCB := dummyWallTrc;
1183       mapGrid.dbgShowTraceLog := true;
1184       {$ENDIF}
1185       pan := g_Map_traceToNearest(pmsCurMapX, pmsCurMapY, dx, dy, (GridTagWall or GridTagDoor or GridTagStep or GridTagAcid1 or GridTagAcid2 or GridTagWater), @ex, @ey);
1186       {$IF DEFINED(D2F_DEBUG)}
1187       //mapGrid.dbgRayTraceTileHitCB := nil;
1188       mapGrid.dbgShowTraceLog := false;
1189       {$ENDIF}
1190       e_LogWritefln('v-trace: (%d,%d)-(%d,%d); end=(%d,%d); hit=%d', [pmsCurMapX, pmsCurMapY, dx, dy, ex, ey, (pan <> nil)]);
1191       exit;
1192     end;
1193     {$ENDIF}
1194   end;
1195   if (doeat) then ev.eat();
1196 end;
1197
1198
1199 // ////////////////////////////////////////////////////////////////////////// //
1200 procedure g_Holmes_Draw ();
1201 begin
1202   if g_Game_IsNet then exit;
1203
1204   {$IF not DEFINED(HEADLESS)}
1205   holmesInitCommands();
1206   holmesInitBinds();
1207
1208   glColorMask(GL_TRUE, GL_TRUE, GL_TRUE, GL_TRUE); // modify color buffer
1209   glDisable(GL_STENCIL_TEST);
1210   glDisable(GL_BLEND);
1211   glDisable(GL_SCISSOR_TEST);
1212   glDisable(GL_TEXTURE_2D);
1213
1214   if gGameOn then plrDebugDraw();
1215   {$ENDIF}
1216
1217   laserSet := false;
1218 end;
1219
1220
1221 procedure g_Holmes_DrawUI ();
1222 begin
1223   if g_Game_IsNet then exit;
1224   if not g_holmes_enabled then exit;
1225   {$IF not DEFINED(HEADLESS)}
1226   gGfxDoClear := false;
1227   //if assigned(prerenderFrameCB) then prerenderFrameCB();
1228   uiDraw();
1229   glMatrixMode(GL_MODELVIEW);
1230   glPushMatrix();
1231   try
1232     //glLoadIdentity();
1233     if assigned(postrenderFrameCB) then postrenderFrameCB();
1234   finally
1235     glPopMatrix();
1236   end;
1237   {$ENDIF}
1238 end;
1239
1240
1241 // ////////////////////////////////////////////////////////////////////////// //
1242 procedure bcOneMonsterThinkStep (); begin gmon_debug_think := false; gmon_debug_one_think_step := true; end;
1243 procedure bcOneMPlatThinkStep (); begin g_dbgpan_mplat_active := false; g_dbgpan_mplat_step := true; end;
1244 procedure bcMPlatToggle (); begin g_dbgpan_mplat_active := not g_dbgpan_mplat_active; end;
1245
1246 procedure bcToggleMonsterInfo (arg: Integer=-1); begin if (arg < 0) then showMonsInfo := not showMonsInfo else showMonsInfo := (arg > 0); end;
1247 procedure bcToggleMonsterLOSPlr (arg: Integer=-1); begin if (arg < 0) then showMonsLOS2Plr := not showMonsLOS2Plr else showMonsLOS2Plr := (arg > 0); end;
1248 procedure bcToggleMonsterCells (arg: Integer=-1); begin if (arg < 0) then showAllMonsCells := not showAllMonsCells else showAllMonsCells := (arg > 0); end;
1249 procedure bcToggleDrawTriggers (arg: Integer=-1); begin if (arg < 0) then showTriggers := not showTriggers else showTriggers := (arg > 0); end;
1250
1251 procedure bcToggleCurPos (arg: Integer=-1); begin if (arg < 0) then showMapCurPos := not showMapCurPos else showMapCurPos := (arg > 0); end;
1252 procedure bcToggleGrid (arg: Integer=-1); begin if (arg < 0) then showGrid := not showGrid else showGrid := (arg > 0); end;
1253
1254 procedure bcMonsterSpawn (s: AnsiString);
1255 var
1256   mon: TMonster;
1257 begin
1258   if not gGameOn or g_Game_IsClient then
1259   begin
1260     conwriteln('cannot spawn monster in this mode');
1261     exit;
1262   end;
1263   mon := g_Mons_SpawnAt(s, pmsCurMapX, pmsCurMapY);
1264   if (mon = nil) then begin conwritefln('unknown monster id: ''%s''', [s]); exit; end;
1265   monMarkedUID := mon.UID;
1266 end;
1267
1268 procedure bcMonsterWakeup ();
1269 var
1270   mon: TMonster;
1271 begin
1272   if (monMarkedUID <> -1) then
1273   begin
1274     mon := g_Monsters_ByUID(monMarkedUID);
1275     if (mon <> nil) then mon.WakeUp();
1276   end;
1277 end;
1278
1279 procedure bcPlayerTeleport ();
1280 var
1281   x, y, w, h: Integer;
1282 begin
1283   //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY);
1284   if (gPlayers[0] <> nil) then
1285   begin
1286     gPlayers[0].getMapBox(x, y, w, h);
1287     gPlayers[0].TeleportTo(pmsCurMapX-w div 2, pmsCurMapY-h div 2, true, 69); // 69: don't change dir
1288   end;
1289 end;
1290
1291 procedure dbgToggleTraceBox (arg: Integer=-1); begin if (arg < 0) then showTraceBox := not showTraceBox else showTraceBox := (arg > 0); end;
1292
1293 procedure dbgToggleHolmesPause (arg: Integer=-1); begin if (arg < 0) then g_Game_HolmesPause(not gPauseHolmes) else g_Game_HolmesPause(arg > 0); end;
1294
1295 procedure cbAtcurSelectMonster ();
1296   function monsAtDump (mon: TMonster; tag: Integer): Boolean;
1297   begin
1298     result := true; // stop
1299     e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), TMsgType.Notify);
1300     monMarkedUID := mon.UID;
1301     dumpPublishedProperties(mon);
1302   end;
1303 var
1304   plr: TPlayer;
1305   x, y, w, h: Integer;
1306 begin
1307   monMarkedUID := -1;
1308   if (Length(gPlayers) > 0) then
1309   begin
1310     plr := gPlayers[0];
1311     if (plr <> nil) then
1312     begin
1313       plr.getMapBox(x, y, w, h);
1314       if (pmsCurMapX >= x) and (pmsCurMapY >= y) and (pmsCurMapX < x+w) and (pmsCurMapY < y+h) then
1315       begin
1316         dumpPublishedProperties(plr);
1317       end;
1318     end;
1319   end;
1320   //e_WriteLog('===========================', MSG_NOTIFY);
1321   monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump);
1322   //e_WriteLog('---------------------------', MSG_NOTIFY);
1323 end;
1324
1325 procedure cbAtcurDumpMonsters ();
1326   function monsAtDump (mon: TMonster; tag: Integer): Boolean;
1327   begin
1328     result := false; // don't stop
1329     e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), TMsgType.Notify);
1330   end;
1331 begin
1332   e_WriteLog('===========================', TMsgType.Notify);
1333   monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump);
1334   e_WriteLog('---------------------------', TMsgType.Notify);
1335 end;
1336
1337 procedure cbAtcurDumpWalls ();
1338   function wallToggle (pan: TPanel; tag: Integer): Boolean;
1339   begin
1340     result := false; // don't stop
1341     if (platMarkedGUID = -1) then platMarkedGUID := pan.guid;
1342     e_LogWritefln('wall ''%s'' #%d(%d); enabled=%d (%d); (%d,%d)-(%d,%d)', [pan.mapId, pan.arrIdx, pan.proxyId, Integer(pan.Enabled), Integer(mapGrid.proxyEnabled[pan.proxyId]), pan.X, pan.Y, pan.Width, pan.Height]);
1343     dumpPublishedProperties(pan);
1344   end;
1345 var
1346   hasTrigs: Boolean = false;
1347   f: Integer;
1348   trig: PTrigger;
1349 begin
1350   platMarkedGUID := -1;
1351   e_WriteLog('=== TOGGLE WALL ===', TMsgType.Notify);
1352   mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor));
1353   e_WriteLog('--- toggle wall ---', TMsgType.Notify);
1354   if showTriggers then
1355   begin
1356     for f := 0 to High(gTriggers) do
1357     begin
1358       trig := @gTriggers[f];
1359       if (pmsCurMapX >= trig.x) and (pmsCurMapY >= trig.y) and (pmsCurMapX < trig.x+trig.width) and (pmsCurMapY < trig.y+trig.height) then
1360       begin
1361         if not hasTrigs then begin writeln('=== TRIGGERS ==='); hasTrigs := true; end;
1362         writeln('trigger ''', trig.mapId, ''' of type ''', trigType2Str(trig.TriggerType), '''');
1363       end;
1364     end;
1365     if hasTrigs then writeln('--- triggers ---');
1366   end;
1367 end;
1368
1369 procedure cbAtcurToggleWalls ();
1370   function wallToggle (pan: TPanel; tag: Integer): Boolean;
1371   begin
1372     result := false; // don't stop
1373     //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);
1374     if pan.Enabled then g_Map_DisableWallGUID(pan.guid) else g_Map_EnableWallGUID(pan.guid);
1375   end;
1376 begin
1377   //e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
1378   mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor));
1379   //e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
1380 end;
1381
1382
1383 // ////////////////////////////////////////////////////////////////////////// //
1384 procedure holmesInitCommands ();
1385 begin
1386   if (cmdlist <> nil) then exit;
1387   cmdAdd('win_layers', toggleLayersWindow, 'toggle layers window', 'window control');
1388   cmdAdd('win_outline', toggleOutlineWindow, 'toggle outline window', 'window control');
1389   cmdAdd('win_help', toggleHelpWindow, 'toggle help window', 'window control');
1390   cmdAdd('win_options', toggleOptionsWindow, 'toggle options window', 'window control');
1391
1392   cmdAdd('mon_think_step', bcOneMonsterThinkStep, 'one monster think step', 'monster control');
1393   cmdAdd('mon_info', bcToggleMonsterInfo, 'toggle monster info', 'monster control');
1394   cmdAdd('mon_los_plr', bcToggleMonsterLOSPlr, 'toggle monster LOS to player', 'monster control');
1395   cmdAdd('mon_cells', bcToggleMonsterCells, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control');
1396   cmdAdd('mon_wakeup', bcMonsterWakeup, 'wake up selected monster', 'monster control');
1397
1398   cmdAdd('mon_spawn', bcMonsterSpawn, 'spawn monster', 'monster control');
1399
1400   cmdAdd('mplat_step', bcOneMPlatThinkStep, 'one mplat think step', 'mplat control');
1401   cmdAdd('mplat_toggle', bcMPlatToggle, 'activate/deactivate moving platforms', 'mplat control');
1402
1403   cmdAdd('plr_teleport', bcPlayerTeleport, 'teleport player', 'player control');
1404
1405   cmdAdd('dbg_curpos', bcToggleCurPos, 'toggle "show cursor position on the map"', 'various');
1406   cmdAdd('dbg_grid', bcToggleGrid, 'toggle grid', 'various');
1407   cmdAdd('dbg_triggers', bcToggleDrawTriggers, 'show/hide triggers (SLOW!)', 'various');
1408
1409   cmdAdd('atcur_select_monster', cbAtcurSelectMonster, 'select monster to operate', 'monster control');
1410   cmdAdd('atcur_dump_monsters', cbAtcurDumpMonsters, 'dump monsters in cell', 'monster control');
1411   cmdAdd('atcur_dump_walls', cbAtcurDumpWalls, 'dump walls in cell', 'wall control');
1412   cmdAdd('atcur_disable_walls', cbAtcurToggleWalls, 'disable walls', 'wall control');
1413
1414   cmdAdd('dbg_tracebox', dbgToggleTraceBox, 'test traceBox()', 'player control');
1415
1416   cmdAdd('hlm_pause', dbgToggleHolmesPause, '"Holmes" pause mode', 'game control');
1417 end;
1418
1419
1420 procedure holmesInitBinds ();
1421 var
1422   st: TStream = nil;
1423   pr: TTextParser = nil;
1424   s, kn, v: AnsiString;
1425   kmods: Byte;
1426   mbuts: Byte;
1427 begin
1428   kbS := kbS;
1429   if not keybindsInited then
1430   begin
1431     // keyboard
1432     keybindAdd('F1', 'win_help');
1433     keybindAdd('M-F1', 'win_options');
1434     keybindAdd('C-O', 'win_outline');
1435     keybindAdd('C-L', 'win_layers');
1436
1437     keybindAdd('M-M', 'mon_think_step');
1438     keybindAdd('M-I', 'mon_info');
1439     keybindAdd('M-L', 'mon_los_plr');
1440     keybindAdd('M-G', 'mon_cells');
1441     keybindAdd('M-A', 'mon_wakeup');
1442
1443     keybindAdd('M-P', 'mplat_step');
1444     keybindAdd('M-O', 'mplat_toggle');
1445
1446     keybindAdd('C-T', 'plr_teleport');
1447     keybindAdd('M-T', 'dbg_tracebox');
1448
1449     keybindAdd('C-P', 'dbg_curpos');
1450     keybindAdd('C-G', 'dbg_grid');
1451     keybindAdd('C-X', 'dbg_triggers');
1452
1453     keybindAdd('C-1', 'mon_spawn zombie');
1454
1455     keybindAdd('C-S-P', 'hlm_pause');
1456
1457     // mouse
1458     msbindAdd('LMB', 'atcur_select_monster');
1459     msbindAdd('M-LMB', 'atcur_dump_monsters');
1460     msbindAdd('RMB', 'atcur_dump_walls');
1461     msbindAdd('M-RMB', 'atcur_disable_walls');
1462
1463     // load bindings from file
1464     try
1465       st := openDiskFileRO(GameDir+'holmes.rc');
1466       pr := TFileTextParser.Create(st);
1467       conwriteln('parsing "holmes.rc"...');
1468       while (pr.tokType <> pr.TTEOF) do
1469       begin
1470         s := pr.expectId();
1471              if (s = 'stop') then break
1472         else if (s = 'unbind_keys') then keybinds := nil
1473         else if (s = 'unbind_mouse') then msbinds := nil
1474         else if (s = 'bind') then
1475         begin
1476                if (pr.tokType = pr.TTStr) then s := pr.expectStr(false)
1477           else if (pr.tokType = pr.TTInt) then s := Format('%d', [pr.expectInt()])
1478           else s := pr.expectId();
1479
1480                if (pr.tokType = pr.TTStr) then v := pr.expectStr(false)
1481           else if (pr.tokType = pr.TTInt) then v := Format('%d', [pr.expectInt()])
1482           else v := pr.expectId();
1483
1484           kn := parseModKeys(s, kmods, mbuts);
1485           if (CompareText(kn, 'lmb') = 0) or (CompareText(kn, 'rmb') = 0) or (CompareText(kn, 'mmb') = 0) or (CompareText(kn, 'None') = 0) then
1486           begin
1487             msbindAdd(s, v);
1488           end
1489           else
1490           begin
1491             keybindAdd(s, v);
1492           end;
1493         end;
1494       end;
1495     except on e: Exception do // sorry
1496       if (pr <> nil) then conwritefln('Holmes config parse error at (%s,%s): %s', [pr.tokLine, pr.tokCol, e.message]);
1497     end;
1498     if (pr <> nil) then pr.Free() else st.Free(); // ownership
1499   end;
1500 end;
1501
1502
1503 procedure onMouseEvent (var ev: THMouseEvent);
1504 begin
1505   if not g_holmes_enabled then exit;
1506   g_Holmes_MouseEvent(ev);
1507 end;
1508
1509 procedure onKeyEvent (var ev: THKeyEvent);
1510 begin
1511   if not g_holmes_enabled then exit;
1512   g_Holmes_KeyEvent(ev);
1513 end;
1514
1515
1516 begin
1517   evMouseCB := onMouseEvent;
1518   evKeyCB := onKeyEvent;
1519
1520   conRegVar('hlm_ui_scale', @gh_ui_scale, 0.01, 5.0, 'Holmes UI scale', '', false);
1521 end.