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