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