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
 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 drawAwakeCells ();
 912   var
 913     x, y: Integer;
 914   begin
 915     for y := 0 to (mapGrid.gridHeight div mapGrid.tileSize) do
 916     begin
 917       for x := 0 to (mapGrid.gridWidth div mapGrid.tileSize) do
 918       begin
 919         if awmIsSetHolmes(x*mapGrid.tileSize+mapGrid.gridX0+1, y*mapGrid.tileSize++mapGrid.gridY0+1) then
 920         begin
 921           fillRect(x*mapGrid.tileSize++mapGrid.gridX0, y*mapGrid.tileSize++mapGrid.gridY0, monsGrid.tileSize, monsGrid.tileSize, 128, 0, 128, 64);
 922         end;
 923       end;
 924     end;
 925   end;
 926
 927   procedure hilightCell (cx, cy: Integer);
 928   begin
 929     fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize, 0, 128, 0, 64);
 930   end;
 931
 932   procedure hilightCell1 (cx, cy: Integer);
 933   begin
 934     //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
 935     fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize, 255, 255, 0, 92);
 936   end;
 937
 938   function hilightWallTrc (pan: TPanel; tag: Integer; x, y, prevx, prevy: Integer): Boolean;
 939   begin
 940     result := false; // don't stop
 941     if (pan = nil) then exit; // cell completion, ignore
 942     //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
 943     fillRect(pan.X, pan.Y, pan.Width, pan.Height, 0, 128, 128, 64);
 944   end;
 945
 946   function monsCollector (mon: TMonster; tag: Integer): Boolean;
 947   var
 948     ex, ey: Integer;
 949     mx, my, mw, mh: Integer;
 950   begin
 951     result := false;
 952     mon.getMapBox(mx, my, mw, mh);
 953     e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 255, 0, 96);
 954     if lineAABBIntersects(laserX0, laserY0, laserX1, laserY1, mx, my, mw, mh, ex, ey) then
 955     begin
 956       e_DrawPoint(8, ex, ey, 0, 255, 0);
 957     end;
 958   end;
 959
 960   procedure drawMonsterInfo (mon: TMonster);
 961   var
 962     mx, my, mw, mh: Integer;
 963
 964     procedure drawMonsterTargetLine ();
 965     var
 966       emx, emy, emw, emh: Integer;
 967       enemy: TMonster;
 968       eplr: TPlayer;
 969       ex, ey: Integer;
 970     begin
 971       if (g_GetUIDType(mon.MonsterTargetUID) = UID_PLAYER) then
 972       begin
 973         eplr := g_Player_Get(mon.MonsterTargetUID);
 974         if (eplr <> nil) then eplr.getMapBox(emx, emy, emw, emh) else exit;
 975       end
 976       else if (g_GetUIDType(mon.MonsterTargetUID) = UID_MONSTER) then
 977       begin
 978         enemy := g_Monsters_ByUID(mon.MonsterTargetUID);
 979         if (enemy <> nil) then enemy.getMapBox(emx, emy, emw, emh) else exit;
 980       end
 981       else
 982       begin
 983         exit;
 984       end;
 985       mon.getMapBox(mx, my, mw, mh);
 986       drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, 255, 0, 0, 255);
 987       if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
 988       begin
 989         drawLine(mx+mw div 2, my+mh div 2, ex, ey, 0, 255, 0, 255);
 990       end;
 991     end;
 992
 993     procedure drawLOS2Plr ();
 994     var
 995       emx, emy, emw, emh: Integer;
 996       eplr: TPlayer;
 997       ex, ey: Integer;
 998     begin
 999       eplr := gPlayers[0];
1000       if (eplr = nil) then exit;
1001       eplr.getMapBox(emx, emy, emw, emh);
1002       mon.getMapBox(mx, my, mw, mh);
1003       drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, 255, 0, 0, 255);
1004       {$IF DEFINED(D2F_DEBUG)}
1005       //mapGrid.dbgRayTraceTileHitCB := hilightCell1;
1006       {$ENDIF}
1007       if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
1008       //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
1009       begin
1010         drawLine(mx+mw div 2, my+mh div 2, ex, ey, 0, 255, 0, 255);
1011       end;
1012       {$IF DEFINED(D2F_DEBUG)}
1013       //mapGrid.dbgRayTraceTileHitCB := nil;
1014       {$ENDIF}
1015     end;
1016
1017   begin
1018     if (mon = nil) then exit;
1019     mon.getMapBox(mx, my, mw, mh);
1020     //mx += mw div 2;
1021
1022     monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
1023
1024     if showMonsInfo then
1025     begin
1026       //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
1027       darkenRect(mx-4, my-7*8-6, 110, 7*8+6, 128);
1028       my -= 8;
1029       my -= 2;
1030
1031       // type
1032       drawText6(mx, my, Format('%s(U:%u)', [monsTypeToString(mon.MonsterType), mon.UID]), 255, 127, 0); my -= 8;
1033       // beh
1034       drawText6(mx, my, Format('Beh: %s', [monsBehToString(mon.MonsterBehaviour)]), 255, 127, 0); my -= 8;
1035       // state
1036       drawText6(mx, my, Format('State:%s (%d)', [monsStateToString(mon.MonsterState), mon.MonsterSleep]), 255, 127, 0); my -= 8;
1037       // health
1038       drawText6(mx, my, Format('Health:%d', [mon.MonsterHealth]), 255, 127, 0); my -= 8;
1039       // ammo
1040       drawText6(mx, my, Format('Ammo:%d', [mon.MonsterAmmo]), 255, 127, 0); my -= 8;
1041       // target
1042       drawText6(mx, my, Format('TgtUID:%u', [mon.MonsterTargetUID]), 255, 127, 0); my -= 8;
1043       drawText6(mx, my, Format('TgtTime:%d', [mon.MonsterTargetTime]), 255, 127, 0); my -= 8;
1044     end;
1045
1046     drawMonsterTargetLine();
1047     if showMonsLOS2Plr then drawLOS2Plr();
1048     {
1049     property MonsterRemoved: Boolean read FRemoved write FRemoved;
1050     property MonsterPain: Integer read FPain write FPain;
1051     property MonsterAnim: Byte read FCurAnim write FCurAnim;
1052     }
1053   end;
1054
1055   function highlightAllMonsterCells (mon: TMonster): Boolean;
1056   begin
1057     result := false; // don't stop
1058     monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
1059   end;
1060
1061   procedure drawSelectedPlatformCells ();
1062   var
1063     pan: TPanel;
1064   begin
1065     if not showGrid then exit;
1066     pan := g_Map_PanelByGUID(platMarkedGUID);
1067     if (pan = nil) then exit;
1068     mapGrid.forEachBodyCell(pan.proxyId, hilightCell);
1069     drawRect(pan.x, pan.y, pan.width, pan.height, 0, 200, 0, 200);
1070   end;
1071
1072   procedure drawTrigger (var trig: TTrigger);
1073
1074     procedure drawPanelDest (pguid: Integer);
1075     var
1076       pan: TPanel;
1077     begin
1078       pan := g_Map_PanelByGUID(pguid);
1079       if (pan = nil) then exit;
1080       drawLine(
1081         trig.trigCenter.x, trig.trigCenter.y,
1082         pan.x+pan.width div 2, pan.y+pan.height div 2,
1083         255, 0, 255, 220);
1084     end;
1085
1086   var
1087     tts: AnsiString;
1088     tx: Integer;
1089   begin
1090     fillRect(trig.x, trig.y, trig.width, trig.height, 255, 0, 255, 96);
1091     tts := trigType2Str(trig.TriggerType);
1092     tx := trig.x+(trig.width-Length(tts)*6) div 2;
1093     darkenRect(tx-2, trig.y-10, Length(tts)*6+4, 10, 64);
1094     drawText6(tx, trig.y-9, tts, 255, 127, 0);
1095     tx := trig.x+(trig.width-Length(trig.mapId)*6) div 2;
1096     darkenRect(tx-2, trig.y-20, Length(trig.mapId)*6+4, 10, 64);
1097     drawText6(tx, trig.y-19, trig.mapId, 255, 255, 0);
1098     drawPanelDest(trig.trigPanelGUID);
1099     case trig.TriggerType of
1100       TRIGGER_NONE: begin end;
1101       TRIGGER_EXIT: begin end;
1102       TRIGGER_TELEPORT: begin end;
1103       TRIGGER_OPENDOOR: begin end;
1104       TRIGGER_CLOSEDOOR: begin end;
1105       TRIGGER_DOOR: begin end;
1106       TRIGGER_DOOR5: begin end;
1107       TRIGGER_CLOSETRAP: begin end;
1108       TRIGGER_TRAP: begin end;
1109       TRIGGER_SECRET: begin end;
1110       TRIGGER_LIFTUP: begin end;
1111       TRIGGER_LIFTDOWN: begin end;
1112       TRIGGER_LIFT: begin end;
1113       TRIGGER_TEXTURE: begin end;
1114       TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF, TRIGGER_PRESS:
1115         begin
1116           if (trig.trigData.trigTWidth > 0) and (trig.trigData.trigTHeight > 0) then
1117           begin
1118             fillRect(
1119               trig.trigData.trigTX, trig.trigData.trigTY,
1120               trig.trigData.trigTWidth, trig.trigData.trigTHeight,
1121               0, 255, 255, 42);
1122             drawLine(
1123               trig.trigCenter.x, trig.trigCenter.y,
1124               trig.trigData.trigTX+trig.trigData.trigTWidth div 2,
1125               trig.trigData.trigTY+trig.trigData.trigTHeight div 2,
1126               255, 0, 255, 220);
1127           end;
1128         end;
1129       TRIGGER_SOUND: begin end;
1130       TRIGGER_SPAWNMONSTER: begin end;
1131       TRIGGER_SPAWNITEM: begin end;
1132       TRIGGER_MUSIC: begin end;
1133       TRIGGER_PUSH: begin end;
1134       TRIGGER_SCORE: begin end;
1135       TRIGGER_MESSAGE: begin end;
1136       TRIGGER_DAMAGE: begin end;
1137       TRIGGER_HEALTH: begin end;
1138       TRIGGER_SHOT: begin end;
1139       TRIGGER_EFFECT: begin end;
1140       TRIGGER_SCRIPT: begin end;
1141     end;
1142     //trigType2Str
1143     //trigPanelId: Integer;
1144   end;
1145
1146   procedure drawTriggers ();
1147   var
1148     f: Integer;
1149   begin
1150     for f := 0 to High(gTriggers) do drawTrigger(gTriggers[f]);
1151   end;
1152
1153   procedure drawGibsBoxes ();
1154   var
1155     f: Integer;
1156     px, py, pw, ph: Integer;
1157     gib: PGib;
1158   begin
1159     for f := 0 to High(gGibs) do
1160     begin
1161       gib := @gGibs[f];
1162       if gib.alive then
1163       begin
1164         gib.getMapBox(px, py, pw, ph);
1165         drawRect(px, py, pw, ph, 255, 0, 255);
1166       end;
1167     end;
1168   end;
1169
1170 var
1171   mon: TMonster;
1172   mx, my, mw, mh: Integer;
1173 begin
1174   if (gPlayer1 = nil) then exit;
1175
1176   glEnable(GL_SCISSOR_TEST);
1177   glScissor(0, gWinSizeY-gPlayerScreenSize.Y-1, vpw, vph);
1178
1179   glPushMatrix();
1180   glScalef(g_dbg_scale, g_dbg_scale, 1.0);
1181   glTranslatef(-vpx, -vpy, 0);
1182
1183   if (showGrid) then drawTileGrid();
1184   drawOutlines();
1185
1186   if (laserSet) then g_Mons_AlongLine(laserX0, laserY0, laserX1, laserY1, monsCollector, true);
1187
1188   if (monMarkedUID <> -1) then
1189   begin
1190     mon := g_Monsters_ByUID(monMarkedUID);
1191     if (mon <> nil) then
1192     begin
1193       mon.getMapBox(mx, my, mw, mh);
1194       e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 0, 0, 30);
1195       drawMonsterInfo(mon);
1196     end;
1197   end;
1198
1199   if showAllMonsCells and showGrid then g_Mons_ForEach(highlightAllMonsterCells);
1200   if showTriggers then drawTriggers();
1201   if showGrid then drawSelectedPlatformCells();
1202
1203   drawAwakeCells();
1204
1205   //drawGibsBoxes();
1206
1207   glPopMatrix();
1208
1209   glDisable(GL_SCISSOR_TEST);
1210
1211   if showMapCurPos then drawText8(4, gWinSizeY-10, Format('mappos:(%d,%d)', [pmsCurMapX, pmsCurMapY]), 255, 255, 0);
1212 end;
1213
1214
1215 // ////////////////////////////////////////////////////////////////////////// //
1216 function g_Holmes_MouseEvent (var ev: THMouseEvent): Boolean;
1217 var
1218   he: THMouseEvent;
1219 begin
1220   holmesInitCommands();
1221   holmesInitBinds();
1222   result := true;
1223   msX := trunc(ev.x/g_holmes_ui_scale);
1224   msY := trunc(ev.y/g_holmes_ui_scale);
1225   msB := ev.bstate;
1226   kbS := ev.kstate;
1227   msB := msB;
1228   he := ev;
1229   he.x := trunc(he.x/g_holmes_ui_scale);
1230   he.y := trunc(he.y/g_holmes_ui_scale);
1231   if not uiMouseEvent(he) then plrDebugMouse(he);
1232 end;
1233
1234
1235 // ////////////////////////////////////////////////////////////////////////// //
1236 function g_Holmes_KeyEvent (var ev: THKeyEvent): Boolean;
1237 {$IF DEFINED(D2F_DEBUG)}
1238 var
1239   pan: TPanel;
1240   ex, ey: Integer;
1241   dx, dy: Integer;
1242 {$ENDIF}
1243
1244   procedure dummyWallTrc (cx, cy: Integer);
1245   begin
1246   end;
1247
1248 begin
1249   holmesInitCommands();
1250   holmesInitBinds();
1251   result := false;
1252   msB := ev.bstate;
1253   kbS := ev.kstate;
1254   case ev.scan of
1255     SDL_SCANCODE_LCTRL, SDL_SCANCODE_RCTRL,
1256     SDL_SCANCODE_LALT, SDL_SCANCODE_RALT,
1257     SDL_SCANCODE_LSHIFT, SDL_SCANCODE_RSHIFT:
1258       result := true;
1259   end;
1260   if uiKeyEvent(ev) then begin result := true; exit; end;
1261   if keybindExecute(ev) then begin result := true; exit; end;
1262   // press
1263   if (ev.kind = THKeyEvent.Press) then
1264   begin
1265     {$IF DEFINED(D2F_DEBUG)}
1266     // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction
1267     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
1268        ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
1269     begin
1270       result := true;
1271       dx := pmsCurMapX;
1272       dy := pmsCurMapY;
1273       case ev.scan of
1274         SDL_SCANCODE_UP: dy -= 120;
1275         SDL_SCANCODE_DOWN: dy += 120;
1276         SDL_SCANCODE_LEFT: dx -= 120;
1277         SDL_SCANCODE_RIGHT: dx += 120;
1278       end;
1279       {$IF DEFINED(D2F_DEBUG)}
1280       //mapGrid.dbgRayTraceTileHitCB := dummyWallTrc;
1281       mapGrid.dbgShowTraceLog := true;
1282       {$ENDIF}
1283       pan := g_Map_traceToNearest(pmsCurMapX, pmsCurMapY, dx, dy, (GridTagWall or GridTagDoor or GridTagStep or GridTagAcid1 or GridTagAcid2 or GridTagWater), @ex, @ey);
1284       {$IF DEFINED(D2F_DEBUG)}
1285       //mapGrid.dbgRayTraceTileHitCB := nil;
1286       mapGrid.dbgShowTraceLog := false;
1287       {$ENDIF}
1288       e_LogWritefln('v-trace: (%d,%d)-(%d,%d); end=(%d,%d); hit=%d', [pmsCurMapX, pmsCurMapY, dx, dy, ex, ey, (pan <> nil)]);
1289       exit;
1290     end;
1291     {$ENDIF}
1292   end;
1293 end;
1294
1295
1296 // ////////////////////////////////////////////////////////////////////////// //
1297 procedure g_Holmes_Draw ();
1298 begin
1299   {$IF not DEFINED(HEADLESS)}
1300   holmesInitCommands();
1301   holmesInitBinds();
1302
1303   glColorMask(GL_TRUE, GL_TRUE, GL_TRUE, GL_TRUE); // modify color buffer
1304   glDisable(GL_STENCIL_TEST);
1305   glDisable(GL_BLEND);
1306   glDisable(GL_SCISSOR_TEST);
1307   glDisable(GL_TEXTURE_2D);
1308
1309   if gGameOn then
1310   begin
1311     plrDebugDraw();
1312   end;
1313   {$ENDIF}
1314
1315   laserSet := false;
1316 end;
1317
1318
1319 procedure g_Holmes_DrawUI ();
1320 begin
1321   {$IF not DEFINED(HEADLESS)}
1322   glPushMatrix();
1323   glScalef(g_holmes_ui_scale, g_holmes_ui_scale, 1.0);
1324   uiDraw();
1325   drawCursor();
1326   glPopMatrix();
1327   {$ENDIF}
1328 end;
1329
1330
1331 // ////////////////////////////////////////////////////////////////////////// //
1332 procedure bcOneMonsterThinkStep (); begin gmon_debug_think := false; gmon_debug_one_think_step := true; end;
1333 procedure bcOneMPlatThinkStep (); begin g_dbgpan_mplat_active := false; g_dbgpan_mplat_step := true; end;
1334 procedure bcMPlatToggle (); begin g_dbgpan_mplat_active := not g_dbgpan_mplat_active; end;
1335
1336 procedure bcToggleMonsterInfo (arg: Integer=-1); begin if (arg < 0) then showMonsInfo := not showMonsInfo else showMonsInfo := (arg > 0); end;
1337 procedure bcToggleMonsterLOSPlr (arg: Integer=-1); begin if (arg < 0) then showMonsLOS2Plr := not showMonsLOS2Plr else showMonsLOS2Plr := (arg > 0); end;
1338 procedure bcToggleMonsterCells (arg: Integer=-1); begin if (arg < 0) then showAllMonsCells := not showAllMonsCells else showAllMonsCells := (arg > 0); end;
1339 procedure bcToggleDrawTriggers (arg: Integer=-1); begin if (arg < 0) then showTriggers := not showTriggers else showTriggers := (arg > 0); end;
1340
1341 procedure bcToggleCurPos (arg: Integer=-1); begin if (arg < 0) then showMapCurPos := not showMapCurPos else showMapCurPos := (arg > 0); end;
1342 procedure bcToggleGrid (arg: Integer=-1); begin if (arg < 0) then showGrid := not showGrid else showGrid := (arg > 0); end;
1343
1344 procedure bcMonsterSpawn (s: AnsiString);
1345 var
1346   mon: TMonster;
1347 begin
1348   if not gGameOn or g_Game_IsClient then
1349   begin
1350     conwriteln('cannot spawn monster in this mode');
1351     exit;
1352   end;
1353   mon := g_Mons_SpawnAt(s, pmsCurMapX, pmsCurMapY);
1354   if (mon = nil) then begin conwritefln('unknown monster id: ''%s''', [s]); exit; end;
1355   monMarkedUID := mon.UID;
1356 end;
1357
1358 procedure bcMonsterWakeup ();
1359 var
1360   mon: TMonster;
1361 begin
1362   if (monMarkedUID <> -1) then
1363   begin
1364     mon := g_Monsters_ByUID(monMarkedUID);
1365     if (mon <> nil) then mon.WakeUp();
1366   end;
1367 end;
1368
1369 procedure bcPlayerTeleport ();
1370 var
1371   x, y, w, h: Integer;
1372 begin
1373   //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY);
1374   if (gPlayers[0] <> nil) then
1375   begin
1376     gPlayers[0].getMapBox(x, y, w, h);
1377     gPlayers[0].TeleportTo(pmsCurMapX-w div 2, pmsCurMapY-h div 2, true, 69); // 69: don't change dir
1378   end;
1379 end;
1380
1381 procedure cbAtcurSelectMonster ();
1382   function monsAtDump (mon: TMonster; tag: Integer): Boolean;
1383   begin
1384     result := true; // stop
1385     e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), MSG_NOTIFY);
1386     monMarkedUID := mon.UID;
1387     dumpPublishedProperties(mon);
1388   end;
1389 var
1390   plr: TPlayer;
1391   x, y, w, h: Integer;
1392 begin
1393   monMarkedUID := -1;
1394   if (Length(gPlayers) > 0) then
1395   begin
1396     plr := gPlayers[0];
1397     if (plr <> nil) then
1398     begin
1399       plr.getMapBox(x, y, w, h);
1400       if (pmsCurMapX >= x) and (pmsCurMapY >= y) and (pmsCurMapX < x+w) and (pmsCurMapY < y+h) then
1401       begin
1402         dumpPublishedProperties(plr);
1403       end;
1404     end;
1405   end;
1406   //e_WriteLog('===========================', MSG_NOTIFY);
1407   monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump);
1408   //e_WriteLog('---------------------------', MSG_NOTIFY);
1409 end;
1410
1411 procedure cbAtcurDumpMonsters ();
1412   function monsAtDump (mon: TMonster; tag: Integer): Boolean;
1413   begin
1414     result := false; // don't stop
1415     e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), MSG_NOTIFY);
1416   end;
1417 begin
1418   e_WriteLog('===========================', MSG_NOTIFY);
1419   monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump);
1420   e_WriteLog('---------------------------', MSG_NOTIFY);
1421 end;
1422
1423 procedure cbAtcurDumpWalls ();
1424   function wallToggle (pan: TPanel; tag: Integer): Boolean;
1425   begin
1426     result := false; // don't stop
1427     if (platMarkedGUID = -1) then platMarkedGUID := pan.guid;
1428     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]);
1429     dumpPublishedProperties(pan);
1430   end;
1431 var
1432   hasTrigs: Boolean = false;
1433   f: Integer;
1434   trig: PTrigger;
1435 begin
1436   platMarkedGUID := -1;
1437   e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
1438   mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor));
1439   e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
1440   if showTriggers then
1441   begin
1442     for f := 0 to High(gTriggers) do
1443     begin
1444       trig := @gTriggers[f];
1445       if (pmsCurMapX >= trig.x) and (pmsCurMapY >= trig.y) and (pmsCurMapX < trig.x+trig.width) and (pmsCurMapY < trig.y+trig.height) then
1446       begin
1447         if not hasTrigs then begin writeln('=== TRIGGERS ==='); hasTrigs := true; end;
1448         writeln('trigger ''', trig.mapId, ''' of type ''', trigType2Str(trig.TriggerType), '''');
1449       end;
1450     end;
1451     if hasTrigs then writeln('--- triggers ---');
1452   end;
1453 end;
1454
1455 procedure cbAtcurToggleWalls ();
1456   function wallToggle (pan: TPanel; tag: Integer): Boolean;
1457   begin
1458     result := false; // don't stop
1459     //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);
1460     if pan.Enabled then g_Map_DisableWallGUID(pan.guid) else g_Map_EnableWallGUID(pan.guid);
1461   end;
1462 begin
1463   //e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
1464   mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor));
1465   //e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
1466 end;
1467
1468
1469 // ////////////////////////////////////////////////////////////////////////// //
1470 procedure holmesInitCommands ();
1471 begin
1472   if (cmdlist <> nil) then exit;
1473   cmdAdd('win_layers', toggleLayersWindow, 'toggle layers window', 'window control');
1474   cmdAdd('win_outline', toggleOutlineWindow, 'toggle outline window', 'window control');
1475   cmdAdd('win_help', toggleHelpWindow, 'toggle help window', 'window control');
1476   cmdAdd('win_options', toggleOptionsWindow, 'toggle options window', 'window control');
1477
1478   cmdAdd('mon_think_step', bcOneMonsterThinkStep, 'one monster think step', 'monster control');
1479   cmdAdd('mon_info', bcToggleMonsterInfo, 'toggle monster info', 'monster control');
1480   cmdAdd('mon_los_plr', bcToggleMonsterLOSPlr, 'toggle monster LOS to player', 'monster control');
1481   cmdAdd('mon_cells', bcToggleMonsterCells, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control');
1482   cmdAdd('mon_wakeup', bcMonsterWakeup, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control');
1483
1484   cmdAdd('mon_spawn', bcMonsterSpawn, 'spawn monster', 'monster control');
1485
1486   cmdAdd('mplat_step', bcOneMPlatThinkStep, 'one mplat think step', 'mplat control');
1487   cmdAdd('mplat_toggle', bcMPlatToggle, 'activate/deactivate moving platforms', 'mplat control');
1488
1489   cmdAdd('plr_teleport', bcPlayerTeleport, 'teleport player', 'player control');
1490
1491   cmdAdd('dbg_curpos', bcToggleCurPos, 'toggle "show cursor position on the map"', 'various');
1492   cmdAdd('dbg_grid', bcToggleGrid, 'toggle grid', 'various');
1493   cmdAdd('dbg_triggers', bcToggleDrawTriggers, 'show/hide triggers (SLOW!)', 'various');
1494
1495   cmdAdd('atcur_select_monster', cbAtcurSelectMonster, 'select monster to operate', 'monster control');
1496   cmdAdd('atcur_dump_monsters', cbAtcurDumpMonsters, 'dump monsters in cell', 'monster control');
1497   cmdAdd('atcur_dump_walls', cbAtcurDumpWalls, 'dump walls in cell', 'wall control');
1498   cmdAdd('atcur_disable_walls', cbAtcurToggleWalls, 'disable walls', 'wall control');
1499 end;
1500
1501
1502 procedure holmesInitBinds ();
1503 var
1504   st: TStream = nil;
1505   pr: TTextParser = nil;
1506   s, kn, v: AnsiString;
1507   kmods: Byte;
1508   mbuts: Byte;
1509 begin
1510   kbS := kbS;
1511   if not keybindsInited then
1512   begin
1513     // keyboard
1514     keybindAdd('F1', 'win_help');
1515     keybindAdd('M-F1', 'win_options');
1516     keybindAdd('C-O', 'win_outline');
1517     keybindAdd('C-L', 'win_layers');
1518
1519     keybindAdd('M-M', 'mon_think_step');
1520     keybindAdd('M-I', 'mon_info');
1521     keybindAdd('M-L', 'mon_los_plr');
1522     keybindAdd('M-G', 'mon_cells');
1523     keybindAdd('M-A', 'mon_wakeup');
1524
1525     keybindAdd('M-P', 'mplat_step');
1526     keybindAdd('M-O', 'mplat_toggle');
1527
1528     keybindAdd('C-T', 'plr_teleport');
1529
1530     keybindAdd('C-P', 'dbg_curpos');
1531     keybindAdd('C-G', 'dbg_grid');
1532     keybindAdd('C-X', 'dbg_triggers');
1533
1534     keybindAdd('C-1', 'mon_spawn zombie');
1535
1536     // mouse
1537     msbindAdd('LMB', 'atcur_select_monster');
1538     msbindAdd('M-LMB', 'atcur_dump_monsters');
1539     msbindAdd('RMB', 'atcur_dump_walls');
1540     msbindAdd('M-RMB', 'atcur_disable_walls');
1541
1542     // load bindings from file
1543     try
1544       st := openDiskFileRO(GameDir+'holmes.rc');
1545       pr := TFileTextParser.Create(st);
1546       conwriteln('parsing "holmes.rc"...');
1547       while (pr.tokType <> pr.TTEOF) do
1548       begin
1549         s := pr.expectId();
1550              if (s = 'stop') then break
1551         else if (s = 'unbind_keys') then keybinds := nil
1552         else if (s = 'unbind_mouse') then msbinds := nil
1553         else if (s = 'bind') then
1554         begin
1555                if (pr.tokType = pr.TTStr) then s := pr.expectStr(false)
1556           else if (pr.tokType = pr.TTInt) then s := Format('%d', [pr.expectInt()])
1557           else s := pr.expectId();
1558
1559                if (pr.tokType = pr.TTStr) then v := pr.expectStr(false)
1560           else if (pr.tokType = pr.TTInt) then v := Format('%d', [pr.expectInt()])
1561           else v := pr.expectId();
1562
1563           kn := parseModKeys(s, kmods, mbuts);
1564           if (CompareText(kn, 'lmb') = 0) or (CompareText(kn, 'rmb') = 0) or (CompareText(kn, 'mmb') = 0) or (CompareText(kn, 'None') = 0) then
1565           begin
1566             msbindAdd(s, v);
1567           end
1568           else
1569           begin
1570             keybindAdd(s, v);
1571           end;
1572         end;
1573       end;
1574     except on e: Exception do // sorry
1575       if (pr <> nil) then conwritefln('Holmes config parse error at (%s,%s): %s', [pr.tokLine, pr.tokCol, e.message]);
1576     end;
1577     if (pr <> nil) then pr.Free() else st.Free(); // ownership
1578   end;
1579 end;
1580
1581
1582 begin
1583   conRegVar('hlm_ui_scale', @g_holmes_ui_scale, 0.01, 5.0, 'Holmes UI scale', '', false);
1584 end.