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