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