b7ad74b79db8028d84f2711100434655a9e5eebe
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, version 3 of the License ONLY.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 {$INCLUDE ../shared/a_modes.inc}
20 procedure holmesInitCommands ();
21 procedure holmesInitBinds ();
23 function monsTypeToString (mt
: Byte): AnsiString;
24 function monsBehToString (bt
: Byte): AnsiString;
25 function monsStateToString (st
: Byte): AnsiString;
26 function trigType2Str (ttype
: Integer): AnsiString;
29 g_holmes_imfunctional
: Boolean = false;
30 g_holmes_enabled
: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}false{$ENDIF};
35 showGrid
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
36 showMonsInfo
: Boolean = false;
37 showMonsLOS2Plr
: Boolean = false;
38 showAllMonsCells
: Boolean = false;
39 showMapCurPos
: Boolean = false;
40 showLayersWindow
: Boolean = false;
41 showOutlineWindow
: Boolean = false;
42 showTriggers
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
43 showTraceBox
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
46 g_ol_nice
: Boolean = false;
47 g_ol_fill_walls
: Boolean = false;
48 g_ol_rlayer_back
: Boolean = false;
49 g_ol_rlayer_step
: Boolean = false;
50 g_ol_rlayer_wall
: Boolean = false;
51 g_ol_rlayer_door
: Boolean = false;
52 g_ol_rlayer_acid1
: Boolean = false;
53 g_ol_rlayer_acid2
: Boolean = false;
54 g_ol_rlayer_water
: Boolean = false;
55 g_ol_rlayer_fore
: Boolean = false;
58 monMarkedUID
: Integer = -1;
59 platMarkedGUID
: Integer = -1;
67 g_map
, g_triggers
, g_game
, g_panel
, g_console
,
69 fui_common
, fui_events
, fui_ctls
,
70 {$IFDEF ENABLE_RENDER}
73 {rttiobj,} typinfo
, e_res
,
83 //globalInited: Boolean = false;
84 msB
: Word = 0; // button state
85 kbS
: Word = 0; // keyboard modifiers state
88 // ////////////////////////////////////////////////////////////////////////// //
89 {$INCLUDE g_holmes.inc}
92 // ////////////////////////////////////////////////////////////////////////// //
93 {$INCLUDE g_holmes_cmd.inc}
96 // ////////////////////////////////////////////////////////////////////////// //
98 {$IF NOT DEFINED(ENABLE_RENDER)}
99 function pmsCurMapX (): Integer; inline;
101 result
:= round(msX
/g_dbg_scale
)
104 function pmsCurMapY (): Integer; inline;
106 result
:= round(msY
/g_dbg_scale
)
109 function r_Render_HolmesViewIsSet (): Boolean;
116 // ////////////////////////////////////////////////////////////////////////// //
118 winHelp
: TUITopWindow
= nil;
119 winOptions
: TUITopWindow
= nil;
120 winLayers
: TUITopWindow
= nil;
121 winOutlines
: TUITopWindow
= nil;
124 procedure createHelpWindow (); forward;
125 procedure createOptionsWindow (); forward;
126 procedure createLayersWindow (); forward;
127 procedure createOutlinesWindow (); forward;
130 procedure toggleLayersWindowCB (me
: TUIControl
);
132 showLayersWindow
:= not showLayersWindow
;
133 if showLayersWindow
then
135 if (winLayers
= nil) then createLayersWindow();
136 uiAddWindow(winLayers
);
140 uiRemoveWindow(winLayers
);
144 procedure toggleOutlineWindowCB (me
: TUIControl
);
146 showOutlineWindow
:= not showOutlineWindow
;
147 if showOutlineWindow
then
149 if (winOutlines
= nil) then createOutlinesWindow();
150 uiAddWindow(winOutlines
);
154 uiRemoveWindow(winOutlines
);
159 procedure createHelpWindow ();
160 procedure addHelpEmptyLine ();
164 stx
:= TUIStaticText
.Create();
165 stx
.flExpand
:= true;
166 stx
.halign
:= 0; // center
170 winHelp
.appendChild(stx
);
173 procedure addHelpCaptionLine (const txt
: AnsiString);
177 stx
:= TUIStaticText
.Create();
178 stx
.flExpand
:= true;
179 stx
.halign
:= 0; // center
183 winHelp
.appendChild(stx
);
186 procedure addHelpCaption (const txt
: AnsiString);
190 stx
:= TUIStaticText
.Create();
191 stx
.flExpand
:= true;
192 stx
.halign
:= 0; // center
196 winHelp
.appendChild(stx
);
199 procedure addHelpKeyMouse (const key
, txt
, grp
: AnsiString);
205 box
:= TUIHBox
.Create();
206 box
.flExpand
:= true;
208 stx
:= TUIStaticText
.Create();
209 stx
.flExpand
:= true;
210 stx
.halign
:= 1; // right
211 stx
.valign
:= 0; // center
216 box
.appendChild(stx
);
218 span
:= TUISpan
.Create();
219 span
.flDefaultSize
:= TLaySize
.Create(12, 1);
220 span
.flExpand
:= true;
221 box
.appendChild(span
);
223 stx
:= TUIStaticText
.Create();
224 stx
.flExpand
:= true;
225 stx
.halign
:= -1; // left
226 stx
.valign
:= 0; // center
230 box
.appendChild(stx
);
231 winHelp
.appendChild(box
);
234 procedure addHelpKey (const key
, txt
: AnsiString); begin addHelpKeyMouse(key
, txt
, 'help-keys'); end;
235 procedure addHelpMouse (const key
, txt
: AnsiString); begin addHelpKeyMouse(key
, txt
, 'help-mouse'); end;
238 slist
: array of AnsiString = nil;
240 bind
: THolmesBinding
;
248 winHelp
:= TUITopWindow
.Create('Holmes Help');
249 winHelp
.escClose
:= true;
250 winHelp
.flHoriz
:= false;
253 for cmd
in cmdlist
do cmd
.helpmark
:= false;
256 for bind
in keybinds
do
258 if (Length(bind
.key
) = 0) then continue
;
259 if cmdlist
.get(bind
.cmdName
, cmd
) then
261 if (Length(cmd
.help
) > 0) then
263 cmd
.helpmark
:= true;
264 //if (maxkeylen < Length(bind.key)) then maxkeylen := Length(bind.key);
269 for cmd
in cmdlist
do
271 if not cmd
.helpmark
then continue
;
272 if (Length(cmd
.help
) = 0) then begin cmd
.helpmark
:= false; continue
; end;
274 while (f
< Length(slist
)) and (CompareText(slist
[f
], cmd
.section
) <> 0) do Inc(f
);
275 if (f
= Length(slist
)) then
277 SetLength(slist
, Length(slist
)+1);
278 slist
[High(slist
)] := cmd
.section
;
282 addHelpCaptionLine('KEYBOARD');
283 //llb := TUISimpleText.Create(0, 0);
284 for f
:= 0 to High(slist
) do
286 //if (f > 0) then llb.appendItem('');
287 if (f
> 0) then addHelpEmptyLine();
288 //llb.appendItem(slist[f], true, true);
289 addHelpCaption(slist
[f
]);
290 for cmd
in cmdlist
do
292 if not cmd
.helpmark
then continue
;
293 if (CompareText(cmd
.section
, slist
[f
]) <> 0) then continue
;
294 for bind
in keybinds
do
296 if (Length(bind
.key
) = 0) then continue
;
297 if (cmd
.name
= bind
.cmdName
) then
300 //while (Length(s) < maxkeylen) do s += ' ';
301 //s := ' '+s+' -- '+cmd.help;
303 addHelpMouse(bind
.key
, cmd
.help
);
310 for cmd
in cmdlist
do cmd
.helpmark
:= false;
313 for bind
in msbinds
do
315 if (Length(bind
.key
) = 0) then continue
;
316 if cmdlist
.get(bind
.cmdName
, cmd
) then
318 if (Length(cmd
.help
) > 0) then
320 cmd
.helpmark
:= true;
321 //if (maxkeylen < Length(bind.key)) then maxkeylen := Length(bind.key);
326 //llb.appendItem('');
327 //llb.appendItem('mouse', true, true);
328 if (f
> 0) then addHelpEmptyLine();
329 addHelpCaptionLine('MOUSE');
330 for bind
in msbinds
do
332 if (Length(bind
.key
) = 0) then continue
;
333 if cmdlist
.get(bind
.cmdName
, cmd
) then
335 if (Length(cmd
.help
) > 0) then
338 //while (Length(s) < maxkeylen) do s += ' ';
339 //s := ' '+s+' -- '+cmd.help;
341 addHelpKey(bind
.key
, cmd
.help
);
346 //winHelp.appendChild(llb);
348 uiLayoutCtl(winHelp
);
349 winHelp
.escClose
:= true;
350 winHelp
.centerInScreen();
354 procedure winLayersClosed (me
: TUIControl
); begin showLayersWindow
:= false; end;
355 procedure winOutlinesClosed (me
: TUIControl
); begin showOutlineWindow
:= false; end;
357 procedure addCheckBox (parent
: TUIControl
; const text: AnsiString; pvar
: PBoolean; const aid
: AnsiString='');
361 cb
:= TUICheckBox
.Create();
366 parent
.appendChild(cb
);
369 procedure addButton (parent
: TUIControl
; const text: AnsiString; cb
: TUIControl
.TActionCB
);
373 but
:= TUIButton
.Create();
374 //but.flExpand := true;
377 parent
.appendChild(but
);
381 procedure actionFillWalls (cb
: TUIControl
);
383 TUICheckBox(cb
).checked
:= not TUICheckBox(cb
).checked
;
384 TUICheckBox(cb
.topLevel
['cbcontour']).enabled
:= not TUICheckBox(cb
).checked
;
387 procedure createLayersWindow ();
391 winLayers
:= TUITopWindow
.Create('layers');
392 winLayers
.flHoriz
:= false;
395 winLayers
.flHoriz
:= false;
396 winLayers
.escClose
:= true;
397 winLayers
.closeCB
:= winLayersClosed
;
399 box
:= TUIVBox
.Create();
400 addCheckBox(box
, '~background', @g_rlayer_back
);
401 addCheckBox(box
, '~steps', @g_rlayer_step
);
402 addCheckBox(box
, '~walls', @g_rlayer_wall
);
403 addCheckBox(box
, '~doors', @g_rlayer_door
);
404 addCheckBox(box
, 'acid~1', @g_rlayer_acid1
);
405 addCheckBox(box
, 'acid~2', @g_rlayer_acid2
);
406 addCheckBox(box
, 'wate~r', @g_rlayer_water
);
407 addCheckBox(box
, '~foreground', @g_rlayer_fore
);
408 winLayers
.appendChild(box
);
410 uiLayoutCtl(winLayers
);
414 procedure createOutlinesWindow ();
418 winOutlines
:= TUITopWindow
.Create('outlines');
419 winOutlines
.flHoriz
:= false;
420 winOutlines
.x0
:= 100;
421 winOutlines
.y0
:= 30;
422 winOutlines
.flHoriz
:= false;
423 winOutlines
.escClose
:= true;
424 winOutlines
.closeCB
:= winOutlinesClosed
;
426 box
:= TUIVBox
.Create();
427 box
.hasFrame
:= true;
428 box
.caption
:= 'layers';
429 addCheckBox(box
, '~background', @g_ol_rlayer_back
);
430 addCheckBox(box
, '~steps', @g_ol_rlayer_step
);
431 addCheckBox(box
, '~walls', @g_ol_rlayer_wall
);
432 addCheckBox(box
, '~doors', @g_ol_rlayer_door
);
433 addCheckBox(box
, 'acid~1', @g_ol_rlayer_acid1
);
434 addCheckBox(box
, 'acid~2', @g_ol_rlayer_acid2
);
435 addCheckBox(box
, 'wate~r', @g_ol_rlayer_water
);
436 addCheckBox(box
, '~foreground', @g_ol_rlayer_fore
);
437 winOutlines
.appendChild(box
);
439 box
:= TUIVBox
.Create();
440 box
.hasFrame
:= true;
441 box
.caption
:= 'options';
442 addCheckBox(box
, 'fi~ll walls', @g_ol_fill_walls
, 'cbfill');
443 addCheckBox(box
, 'con~tours', @g_ol_nice
, 'cbcontour');
444 winOutlines
.appendChild(box
);
446 winOutlines
.setActionCBFor('cbfill', actionFillWalls
);
448 uiLayoutCtl(winOutlines
);
452 procedure createOptionsWindow ();
457 winOptions
:= TUITopWindow
.Create('Holmes Options');
458 winOptions
.flHoriz
:= false;
459 winOptions
.flHoriz
:= false;
460 winOptions
.escClose
:= true;
462 box
:= TUIVBox
.Create();
463 box
.hasFrame
:= true;
464 box
.caption
:= 'visual';
465 addCheckBox(box
, 'map ~grid', @showGrid
);
466 addCheckBox(box
, 'cursor ~position on map', @showMapCurPos
);
467 addCheckBox(box
, '~monster info', @showMonsInfo
);
468 addCheckBox(box
, 'monster LO~S to player', @showMonsLOS2Plr
);
469 addCheckBox(box
, 'monster ~cells (SLOW!)', @showAllMonsCells
);
470 addCheckBox(box
, 'draw ~triggers (SLOW!)', @showTriggers
);
471 winOptions
.appendChild(box
);
473 box
:= TUIHBox
.Create();
474 box
.hasFrame
:= true;
475 box
.caption
:= 'windows';
476 box
.captionAlign
:= 0;
478 addButton(box
, '~layers', toggleLayersWindowCB
);
479 span
:= TUISpan
.Create();
480 span
.flExpand
:= true;
481 span
.flDefaultSize
:= TLaySize
.Create(4, 1);
482 box
.appendChild(span
);
483 addButton(box
, '~outline', toggleOutlineWindowCB
);
484 winOptions
.appendChild(box
);
486 uiLayoutCtl(winOptions
);
487 winOptions
.centerInScreen();
491 procedure toggleLayersWindow (arg
: Integer=-1);
493 if (arg
< 0) then showLayersWindow
:= not showLayersWindow
else showLayersWindow
:= (arg
> 0);
494 showLayersWindow
:= not showLayersWindow
; // hack for callback
495 toggleLayersWindowCB(nil);
498 procedure toggleOutlineWindow (arg
: Integer=-1);
500 if (arg
< 0) then showOutlineWindow
:= not showOutlineWindow
else showOutlineWindow
:= (arg
> 0);
501 showOutlineWindow
:= not showOutlineWindow
; // hack for callback
502 toggleOutlineWindowCB(nil);
505 procedure toggleHelpWindow (arg
: Integer=-1);
507 if (winHelp
= nil) then
509 if (arg
= 0) then exit
;
512 if (arg
< 0) then begin if not uiVisibleWindow(winHelp
) then uiAddWindow(winHelp
) else uiRemoveWindow(winHelp
); end
513 else if (arg
= 0) then begin if uiVisibleWindow(winHelp
) then uiRemoveWindow(winHelp
); end
514 else begin if (not uiVisibleWindow(winHelp
)) then uiAddWindow(winHelp
); end;
515 if (not uiVisibleWindow(winHelp
)) then FreeAndNil(winHelp
);
518 procedure toggleOptionsWindow (arg
: Integer=-1);
520 if (winOptions
= nil) then createOptionsWindow();
521 if (arg
< 0) then begin if not uiVisibleWindow(winOptions
) then uiAddWindow(winOptions
) else uiRemoveWindow(winOptions
); end
522 else if (arg
= 0) then begin if uiVisibleWindow(winOptions
) then uiRemoveWindow(winOptions
); end
523 else begin if not uiVisibleWindow(winOptions
) then uiAddWindow(winOptions
); end
527 // ////////////////////////////////////////////////////////////////////////// //
529 procedure onKeyEvent (var ev
: TFUIEvent
);
530 {$IF DEFINED(D2F_DEBUG)}
537 procedure dummyWallTrc (cx
, cy
: Integer);
545 {$IF DEFINED(D2F_DEBUG)}
546 // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction
547 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
548 ((ev
.kstate
and TFUIEvent
.ModCtrl
) <> 0) then
554 SDL_SCANCODE_UP
: dy
-= 120;
555 SDL_SCANCODE_DOWN
: dy
+= 120;
556 SDL_SCANCODE_LEFT
: dx
-= 120;
557 SDL_SCANCODE_RIGHT
: dx
+= 120;
559 {$IF DEFINED(D2F_DEBUG)}
560 //mapGrid.dbgRayTraceTileHitCB := dummyWallTrc;
561 mapGrid
.dbgShowTraceLog
:= true;
563 pan
:= g_Map_traceToNearest(pmsCurMapX
, pmsCurMapY
, dx
, dy
, (GridTagWall
or GridTagDoor
or GridTagStep
or GridTagAcid1
or GridTagAcid2
or GridTagWater
), @ex
, @ey
);
564 {$IF DEFINED(D2F_DEBUG)}
565 //mapGrid.dbgRayTraceTileHitCB := nil;
566 mapGrid
.dbgShowTraceLog
:= false;
568 e_LogWritefln('v-trace: (%d,%d)-(%d,%d); end=(%d,%d); hit=%d', [pmsCurMapX
, pmsCurMapY
, dx
, dy
, ex
, ey
, (pan
<> nil)]);
575 procedure onKeyEvent (var ev
: TFUIEvent
);
581 // ////////////////////////////////////////////////////////////////////////// //
582 procedure g_Holmes_OnEvent (var ev
: TFUIEvent
);
583 var doeat
: Boolean = false;
585 if g_Game_IsNet
then exit
;
586 if not g_holmes_enabled
then exit
;
587 if g_holmes_imfunctional
then exit
;
589 holmesInitCommands();
599 SDL_SCANCODE_LCTRL
, SDL_SCANCODE_RCTRL
,
600 SDL_SCANCODE_LALT
, SDL_SCANCODE_RALT
,
601 SDL_SCANCODE_LSHIFT
, SDL_SCANCODE_RSHIFT
:
606 else if (ev
.mouse
) then
616 if (not ev
.alive
) then exit
;
620 if (gPlayer1
<> nil) and r_Render_HolmesViewIsSet() then msbindExecute(ev
);
625 if keybindExecute(ev
) then ev
.eat();
626 if (ev
.alive
) then onKeyEvent(ev
);
629 if (doeat
) then ev
.eat();
633 // ////////////////////////////////////////////////////////////////////////// //
634 procedure bcOneMonsterThinkStep (); begin gmon_debug_think
:= false; gmon_debug_one_think_step
:= true; end;
635 procedure bcOneMPlatThinkStep (); begin g_dbgpan_mplat_active
:= false; g_dbgpan_mplat_step
:= true; end;
636 procedure bcMPlatToggle (); begin g_dbgpan_mplat_active
:= not g_dbgpan_mplat_active
; end;
638 procedure bcToggleMonsterInfo (arg
: Integer=-1); begin if (arg
< 0) then showMonsInfo
:= not showMonsInfo
else showMonsInfo
:= (arg
> 0); end;
639 procedure bcToggleMonsterLOSPlr (arg
: Integer=-1); begin if (arg
< 0) then showMonsLOS2Plr
:= not showMonsLOS2Plr
else showMonsLOS2Plr
:= (arg
> 0); end;
640 procedure bcToggleMonsterCells (arg
: Integer=-1); begin if (arg
< 0) then showAllMonsCells
:= not showAllMonsCells
else showAllMonsCells
:= (arg
> 0); end;
641 procedure bcToggleDrawTriggers (arg
: Integer=-1); begin if (arg
< 0) then showTriggers
:= not showTriggers
else showTriggers
:= (arg
> 0); end;
643 procedure bcToggleCurPos (arg
: Integer=-1); begin if (arg
< 0) then showMapCurPos
:= not showMapCurPos
else showMapCurPos
:= (arg
> 0); end;
644 procedure bcToggleGrid (arg
: Integer=-1); begin if (arg
< 0) then showGrid
:= not showGrid
else showGrid
:= (arg
> 0); end;
646 procedure bcMonsterSpawn (s
: AnsiString);
650 if not gGameOn
or g_Game_IsClient
then
652 conwriteln('cannot spawn monster in this mode');
655 mon
:= g_Mons_SpawnAt(s
, pmsCurMapX
, pmsCurMapY
);
656 if (mon
= nil) then begin conwritefln('unknown monster id: ''%s''', [s
]); exit
; end;
657 monMarkedUID
:= mon
.UID
;
660 procedure bcMonsterWakeup ();
664 if (monMarkedUID
<> -1) then
666 mon
:= g_Monsters_ByUID(monMarkedUID
);
667 if (mon
<> nil) then mon
.WakeUp();
671 procedure bcPlayerTeleport ();
675 //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY);
676 if (gPlayers
[0] <> nil) then
678 gPlayers
[0].getMapBox(x
, y
, w
, h
);
679 gPlayers
[0].TeleportTo(pmsCurMapX
-w
div 2, pmsCurMapY
-h
div 2, true, 69); // 69: don't change dir
683 procedure dbgToggleTraceBox (arg
: Integer=-1); begin if (arg
< 0) then showTraceBox
:= not showTraceBox
else showTraceBox
:= (arg
> 0); end;
685 procedure dbgToggleHolmesPause (arg
: Integer=-1); begin if (arg
< 0) then g_Game_HolmesPause(not gPauseHolmes
) else g_Game_HolmesPause(arg
> 0); end;
687 procedure cbAtcurSelectMonster ();
688 function monsAtDump (mon
: TMonster
{; tag: Integer}): Boolean;
690 result
:= true; // stop
691 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon
.arrIdx
, mon
.UID
, mon
.proxyId
]), TMsgType
.Notify
);
692 monMarkedUID
:= mon
.UID
;
693 dumpPublishedProperties(mon
);
699 it
: TMonsterGrid
.Iter
;
702 if (Length(gPlayers
) > 0) then
707 plr
.getMapBox(x
, y
, w
, h
);
708 if (pmsCurMapX
>= x
) and (pmsCurMapY
>= y
) and (pmsCurMapX
< x
+w
) and (pmsCurMapY
< y
+h
) then
710 dumpPublishedProperties(plr
);
714 //e_WriteLog('===========================', MSG_NOTIFY);
715 it
:= monsGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
);
716 for mit
in it
do monsAtDump(mit
^);
718 //e_WriteLog('---------------------------', MSG_NOTIFY);
721 procedure cbAtcurDumpMonsters ();
722 function monsAtDump (mon
: TMonster
{; tag: Integer}): Boolean;
724 result
:= false; // don't stop
725 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon
.arrIdx
, mon
.UID
, mon
.proxyId
]), TMsgType
.Notify
);
729 it
: TMonsterGrid
.Iter
;
731 it
:= monsGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
);
732 if (it
.length
> 0) then
734 e_WriteLog('===========================', TMsgType
.Notify
);
735 for mit
in it
do monsAtDump(mit
^);
736 e_WriteLog('---------------------------', TMsgType
.Notify
);
741 procedure cbAtcurDumpWalls ();
742 function wallToggle (pan
: TPanel
{; tag: Integer}): Boolean;
744 result
:= false; // don't stop
745 if (platMarkedGUID
= -1) then platMarkedGUID
:= pan
.guid
;
746 e_LogWritefln('wall ''%s'' #%d(%d); enabled=%d (%d); (%d,%d)-(%d,%d)', [pan
.mapId
, pan
.arrIdx
, pan
.proxyId
, Integer(pan
.Enabled
), Integer(mapGrid
.proxyEnabled
[pan
.proxyId
]), pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
]);
747 dumpPublishedProperties(pan
);
750 hasTrigs
: Boolean = false;
756 platMarkedGUID
:= -1;
757 it
:= mapGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, (GridTagWall
or GridTagDoor
));
758 if (it
.length
> 0) then
760 e_WriteLog('=== TOGGLE WALL ===', TMsgType
.Notify
);
761 for mwit
in it
do wallToggle(mwit
^);
762 e_WriteLog('--- toggle wall ---', TMsgType
.Notify
);
767 for f
:= 0 to High(gTriggers
) do
769 trig
:= @gTriggers
[f
];
770 if (pmsCurMapX
>= trig
.x
) and (pmsCurMapY
>= trig
.y
) and (pmsCurMapX
< trig
.x
+trig
.width
) and (pmsCurMapY
< trig
.y
+trig
.height
) then
772 if not hasTrigs
then begin writeln('=== TRIGGERS ==='); hasTrigs
:= true; end;
773 writeln('trigger ''', trig
.mapId
, ''' of type ''', trigType2Str(trig
.TriggerType
), '''');
776 if hasTrigs
then writeln('--- triggers ---');
780 procedure cbAtcurToggleWalls ();
781 function wallToggle (pan
: TPanel
{; tag: Integer}): Boolean;
783 result
:= false; // don't stop
784 //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);
785 if pan
.Enabled
then g_Map_DisableWallGUID(pan
.guid
) else g_Map_EnableWallGUID(pan
.guid
);
791 //e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
792 //e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
793 it
:= mapGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, (GridTagWall
or GridTagDoor
));
794 for mwit
in it
do wallToggle(mwit
^);
799 // ////////////////////////////////////////////////////////////////////////// //
800 procedure holmesInitCommands ();
802 if (cmdlist
<> nil) then exit
;
803 cmdAdd('win_layers', toggleLayersWindow
, 'toggle layers window', 'window control');
804 cmdAdd('win_outline', toggleOutlineWindow
, 'toggle outline window', 'window control');
805 cmdAdd('win_help', toggleHelpWindow
, 'toggle help window', 'window control');
806 cmdAdd('win_options', toggleOptionsWindow
, 'toggle options window', 'window control');
808 cmdAdd('mon_think_step', bcOneMonsterThinkStep
, 'one monster think step', 'monster control');
809 cmdAdd('mon_info', bcToggleMonsterInfo
, 'toggle monster info', 'monster control');
810 cmdAdd('mon_los_plr', bcToggleMonsterLOSPlr
, 'toggle monster LOS to player', 'monster control');
811 cmdAdd('mon_cells', bcToggleMonsterCells
, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control');
812 cmdAdd('mon_wakeup', bcMonsterWakeup
, 'wake up selected monster', 'monster control');
814 cmdAdd('mon_spawn', bcMonsterSpawn
, 'spawn monster', 'monster control');
816 cmdAdd('mplat_step', bcOneMPlatThinkStep
, 'one mplat think step', 'mplat control');
817 cmdAdd('mplat_toggle', bcMPlatToggle
, 'activate/deactivate moving platforms', 'mplat control');
819 cmdAdd('plr_teleport', bcPlayerTeleport
, 'teleport player', 'player control');
821 cmdAdd('dbg_curpos', bcToggleCurPos
, 'toggle "show cursor position on the map"', 'various');
822 cmdAdd('dbg_grid', bcToggleGrid
, 'toggle grid', 'various');
823 cmdAdd('dbg_triggers', bcToggleDrawTriggers
, 'show/hide triggers (SLOW!)', 'various');
825 cmdAdd('atcur_select_monster', cbAtcurSelectMonster
, 'select monster to operate', 'monster control');
826 cmdAdd('atcur_dump_monsters', cbAtcurDumpMonsters
, 'dump monsters in cell', 'monster control');
827 cmdAdd('atcur_dump_walls', cbAtcurDumpWalls
, 'dump walls in cell', 'wall control');
828 cmdAdd('atcur_disable_walls', cbAtcurToggleWalls
, 'disable walls', 'wall control');
830 cmdAdd('dbg_tracebox', dbgToggleTraceBox
, 'test traceBox()', 'player control');
832 cmdAdd('hlm_pause', dbgToggleHolmesPause
, '"Holmes" pause mode', 'game control');
836 procedure holmesInitBinds ();
839 pr
: TTextParser
= nil;
840 s
, kn
, v
: AnsiString;
845 if not keybindsInited
then
848 keybindAdd('F1', 'win_help');
849 keybindAdd('M-F1', 'win_options');
850 keybindAdd('C-O', 'win_outline');
851 keybindAdd('C-L', 'win_layers');
853 keybindAdd('M-M', 'mon_think_step');
854 keybindAdd('M-I', 'mon_info');
855 keybindAdd('M-L', 'mon_los_plr');
856 keybindAdd('M-G', 'mon_cells');
857 keybindAdd('M-A', 'mon_wakeup');
859 keybindAdd('M-P', 'mplat_step');
860 keybindAdd('M-O', 'mplat_toggle');
862 keybindAdd('C-T', 'plr_teleport');
863 keybindAdd('M-T', 'dbg_tracebox');
865 keybindAdd('C-P', 'dbg_curpos');
866 keybindAdd('C-G', 'dbg_grid');
867 keybindAdd('C-X', 'dbg_triggers');
869 keybindAdd('C-1', 'mon_spawn zombie');
871 keybindAdd('C-S-P', 'hlm_pause');
874 msbindAdd('LMB', 'atcur_select_monster');
875 msbindAdd('M-LMB', 'atcur_dump_monsters');
876 msbindAdd('RMB', 'atcur_dump_walls');
877 msbindAdd('M-RMB', 'atcur_disable_walls');
879 // load bindings from file
881 st
:= e_OpenResourceRO(ConfigDirs
, 'holmes.rc');
882 pr
:= TFileTextParser
.Create(st
);
883 conwriteln('parsing "holmes.rc"...');
884 while (pr
.tokType
<> pr
.TTEOF
) do
887 if (s
= 'stop') then break
888 else if (s
= 'unbind_keys') then keybinds
:= nil
889 else if (s
= 'unbind_mouse') then msbinds
:= nil
890 else if (s
= 'bind') then
892 if (pr
.tokType
= pr
.TTStr
) then s
:= pr
.expectStr(false)
893 else if (pr
.tokType
= pr
.TTInt
) then s
:= Format('%d', [pr
.expectInt()])
894 else s
:= pr
.expectId();
896 if (pr
.tokType
= pr
.TTStr
) then v
:= pr
.expectStr(false)
897 else if (pr
.tokType
= pr
.TTInt
) then v
:= Format('%d', [pr
.expectInt()])
898 else v
:= pr
.expectId();
900 kn
:= parseModKeys(s
, kmods
, mbuts
);
901 if (CompareText(kn
, 'lmb') = 0) or (CompareText(kn
, 'rmb') = 0) or (CompareText(kn
, 'mmb') = 0) or (CompareText(kn
, 'None') = 0) then
911 except on e
: Exception
do // sorry
912 if (pr
<> nil) then conwritefln('Holmes config parse error at (%s,%s): %s', [pr
.tokLine
, pr
.tokCol
, e
.message]);
914 if (pr
<> nil) then pr
.Free() else st
.Free(); // ownership
923 fuiEventCB
:= g_Holmes_OnEvent
;
924 //uiContext.font := 'win14';