1 (* Copyright (C) DooM 2D:Forever Developers
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.
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.
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/>.
16 {$INCLUDE ../shared/a_modes.inc}
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
,
32 // both for but and for bstate
45 kind
: Byte; // motion, press, release
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);
67 scan
: Word; // SDL_SCANCODE_XXX
68 sym
: Word; // SDLK_XXX
69 bstate
: Word; // button state
70 kstate
: Word; // keyboard state
75 procedure g_Holmes_VidModeChanged ();
76 procedure g_Holmes_WindowFocused ();
77 procedure g_Holmes_WindowBlured ();
79 procedure g_Holmes_Draw ();
80 procedure g_Holmes_DrawUI ();
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
86 procedure g_Holmes_plrView (viewPortX
, viewPortY
, viewPortW
, viewPortH
: Integer);
87 procedure g_Holmes_plrLaser (ax0
, ay0
, ax1
, ay1
: Integer);
90 operator
= (constref ev
: THKeyEvent
; const s
: AnsiString): Boolean;
91 operator
= (const s
: AnsiString; constref ev
: THKeyEvent
): Boolean;
93 operator
= (constref ev
: THMouseEvent
; const s
: AnsiString): Boolean;
94 operator
= (const s
: AnsiString; constref ev
: THMouseEvent
): Boolean;
98 g_holmes_enabled
: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}false{$ENDIF};
104 SysUtils
, Classes
, GL
, SDL2
,
105 MAPDEF
, g_main
, g_options
,
106 utils
, hashtable
, xparser
;
110 //globalInited: Boolean = false;
113 msB
: Word = 0; // button state
114 kbS
: Word = 0; // keyboard modifiers state
115 showGrid
: Boolean = true;
116 showMonsInfo
: Boolean = false;
117 showMonsLOS2Plr
: Boolean = false;
118 showAllMonsCells
: Boolean = false;
119 showMapCurPos
: Boolean = false;
120 showLayersWindow
: Boolean = false;
121 showOutlineWindow
: Boolean = false;
122 showTriggers
: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}false{$ENDIF};
124 // ////////////////////////////////////////////////////////////////////////// //
125 {$INCLUDE g_holmes.inc}
126 {$INCLUDE g_holmes_ui.inc}
129 // ////////////////////////////////////////////////////////////////////////// //
130 // any mods = 255: nothing was defined
131 function parseModKeys (const s
: AnsiString; out kmods
: Byte; out mbuts
: Byte): AnsiString;
138 //while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos);
139 if (pos
< Length(s
)) and ((s
[pos
] = '+') or (s
[pos
] = '-') or (s
[pos
] = '*')) then Inc(pos
);
140 while (pos
< Length(s
)) do
142 if (Length(s
)-pos
>= 2) and (s
[pos
+1] = '-') then
145 'C', 'c': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModCtrl
; Inc(pos
, 2); continue
; end;
146 'M', 'm': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModAlt
; Inc(pos
, 2); continue
; end;
147 'S', 's': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModShift
; Inc(pos
, 2); continue
; end;
151 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 'L', 'l': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Left
; Inc(pos
, 4); continue
; end;
155 'R', 'r': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Right
; Inc(pos
, 4); continue
; end;
156 'M', 'm': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Middle
; Inc(pos
, 4); continue
; end;
163 while (epos
> pos
) and (s
[epos
-1] <= ' ') do Dec(epos
);
164 if (epos
> pos
) then result
:= Copy(s
, pos
, epos
-pos
) else result
:= '';
168 operator
= (constref ev
: THKeyEvent
; const s
: AnsiString): Boolean;
176 if (Length(s
) > 0) then
178 if (s
[1] = '+') then begin if (ev
.kind
<> ev
.Press
) then exit
; end
179 else if (s
[1] = '-') then begin if (ev
.kind
<> ev
.Release
) then exit
; end
180 else if (s
[1] = '*') then begin end
181 else if (ev
.kind
<> ev
.Press
) then exit
;
183 kname
:= parseModKeys(s
, kmods
, mbuts
);
184 if (kmods
= 255) then kmods
:= 0;
185 if (ev
.kstate
<> kmods
) then exit
;
186 if (mbuts
<> 255) and (ev
.bstate
<> mbuts
) then exit
;
187 for f
:= 1 to High(e_KeyNames
) do
189 if (CompareText(kname
, e_KeyNames
[f
]) = 0) then
191 result
:= (ev
.scan
= f
);
198 operator
= (const s
: AnsiString; constref ev
: THKeyEvent
): Boolean;
204 operator
= (constref ev
: THMouseEvent
; const s
: AnsiString): Boolean;
213 if (Length(s
) > 0) then
215 if (s
[1] = '+') then begin if (ev
.kind
<> ev
.Press
) then exit
; end
216 else if (s
[1] = '-') then begin if (ev
.kind
<> ev
.Release
) then exit
; end
217 else if (s
[1] = '*') then begin if (ev
.kind
<> ev
.Motion
) then exit
; end
218 else if (ev
.kind
<> ev
.Press
) then exit
;
221 kname
:= parseModKeys(s
, kmods
, mbuts
);
222 if (CompareText(kname
, 'LMB') = 0) then but
:= THMouseEvent
.Left
223 else if (CompareText(kname
, 'RMB') = 0) then but
:= THMouseEvent
.Right
224 else if (CompareText(kname
, 'MMB') = 0) then but
:= THMouseEvent
.Middle
225 else if (CompareText(kname
, 'None') = 0) then but
:= 0
228 //conwritefln('s=[%s]; kname=[%s]; kmods=%s; mbuts=%s; but=%s', [s, kname, kmods, mbuts, but]);
230 if (mbuts
= 255) then mbuts
:= 0;
231 if (kmods
= 255) then kmods
:= 0;
232 if (ev
.kstate
<> kmods
) then exit
;
234 if (ev
.kind
= ev
.Press
) then mbuts
:= mbuts
or but
235 else if (ev
.kind
= ev
.Release
) then mbuts
:= mbuts
and (not but
);
237 //conwritefln(' ev.bstate=%s; ev.but=%s; mbuts=%s', [ev.bstate, ev.but, mbuts]);
239 result
:= (ev
.bstate
= mbuts
) and (ev
.but
= but
);
243 operator
= (const s
: AnsiString; constref ev
: THMouseEvent
): Boolean;
249 // ////////////////////////////////////////////////////////////////////////// //
251 function trigType2Str (ttype
: Integer): AnsiString;
253 result
:= '<unknown>';
255 TRIGGER_NONE
: result
:= 'none';
256 TRIGGER_EXIT
: result
:= 'exit';
257 TRIGGER_TELEPORT
: result
:= 'teleport';
258 TRIGGER_OPENDOOR
: result
:= 'opendoor';
259 TRIGGER_CLOSEDOOR
: result
:= 'closedoor';
260 TRIGGER_DOOR
: result
:= 'door';
261 TRIGGER_DOOR5
: result
:= 'door5';
262 TRIGGER_CLOSETRAP
: result
:= 'closetrap';
263 TRIGGER_TRAP
: result
:= 'trap';
264 TRIGGER_PRESS
: result
:= 'press';
265 TRIGGER_SECRET
: result
:= 'secret';
266 TRIGGER_LIFTUP
: result
:= 'liftup';
267 TRIGGER_LIFTDOWN
: result
:= 'liftdown';
268 TRIGGER_LIFT
: result
:= 'lift';
269 TRIGGER_TEXTURE
: result
:= 'texture';
270 TRIGGER_ON
: result
:= 'on';
271 TRIGGER_OFF
: result
:= 'off';
272 TRIGGER_ONOFF
: result
:= 'onoff';
273 TRIGGER_SOUND
: result
:= 'sound';
274 TRIGGER_SPAWNMONSTER
: result
:= 'spawnmonster';
275 TRIGGER_SPAWNITEM
: result
:= 'spawnitem';
276 TRIGGER_MUSIC
: result
:= 'music';
277 TRIGGER_PUSH
: result
:= 'push';
278 TRIGGER_SCORE
: result
:= 'score';
279 TRIGGER_MESSAGE
: result
:= 'message';
280 TRIGGER_DAMAGE
: result
:= 'damage';
281 TRIGGER_HEALTH
: result
:= 'health';
282 TRIGGER_SHOT
: result
:= 'shot';
283 TRIGGER_EFFECT
: result
:= 'effect';
284 TRIGGER_SCRIPT
: result
:= 'script';
288 // ////////////////////////////////////////////////////////////////////////// //
289 {$INCLUDE g_holmes_cmd.inc}
290 procedure holmesInitCommands (); forward;
291 procedure holmesInitBinds (); forward;
294 // ////////////////////////////////////////////////////////////////////////// //
296 g_ol_nice
: Boolean = false;
297 g_ol_fill_walls
: Boolean = false;
298 g_ol_rlayer_back
: Boolean = false;
299 g_ol_rlayer_step
: Boolean = false;
300 g_ol_rlayer_wall
: Boolean = false;
301 g_ol_rlayer_door
: Boolean = false;
302 g_ol_rlayer_acid1
: Boolean = false;
303 g_ol_rlayer_acid2
: Boolean = false;
304 g_ol_rlayer_water
: Boolean = false;
305 g_ol_rlayer_fore
: Boolean = false;
308 // ////////////////////////////////////////////////////////////////////////// //
310 winHelp
: THTopWindow
= nil;
311 winOptions
: THTopWindow
= nil;
312 winLayers
: THTopWindow
= nil;
313 winOutlines
: THTopWindow
= nil;
316 procedure createHelpWindow (); forward;
317 procedure createOptionsWindow (); forward;
318 procedure createLayersWindow (); forward;
319 procedure createOutlinesWindow (); forward;
322 procedure toggleLayersWindowCB (me
: THControl
; checked
: Integer);
324 if showLayersWindow
then
326 if (winLayers
= nil) then createLayersWindow();
327 uiAddWindow(winLayers
);
331 uiRemoveWindow(winLayers
);
336 procedure toggleOutlineWindowCB (me
: THControl
; checked
: Integer);
338 if showOutlineWindow
then
340 if (winOutlines
= nil) then createOutlinesWindow();
341 uiAddWindow(winOutlines
);
345 uiRemoveWindow(winOutlines
);
350 procedure createHelpWindow ();
352 llb
: THCtlSimpleText
;
353 slist
: array of AnsiString = nil;
355 bind
: THolmesBinding
;
356 f
, maxkeylen
: Integer;
359 for cmd
in cmdlist
do cmd
.helpmark
:= false;
362 for bind
in keybinds
do
364 if (Length(bind
.key
) = 0) then continue
;
365 if cmdlist
.get(bind
.cmdName
, cmd
) then
367 if (Length(cmd
.help
) > 0) then
369 cmd
.helpmark
:= true;
370 if (maxkeylen
< Length(bind
.key
)) then maxkeylen
:= Length(bind
.key
);
375 for cmd
in cmdlist
do
377 if not cmd
.helpmark
then continue
;
378 if (Length(cmd
.help
) = 0) then continue
;
380 while (f
< Length(slist
)) and (CompareText(slist
[f
], cmd
.section
) <> 0) do Inc(f
);
381 if (f
= Length(slist
)) then
383 SetLength(slist
, Length(slist
)+1);
384 slist
[High(slist
)] := cmd
.section
;
388 llb
:= THCtlSimpleText
.Create(0, 0);
389 for f
:= 0 to High(slist
) do
391 if (f
> 0) then llb
.appendItem('');
392 llb
.appendItem(slist
[f
], true, true);
393 for cmd
in cmdlist
do
395 if not cmd
.helpmark
then continue
;
396 if (CompareText(cmd
.section
, slist
[f
]) <> 0) then continue
;
397 for bind
in keybinds
do
399 if (Length(bind
.key
) = 0) then continue
;
400 if (cmd
.name
= bind
.cmdName
) then
403 while (Length(s
) < maxkeylen
) do s
+= ' ';
404 s
:= ' '+s
+' -- '+cmd
.help
;
412 for bind
in msbinds
do
414 if (Length(bind
.key
) = 0) then continue
;
415 if cmdlist
.get(bind
.cmdName
, cmd
) then
417 if (Length(cmd
.help
) > 0) then
419 cmd
.helpmark
:= true;
420 if (maxkeylen
< Length(bind
.key
)) then maxkeylen
:= Length(bind
.key
);
426 llb
.appendItem('mouse', true, true);
427 for bind
in msbinds
do
429 if (Length(bind
.key
) = 0) then continue
;
430 if cmdlist
.get(bind
.cmdName
, cmd
) then
432 if (Length(cmd
.help
) > 0) then
435 while (Length(s
) < maxkeylen
) do s
+= ' ';
436 s
:= ' '+s
+' -- '+cmd
.help
;
442 winHelp
:= THTopWindow
.Create('Holmes Help', 10, 10);
443 winHelp
.escClose
:= true;
444 winHelp
.appendChild(llb
);
445 winHelp
.centerInScreen();
449 procedure winLayersClosed (me
: THControl
; dummy
: Integer); begin showLayersWindow
:= false; end;
450 procedure winOutlinesClosed (me
: THControl
; dummy
: Integer); begin showOutlineWindow
:= false; end;
452 procedure createLayersWindow ();
456 llb
:= THCtlCBListBox
.Create(0, 0);
457 llb
.appendItem('background', @g_rlayer_back
);
458 llb
.appendItem('steps', @g_rlayer_step
);
459 llb
.appendItem('walls', @g_rlayer_wall
);
460 llb
.appendItem('doors', @g_rlayer_door
);
461 llb
.appendItem('acid1', @g_rlayer_acid1
);
462 llb
.appendItem('acid2', @g_rlayer_acid2
);
463 llb
.appendItem('water', @g_rlayer_water
);
464 llb
.appendItem('foreground', @g_rlayer_fore
);
465 winLayers
:= THTopWindow
.Create('layers', 10, 10);
466 winLayers
.escClose
:= true;
467 winLayers
.appendChild(llb
);
468 winLayers
.closeCB
:= winLayersClosed
;
472 procedure createOutlinesWindow ();
476 llb
:= THCtlCBListBox
.Create(0, 0);
477 llb
.appendItem('background', @g_ol_rlayer_back
);
478 llb
.appendItem('steps', @g_ol_rlayer_step
);
479 llb
.appendItem('walls', @g_ol_rlayer_wall
);
480 llb
.appendItem('doors', @g_ol_rlayer_door
);
481 llb
.appendItem('acid1', @g_ol_rlayer_acid1
);
482 llb
.appendItem('acid2', @g_ol_rlayer_acid2
);
483 llb
.appendItem('water', @g_ol_rlayer_water
);
484 llb
.appendItem('foreground', @g_ol_rlayer_fore
);
485 llb
.appendItem('OPTIONS', nil);
486 llb
.appendItem('fill walls', @g_ol_fill_walls
);
487 llb
.appendItem('contours', @g_ol_nice
);
488 winOutlines
:= THTopWindow
.Create('outlines', 100, 10);
489 winOutlines
.escClose
:= true;
490 winOutlines
.appendChild(llb
);
491 winOutlines
.closeCB
:= winOutlinesClosed
;
495 procedure createOptionsWindow ();
499 llb
:= THCtlCBListBox
.Create(0, 0);
500 llb
.appendItem('map grid', @showGrid
);
501 llb
.appendItem('cursor position on map', @showMapCurPos
);
502 llb
.appendItem('monster info', @showMonsInfo
);
503 llb
.appendItem('monster LOS to player', @showMonsLOS2Plr
);
504 llb
.appendItem('monster cells (SLOW!)', @showAllMonsCells
);
505 llb
.appendItem('draw triggers (SLOW!)', @showTriggers
);
506 llb
.appendItem('WINDOWS', nil);
507 llb
.appendItem('layers window', @showLayersWindow
, toggleLayersWindowCB
);
508 llb
.appendItem('outline window', @showOutlineWindow
, toggleOutlineWindowCB
);
509 winOptions
:= THTopWindow
.Create('Holmes Options', 100, 100);
510 winOptions
.escClose
:= true;
511 winOptions
.appendChild(llb
);
512 winOptions
.centerInScreen();
516 procedure toggleLayersWindow (arg
: Integer=-1);
518 showLayersWindow
:= not showLayersWindow
;
519 toggleLayersWindowCB(nil, 0);
522 procedure toggleOutlineWindow (arg
: Integer=-1);
524 showOutlineWindow
:= not showOutlineWindow
;
525 toggleOutlineWindowCB(nil, 0);
528 procedure toggleHelpWindow (arg
: Integer=-1);
530 if (winHelp
= nil) then createHelpWindow();
531 if not uiVisibleWindow(winHelp
) then uiAddWindow(winHelp
) else uiRemoveWindow(winHelp
);
534 procedure toggleOptionsWindow (arg
: Integer=-1);
536 if (winOptions
= nil) then createOptionsWindow();
537 if not uiVisibleWindow(winOptions
) then uiAddWindow(winOptions
) else uiRemoveWindow(winOptions
);
541 // ////////////////////////////////////////////////////////////////////////// //
542 procedure g_Holmes_VidModeChanged ();
544 e_WriteLog(Format('Holmes: videomode changed: %dx%d', [gScreenWidth
, gScreenHeight
]), MSG_NOTIFY
);
545 // texture space is possibly lost here, idc
551 //createCursorTexture();
554 procedure g_Holmes_WindowFocused ();
560 procedure g_Holmes_WindowBlured ();
565 // ////////////////////////////////////////////////////////////////////////// //
567 vpSet
: Boolean = false;
570 laserSet
: Boolean = false;
571 laserX0
, laserY0
, laserX1
, laserY1
: Integer;
572 monMarkedUID
: Integer = -1;
575 procedure g_Holmes_plrView (viewPortX
, viewPortY
, viewPortW
, viewPortH
: Integer);
584 procedure g_Holmes_plrLaser (ax0
, ay0
, ax1
, ay1
: Integer);
591 laserSet
:= laserSet
; // shut up, fpc!
595 function pmsCurMapX (): Integer; inline; begin result
:= msX
+vpx
; end;
596 function pmsCurMapY (): Integer; inline; begin result
:= msY
+vpy
; end;
599 procedure plrDebugMouse (var ev
: THMouseEvent
);
601 //e_WriteLog(Format('mouse: x=%d; y=%d; but=%d; bstate=%d', [msx, msy, but, bstate]), MSG_NOTIFY);
602 if (gPlayer1
= nil) or not vpSet
then exit
;
603 //if (ev.kind <> THMouseEvent.Press) then exit;
604 //e_WriteLog(Format('mev: %d', [Integer(ev.kind)]), MSG_NOTIFY);
610 edgeBmp
: array of Byte = nil;
613 procedure drawOutlines ();
617 procedure clearEdgeBmp ();
619 SetLength(edgeBmp
, (gWinSizeX
+4)*(gWinSizeY
+4));
620 FillChar(edgeBmp
[0], Length(edgeBmp
)*sizeof(edgeBmp
[0]), 0);
623 procedure drawPanel (pan
: TPanel
);
625 sx
, len
, y0
, y1
: Integer;
627 if (pan
= nil) or (pan
.Width
< 1) or (pan
.Height
< 1) then exit
;
628 if (pan
.X
+pan
.Width
<= vpx
-1) or (pan
.Y
+pan
.Height
<= vpy
-1) then exit
;
629 if (pan
.X
>= vpx
+vpw
+1) or (pan
.Y
>= vpy
+vph
+1) then exit
;
630 if g_ol_nice
or g_ol_fill_walls
then
634 if (len
> gWinSizeX
+4) then len
:= gWinSizeX
+4;
635 if (sx
< 0) then begin len
+= sx
; sx
:= 0; end;
636 if (sx
+len
> gWinSizeX
+4) then len
:= gWinSizeX
+4-sx
;
637 if (len
< 1) then exit
;
639 assert(sx
+len
<= gWinSizeX
+4);
642 if (y0
< 0) then y0
:= 0;
643 if (y1
> gWinSizeY
+4) then y1
:= gWinSizeY
+4;
646 FillChar(edgeBmp
[y0
*(gWinSizeX
+4)+sx
], len
*sizeof(edgeBmp
[0]), 1);
652 drawRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, r
, g
, b
);
661 procedure flushLine ();
663 if (lsy
> 0) and (lsx
> 0) then
668 glVertex2f(lsx
-1+vpx
+0.37, lsy
-1+vpy
+0.37);
674 glVertex2f(lsx
-1+vpx
+0.37, lsy
-1+vpy
+0.37);
675 glVertex2f(lex
-0+vpx
+0.37, lsy
-1+vpy
+0.37);
683 procedure startLine (y
: Integer);
689 procedure putPixel (x
: Integer);
691 if (x
< 1) then exit
;
692 if (lex
+1 <> x
) then flushLine();
693 if (lsx
< 0) then lsx
:= x
;
697 procedure drawEdges ();
703 glDisable(GL_TEXTURE_2D
);
706 glDisable(GL_LINE_SMOOTH
);
707 glDisable(GL_POLYGON_SMOOTH
);
708 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
711 a
:= @edgeBmp
[y
*(gWinSizeX
+4)+1];
717 if (a
[-1] = 0) or (a
[1] = 0) or (a
[-(gWinSizeX
+4)] = 0) or (a
[gWinSizeX
+4] = 0) or
718 (a
[-(gWinSizeX
+4)-1] = 0) or (a
[-(gWinSizeX
+4)+1] = 0) or
719 (a
[gWinSizeX
+4-1] = 0) or (a
[gWinSizeX
+4+1] = 0) then
730 procedure drawFilledWalls ();
736 glDisable(GL_TEXTURE_2D
);
739 glDisable(GL_LINE_SMOOTH
);
740 glDisable(GL_POLYGON_SMOOTH
);
741 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
744 a
:= @edgeBmp
[y
*(gWinSizeX
+4)+1];
748 if (a
[0] <> 0) then putPixel(x
);
755 procedure doWallsOld (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
763 if g_ol_nice
or g_ol_fill_walls
then clearEdgeBmp();
764 for f
:= 0 to High(parr
) do
767 if (pan
= nil) or not pan
.Enabled
or (pan
.Width
< 1) or (pan
.Height
< 1) then continue
;
768 if ((pan
.PanelType
and ptype
) = 0) then continue
;
771 if g_ol_nice
then drawEdges();
772 if g_ol_fill_walls
then drawFilledWalls();
778 function doWallCB (pan
: TPanel
; tag
: Integer): Boolean;
780 result
:= false; // don't stop
781 //if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then exit;
782 if ((pan
.PanelType
and xptag
) = 0) then exit
;
786 procedure doWalls (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
792 if ((ptype
and (PANEL_WALL
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) <> 0) then ptype
:= GridTagWall
or GridTagDoor
793 else panelTypeToTag(ptype
);
794 if g_ol_nice
or g_ol_fill_walls
then clearEdgeBmp();
795 mapGrid
.forEachInAABB(vpx
-1, vpy
-1, vpw
+2, vph
+2, doWallCB
, ptype
);
796 if g_ol_nice
then drawEdges();
797 if g_ol_fill_walls
then drawFilledWalls();
801 if g_ol_rlayer_back
then doWallsOld(gRenderBackgrounds
, PANEL_BACK
, 255, 127, 0);
802 if g_ol_rlayer_step
then doWallsOld(gSteps
, PANEL_STEP
, 192, 192, 192);
803 if g_ol_rlayer_wall
then doWallsOld(gWalls
, PANEL_WALL
, 255, 255, 255);
804 if g_ol_rlayer_door
then doWallsOld(gWalls
, PANEL_OPENDOOR
or PANEL_CLOSEDOOR
, 0, 255, 0);
805 if g_ol_rlayer_acid1
then doWallsOld(gAcid1
, PANEL_ACID1
, 255, 0, 0);
806 if g_ol_rlayer_acid2
then doWallsOld(gAcid2
, PANEL_ACID2
, 198, 198, 0);
807 if g_ol_rlayer_water
then doWallsOld(gWater
, PANEL_WATER
, 0, 255, 255);
808 if g_ol_rlayer_fore
then doWallsOld(gRenderForegrounds
, PANEL_FORE
, 210, 210, 210);
812 procedure plrDebugDraw ();
813 procedure drawTileGrid ();
817 for y
:= 0 to (mapGrid
.gridHeight
div mapGrid
.tileSize
) do
819 drawLine(mapGrid
.gridX0
, mapGrid
.gridY0
+y
*mapGrid
.tileSize
, mapGrid
.gridX0
+mapGrid
.gridWidth
, mapGrid
.gridY0
+y
*mapGrid
.tileSize
, 96, 96, 96, 255);
822 for x
:= 0 to (mapGrid
.gridWidth
div mapGrid
.tileSize
) do
824 drawLine(mapGrid
.gridX0
+x
*mapGrid
.tileSize
, mapGrid
.gridY0
, mapGrid
.gridX0
+x
*mapGrid
.tileSize
, mapGrid
.gridY0
+y
*mapGrid
.gridHeight
, 96, 96, 96, 255);
828 procedure hilightCell (cx
, cy
: Integer);
830 fillRect(cx
, cy
, monsGrid
.tileSize
, monsGrid
.tileSize
, 0, 128, 0, 64);
833 procedure hilightCell1 (cx
, cy
: Integer);
835 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
836 fillRect(cx
, cy
, monsGrid
.tileSize
, monsGrid
.tileSize
, 255, 255, 0, 92);
839 function hilightWallTrc (pan
: TPanel
; tag
: Integer; x
, y
, prevx
, prevy
: Integer): Boolean;
841 result
:= false; // don't stop
842 if (pan
= nil) then exit
; // cell completion, ignore
843 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
844 fillRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, 0, 128, 128, 64);
847 function monsCollector (mon
: TMonster
; tag
: Integer): Boolean;
850 mx
, my
, mw
, mh
: Integer;
853 mon
.getMapBox(mx
, my
, mw
, mh
);
854 e_DrawQuad(mx
, my
, mx
+mw
-1, my
+mh
-1, 255, 255, 0, 96);
855 if lineAABBIntersects(laserX0
, laserY0
, laserX1
, laserY1
, mx
, my
, mw
, mh
, ex
, ey
) then
857 e_DrawPoint(8, ex
, ey
, 0, 255, 0);
861 procedure drawMonsterInfo (mon
: TMonster
);
863 mx
, my
, mw
, mh
: Integer;
865 procedure drawMonsterTargetLine ();
867 emx
, emy
, emw
, emh
: Integer;
872 if (g_GetUIDType(mon
.MonsterTargetUID
) = UID_PLAYER
) then
874 eplr
:= g_Player_Get(mon
.MonsterTargetUID
);
875 if (eplr
<> nil) then eplr
.getMapBox(emx
, emy
, emw
, emh
) else exit
;
877 else if (g_GetUIDType(mon
.MonsterTargetUID
) = UID_MONSTER
) then
879 enemy
:= g_Monsters_ByUID(mon
.MonsterTargetUID
);
880 if (enemy
<> nil) then enemy
.getMapBox(emx
, emy
, emw
, emh
) else exit
;
886 mon
.getMapBox(mx
, my
, mw
, mh
);
887 drawLine(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, 255, 0, 0, 255);
888 if (g_Map_traceToNearestWall(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, @ex
, @ey
) <> nil) then
890 drawLine(mx
+mw
div 2, my
+mh
div 2, ex
, ey
, 0, 255, 0, 255);
894 procedure drawLOS2Plr ();
896 emx
, emy
, emw
, emh
: Integer;
901 if (eplr
= nil) then exit
;
902 eplr
.getMapBox(emx
, emy
, emw
, emh
);
903 mon
.getMapBox(mx
, my
, mw
, mh
);
904 drawLine(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, 255, 0, 0, 255);
905 {$IF DEFINED(D2F_DEBUG)}
906 //mapGrid.dbgRayTraceTileHitCB := hilightCell1;
908 if (g_Map_traceToNearestWall(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, @ex
, @ey
) <> nil) then
909 //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
911 drawLine(mx
+mw
div 2, my
+mh
div 2, ex
, ey
, 0, 255, 0, 255);
913 {$IF DEFINED(D2F_DEBUG)}
914 //mapGrid.dbgRayTraceTileHitCB := nil;
919 if (mon
= nil) then exit
;
920 mon
.getMapBox(mx
, my
, mw
, mh
);
923 monsGrid
.forEachBodyCell(mon
.proxyId
, hilightCell
);
927 //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
928 darkenRect(mx
-4, my
-7*8-6, 110, 7*8+6, 128);
933 drawText6(mx
, my
, Format('%s(U:%u)', [monsTypeToString(mon
.MonsterType
), mon
.UID
]), 255, 127, 0); my
-= 8;
935 drawText6(mx
, my
, Format('Beh: %s', [monsBehToString(mon
.MonsterBehaviour
)]), 255, 127, 0); my
-= 8;
937 drawText6(mx
, my
, Format('State:%s (%d)', [monsStateToString(mon
.MonsterState
), mon
.MonsterSleep
]), 255, 127, 0); my
-= 8;
939 drawText6(mx
, my
, Format('Health:%d', [mon
.MonsterHealth
]), 255, 127, 0); my
-= 8;
941 drawText6(mx
, my
, Format('Ammo:%d', [mon
.MonsterAmmo
]), 255, 127, 0); my
-= 8;
943 drawText6(mx
, my
, Format('TgtUID:%u', [mon
.MonsterTargetUID
]), 255, 127, 0); my
-= 8;
944 drawText6(mx
, my
, Format('TgtTime:%d', [mon
.MonsterTargetTime
]), 255, 127, 0); my
-= 8;
947 drawMonsterTargetLine();
948 if showMonsLOS2Plr
then drawLOS2Plr();
950 property MonsterRemoved: Boolean read FRemoved write FRemoved;
951 property MonsterPain: Integer read FPain write FPain;
952 property MonsterAnim: Byte read FCurAnim write FCurAnim;
956 function highlightAllMonsterCells (mon
: TMonster
): Boolean;
958 result
:= false; // don't stop
959 monsGrid
.forEachBodyCell(mon
.proxyId
, hilightCell
);
962 procedure drawTrigger (var trig
: TTrigger
);
964 procedure drawPanelDest (var parr
: TPanelArray
; idx
: Integer);
968 if (idx
< 0) or (idx
>= Length(parr
)) then exit
;
971 trig
.trigCenter
.x
, trig
.trigCenter
.y
,
972 pan
.x
+pan
.width
div 2, pan
.y
+pan
.height
div 2,
980 fillRect(trig
.x
, trig
.y
, trig
.width
, trig
.height
, 255, 0, 255, 96);
981 tts
:= trigType2Str(trig
.TriggerType
);
982 tx
:= trig
.x
+(trig
.width
-Length(tts
)*6) div 2;
983 darkenRect(tx
-2, trig
.y
-10, Length(tts
)*6+4, 10, 64);
984 drawText6(tx
, trig
.y
-9, tts
, 255, 127, 0);
985 tx
:= trig
.x
+(trig
.width
-Length(trig
.mapId
)*6) div 2;
986 darkenRect(tx
-2, trig
.y
-20, Length(trig
.mapId
)*6+4, 10, 64);
987 drawText6(tx
, trig
.y
-19, trig
.mapId
, 255, 255, 0);
988 case trig
.TriggerType
of
989 TRIGGER_NONE
: begin end;
990 TRIGGER_EXIT
: begin end;
991 TRIGGER_TELEPORT
: begin end;
992 TRIGGER_OPENDOOR
: begin drawPanelDest(gWalls
, trig
.trigPanelId
); end;
993 TRIGGER_CLOSEDOOR
: begin drawPanelDest(gWalls
, trig
.trigPanelId
); end;
994 TRIGGER_DOOR
: begin drawPanelDest(gWalls
, trig
.trigPanelId
); end;
995 TRIGGER_DOOR5
: begin drawPanelDest(gWalls
, trig
.trigPanelId
); end;
996 TRIGGER_CLOSETRAP
: begin drawPanelDest(gWalls
, trig
.trigPanelId
); end;
997 TRIGGER_TRAP
: begin drawPanelDest(gWalls
, trig
.trigPanelId
); end;
998 TRIGGER_SECRET
: begin end;
999 TRIGGER_LIFTUP
: begin drawPanelDest(gLifts
, trig
.trigPanelId
); end;
1000 TRIGGER_LIFTDOWN
: begin drawPanelDest(gLifts
, trig
.trigPanelId
); end;
1001 TRIGGER_LIFT
: begin drawPanelDest(gLifts
, trig
.trigPanelId
); end;
1002 TRIGGER_TEXTURE
: begin end;
1003 TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
, TRIGGER_PRESS
:
1006 trig
.trigData
.trigTX
, trig
.trigData
.trigTY
,
1007 trig
.trigData
.trigTWidth
, trig
.trigData
.trigTHeight
,
1010 trig
.trigCenter
.x
, trig
.trigCenter
.y
,
1011 trig
.trigData
.trigTX
+trig
.trigData
.trigTWidth
div 2,
1012 trig
.trigData
.trigTY
+trig
.trigData
.trigTHeight
div 2,
1015 TRIGGER_SOUND
: begin end;
1016 TRIGGER_SPAWNMONSTER
: begin end;
1017 TRIGGER_SPAWNITEM
: begin end;
1018 TRIGGER_MUSIC
: begin end;
1019 TRIGGER_PUSH
: begin end;
1020 TRIGGER_SCORE
: begin end;
1021 TRIGGER_MESSAGE
: begin end;
1022 TRIGGER_DAMAGE
: begin end;
1023 TRIGGER_HEALTH
: begin end;
1024 TRIGGER_SHOT
: begin end;
1025 TRIGGER_EFFECT
: begin end;
1026 TRIGGER_SCRIPT
: begin end;
1029 //trigPanelId: Integer;
1032 procedure drawTriggers ();
1036 for f
:= 0 to High(gTriggers
) do drawTrigger(gTriggers
[f
]);
1041 mx
, my
, mw
, mh
: Integer;
1043 if (gPlayer1
= nil) then exit
;
1045 glEnable(GL_SCISSOR_TEST
);
1046 glScissor(0, gWinSizeY
-gPlayerScreenSize
.Y
-1, vpw
, vph
);
1049 if g_dbg_scale_05
then glScalef(0.5, 0.5, 1.0);
1050 glTranslatef(-vpx
, -vpy
, 0);
1052 if (showGrid
) then drawTileGrid();
1055 if (laserSet
) then g_Mons_AlongLine(laserX0
, laserY0
, laserX1
, laserY1
, monsCollector
, true);
1057 if (monMarkedUID
<> -1) then
1059 mon
:= g_Monsters_ByUID(monMarkedUID
);
1060 if (mon
<> nil) then
1062 mon
.getMapBox(mx
, my
, mw
, mh
);
1063 e_DrawQuad(mx
, my
, mx
+mw
-1, my
+mh
-1, 255, 0, 0, 30);
1064 drawMonsterInfo(mon
);
1068 if showAllMonsCells
then g_Mons_ForEach(highlightAllMonsterCells
);
1069 if showTriggers
then drawTriggers();
1073 glDisable(GL_SCISSOR_TEST
);
1075 if showMapCurPos
then drawText8(4, gWinSizeY
-10, Format('mappos:(%d,%d)', [pmsCurMapX
, pmsCurMapY
]), 255, 255, 0);
1079 // ////////////////////////////////////////////////////////////////////////// //
1080 function g_Holmes_MouseEvent (var ev
: THMouseEvent
): Boolean;
1082 holmesInitCommands();
1090 if not uiMouseEvent(ev
) then plrDebugMouse(ev
);
1094 // ////////////////////////////////////////////////////////////////////////// //
1095 function g_Holmes_KeyEvent (var ev
: THKeyEvent
): Boolean;
1096 {$IF DEFINED(D2F_DEBUG)}
1103 procedure dummyWallTrc (cx
, cy
: Integer);
1108 holmesInitCommands();
1114 SDL_SCANCODE_LCTRL
, SDL_SCANCODE_RCTRL
,
1115 SDL_SCANCODE_LALT
, SDL_SCANCODE_RALT
,
1116 SDL_SCANCODE_LSHIFT
, SDL_SCANCODE_RSHIFT
:
1119 if uiKeyEvent(ev
) then begin result
:= true; exit
; end;
1120 if keybindExecute(ev
) then begin result
:= true; exit
; end;
1122 if (ev
.kind
= THKeyEvent
.Press
) then
1124 {$IF DEFINED(D2F_DEBUG)}
1125 // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction
1126 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
1127 ((ev
.kstate
and THKeyEvent
.ModCtrl
) <> 0) then
1133 SDL_SCANCODE_UP
: dy
-= 120;
1134 SDL_SCANCODE_DOWN
: dy
+= 120;
1135 SDL_SCANCODE_LEFT
: dx
-= 120;
1136 SDL_SCANCODE_RIGHT
: dx
+= 120;
1138 {$IF DEFINED(D2F_DEBUG)}
1139 //mapGrid.dbgRayTraceTileHitCB := dummyWallTrc;
1140 mapGrid
.dbgShowTraceLog
:= true;
1142 pan
:= g_Map_traceToNearest(pmsCurMapX
, pmsCurMapY
, dx
, dy
, (GridTagWall
or GridTagDoor
or GridTagStep
or GridTagAcid1
or GridTagAcid2
or GridTagWater
), @ex
, @ey
);
1143 {$IF DEFINED(D2F_DEBUG)}
1144 //mapGrid.dbgRayTraceTileHitCB := nil;
1145 mapGrid
.dbgShowTraceLog
:= false;
1147 e_LogWritefln('v-trace: (%d,%d)-(%d,%d); end=(%d,%d); hit=%d', [pmsCurMapX
, pmsCurMapY
, dx
, dy
, ex
, ey
, (pan
<> nil)]);
1155 // ////////////////////////////////////////////////////////////////////////// //
1156 procedure g_Holmes_Draw ();
1158 {$IF not DEFINED(HEADLESS)}
1159 holmesInitCommands();
1162 glColorMask(GL_TRUE
, GL_TRUE
, GL_TRUE
, GL_TRUE
); // modify color buffer
1163 glDisable(GL_STENCIL_TEST
);
1164 glDisable(GL_BLEND
);
1165 glDisable(GL_SCISSOR_TEST
);
1166 glDisable(GL_TEXTURE_2D
);
1178 procedure g_Holmes_DrawUI ();
1180 {$IF not DEFINED(HEADLESS)}
1187 // ////////////////////////////////////////////////////////////////////////// //
1188 procedure bcOneMonsterThinkStep (); begin gmon_debug_think
:= false; gmon_debug_one_think_step
:= true; end;
1189 procedure bcToggleMonsterInfo (arg
: Integer=-1); begin if (arg
< 0) then showMonsInfo
:= not showMonsInfo
else showMonsInfo
:= (arg
> 0); end;
1190 procedure bcToggleMonsterLOSPlr (arg
: Integer=-1); begin if (arg
< 0) then showMonsLOS2Plr
:= not showMonsLOS2Plr
else showMonsLOS2Plr
:= (arg
> 0); end;
1191 procedure bcToggleMonsterCells (arg
: Integer=-1); begin if (arg
< 0) then showAllMonsCells
:= not showAllMonsCells
else showAllMonsCells
:= (arg
> 0); end;
1192 procedure bcToggleDrawTriggers (arg
: Integer=-1); begin if (arg
< 0) then showTriggers
:= not showTriggers
else showTriggers
:= (arg
> 0); end;
1194 procedure bcToggleCurPos (arg
: Integer=-1); begin if (arg
< 0) then showMapCurPos
:= not showMapCurPos
else showMapCurPos
:= (arg
> 0); end;
1195 procedure bcToggleGrid (arg
: Integer=-1); begin if (arg
< 0) then showGrid
:= not showGrid
else showGrid
:= (arg
> 0); end;
1197 procedure bcMonsterWakeup ();
1201 if (monMarkedUID
<> -1) then
1203 mon
:= g_Monsters_ByUID(monMarkedUID
);
1204 if (mon
<> nil) then mon
.WakeUp();
1208 procedure bcPlayerTeleport ();
1210 x
, y
, w
, h
: Integer;
1212 //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY);
1213 if (gPlayers
[0] <> nil) then
1215 gPlayers
[0].getMapBox(x
, y
, w
, h
);
1216 gPlayers
[0].TeleportTo(pmsCurMapX
-w
div 2, pmsCurMapY
-h
div 2, true, 69); // 69: don't change dir
1220 procedure cbAtcurSelectMonster ();
1221 function monsAtDump (mon
: TMonster
; tag
: Integer): Boolean;
1223 result
:= true; // stop
1224 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon
.arrIdx
, mon
.UID
, mon
.proxyId
]), MSG_NOTIFY
);
1225 monMarkedUID
:= mon
.UID
;
1229 //e_WriteLog('===========================', MSG_NOTIFY);
1230 monsGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, monsAtDump
);
1231 //e_WriteLog('---------------------------', MSG_NOTIFY);
1234 procedure cbAtcurDumpMonsters ();
1235 function monsAtDump (mon
: TMonster
; tag
: Integer): Boolean;
1237 result
:= false; // don't stop
1238 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon
.arrIdx
, mon
.UID
, mon
.proxyId
]), MSG_NOTIFY
);
1241 e_WriteLog('===========================', MSG_NOTIFY
);
1242 monsGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, monsAtDump
);
1243 e_WriteLog('---------------------------', MSG_NOTIFY
);
1246 procedure cbAtcurDumpWalls ();
1247 function wallToggle (pan
: TPanel
; tag
: Integer): Boolean;
1249 result
:= false; // don't stop
1250 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
);
1253 hasTrigs
: Boolean = false;
1257 e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY
);
1258 mapGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, wallToggle
, (GridTagWall
or GridTagDoor
));
1259 e_WriteLog('--- toggle wall ---', MSG_NOTIFY
);
1260 if showTriggers
then
1262 for f
:= 0 to High(gTriggers
) do
1264 trig
:= @gTriggers
[f
];
1265 if (pmsCurMapX
>= trig
.x
) and (pmsCurMapY
>= trig
.y
) and (pmsCurMapX
< trig
.x
+trig
.width
) and (pmsCurMapY
< trig
.y
+trig
.height
) then
1267 if not hasTrigs
then begin writeln('=== TRIGGERS ==='); hasTrigs
:= true; end;
1268 writeln('trigger ''', trig
.mapId
, ''' of type ''', trigType2Str(trig
.TriggerType
), '''');
1271 if hasTrigs
then writeln('--- triggers ---');
1275 procedure cbAtcurToggleWalls ();
1276 function wallToggle (pan
: TPanel
; tag
: Integer): Boolean;
1278 result
:= false; // don't stop
1279 //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);
1280 if pan
.Enabled
then g_Map_DisableWall(pan
.arrIdx
) else g_Map_EnableWall(pan
.arrIdx
);
1283 //e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
1284 mapGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, wallToggle
, (GridTagWall
or GridTagDoor
));
1285 //e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
1289 // ////////////////////////////////////////////////////////////////////////// //
1290 procedure holmesInitCommands ();
1292 if (cmdlist
<> nil) then exit
;
1293 cmdAdd('win_layers', toggleLayersWindow
, 'toggle layers window', 'window control');
1294 cmdAdd('win_outline', toggleOutlineWindow
, 'toggle outline window', 'window control');
1295 cmdAdd('win_help', toggleHelpWindow
, 'toggle help window', 'window control');
1296 cmdAdd('win_options', toggleOptionsWindow
, 'toggle options window', 'window control');
1298 cmdAdd('mon_think_step', bcOneMonsterThinkStep
, 'one monster think step', 'monster control');
1299 cmdAdd('mon_info', bcToggleMonsterInfo
, 'toggle monster info', 'monster control');
1300 cmdAdd('mon_los_plr', bcToggleMonsterLOSPlr
, 'toggle monster LOS to player', 'monster control');
1301 cmdAdd('mon_cells', bcToggleMonsterCells
, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control');
1302 cmdAdd('mon_wakeup', bcMonsterWakeup
, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control');
1304 cmdAdd('plr_teleport', bcPlayerTeleport
, 'teleport player', 'player control');
1306 cmdAdd('dbg_curpos', bcToggleCurPos
, 'toggle "show cursor position on the map"', 'various');
1307 cmdAdd('dbg_grid', bcToggleGrid
, 'toggle grid', 'various');
1308 cmdAdd('dbg_triggers', bcToggleDrawTriggers
, 'show/hide triggers (SLOW!)', 'various');
1310 cmdAdd('atcur_select_monster', cbAtcurSelectMonster
, 'select monster to operate', 'monster control');
1311 cmdAdd('atcur_dump_monsters', cbAtcurDumpMonsters
, 'dump monsters in cell', 'monster control');
1312 cmdAdd('atcur_dump_walls', cbAtcurDumpWalls
, 'dump walls in cell', 'wall control');
1313 cmdAdd('atcur_disable_walls', cbAtcurToggleWalls
, 'disable walls', 'wall control');
1317 procedure holmesInitBinds ();
1320 pr
: TTextParser
= nil;
1321 s
, kn
, v
: AnsiString;
1326 if not keybindsInited
then
1329 keybindAdd('F1', 'win_help');
1330 keybindAdd('M-F1', 'win_options');
1331 keybindAdd('C-O', 'win_outline');
1332 keybindAdd('C-L', 'win_layers');
1334 keybindAdd('M-M', 'mon_think_step');
1335 keybindAdd('M-I', 'mon_info');
1336 keybindAdd('M-L', 'mon_los_plr');
1337 keybindAdd('M-G', 'mon_cells');
1338 keybindAdd('M-A', 'mon_wakeup');
1340 keybindAdd('C-T', 'plr_teleport');
1342 keybindAdd('C-P', 'dbg_curpos');
1343 keybindAdd('C-G', 'dbg_grid');
1344 keybindAdd('C-X', 'dbg_triggers');
1347 msbindAdd('LMB', 'atcur_select_monster');
1348 msbindAdd('M-LMB', 'atcur_dump_monsters');
1349 msbindAdd('RMB', 'atcur_dump_walls');
1350 msbindAdd('M-RMB', 'atcur_disable_walls');
1352 // load bindings from file
1354 st
:= openDiskFileRO(GameDir
+'holmes.rc');
1355 pr
:= TFileTextParser
.Create(st
);
1356 conwriteln('parsing "holmes.rc"...');
1357 while (pr
.tokType
<> pr
.TTEOF
) do
1360 if (s
= 'stop') then break
1361 else if (s
= 'unbind_keys') then keybinds
:= nil
1362 else if (s
= 'unbind_mouse') then msbinds
:= nil
1363 else if (s
= 'bind') then
1365 if (pr
.tokType
= pr
.TTStr
) then s
:= pr
.expectStr(false)
1366 else if (pr
.tokType
= pr
.TTInt
) then s
:= Format('%d', [pr
.expectInt()])
1367 else s
:= pr
.expectId();
1369 if (pr
.tokType
= pr
.TTStr
) then v
:= pr
.expectStr(false)
1370 else if (pr
.tokType
= pr
.TTInt
) then v
:= Format('%d', [pr
.expectInt()])
1371 else v
:= pr
.expectId();
1373 kn
:= parseModKeys(s
, kmods
, mbuts
);
1374 if (CompareText(kn
, 'lmb') = 0) or (CompareText(kn
, 'rmb') = 0) or (CompareText(kn
, 'mmb') = 0) or (CompareText(kn
, 'None') = 0) then
1384 except on e
: Exception
do // sorry
1385 if (pr
<> nil) then conwritefln('Holmes config parse error at (%s,%s): %s', [pr
.tokLine
, pr
.tokCol
, e
.message]);
1387 if (pr
<> nil) then pr
.Free() else st
.Free(); // ownership