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