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}
22 {$IFDEF USE_MEMPOOL}mempool
,{$ENDIF} geom
,
24 g_textures
, g_basic
, e_graphics
, g_phys
, g_grid
, g_player
, g_monsters
,
25 g_window
, g_map
, g_triggers
, g_items
, g_game
, g_panel
, g_console
, g_gfx
,
27 sdlcarcass
, glgfx
, gh_ui
;
30 procedure g_Holmes_Draw ();
31 procedure g_Holmes_DrawUI ();
33 function g_Holmes_MouseEvent (var ev
: THMouseEvent
): Boolean; // returns `true` if event was eaten
34 function g_Holmes_KeyEvent (var ev
: THKeyEvent
): Boolean; // returns `true` if event was eaten
37 procedure g_Holmes_plrViewPos (viewPortX
, viewPortY
: Integer);
38 procedure g_Holmes_plrViewSize (viewPortW
, viewPortH
: Integer);
39 procedure g_Holmes_plrLaser (ax0
, ay0
, ax1
, ay1
: Integer);
43 g_holmes_enabled
: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}false{$ENDIF};
49 {rttiobj,} typinfo
, e_texture
,
50 SysUtils
, Classes
, GL
, SDL2
,
51 MAPDEF
, g_main
, g_options
,
52 utils
, hashtable
, xparser
;
56 //globalInited: Boolean = false;
59 msB
: Word = 0; // button state
60 kbS
: Word = 0; // keyboard modifiers state
61 showGrid
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
62 showMonsInfo
: Boolean = false;
63 showMonsLOS2Plr
: Boolean = false;
64 showAllMonsCells
: Boolean = false;
65 showMapCurPos
: Boolean = false;
66 showLayersWindow
: Boolean = false;
67 showOutlineWindow
: Boolean = false;
68 showTriggers
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
69 showTraceBox
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
72 // ////////////////////////////////////////////////////////////////////////// //
73 {$INCLUDE g_holmes.inc}
74 {$INCLUDE g_holmes_ol.inc} // outliner
77 // ////////////////////////////////////////////////////////////////////////// //
78 {$INCLUDE g_holmes_cmd.inc}
79 procedure holmesInitCommands (); forward;
80 procedure holmesInitBinds (); forward;
83 // ////////////////////////////////////////////////////////////////////////// //
85 g_ol_nice
: Boolean = false;
86 g_ol_fill_walls
: Boolean = false;
87 g_ol_rlayer_back
: Boolean = false;
88 g_ol_rlayer_step
: Boolean = false;
89 g_ol_rlayer_wall
: Boolean = false;
90 g_ol_rlayer_door
: Boolean = false;
91 g_ol_rlayer_acid1
: Boolean = false;
92 g_ol_rlayer_acid2
: Boolean = false;
93 g_ol_rlayer_water
: Boolean = false;
94 g_ol_rlayer_fore
: Boolean = false;
97 // ////////////////////////////////////////////////////////////////////////// //
99 winHelp
: THTopWindow
= nil;
100 winOptions
: THTopWindow
= nil;
101 winLayers
: THTopWindow
= nil;
102 winOutlines
: THTopWindow
= nil;
105 procedure createHelpWindow (); forward;
106 procedure createOptionsWindow (); forward;
107 procedure createLayersWindow (); forward;
108 procedure createOutlinesWindow (); forward;
111 procedure toggleLayersWindowCB (me
: THControl
; checked
: Integer);
113 if showLayersWindow
then
115 if (winLayers
= nil) then createLayersWindow();
116 uiAddWindow(winLayers
);
120 uiRemoveWindow(winLayers
);
125 procedure toggleOutlineWindowCB (me
: THControl
; checked
: Integer);
127 if showOutlineWindow
then
129 if (winOutlines
= nil) then createOutlinesWindow();
130 uiAddWindow(winOutlines
);
134 uiRemoveWindow(winOutlines
);
139 procedure createHelpWindow ();
141 llb
: THCtlSimpleText
;
142 slist
: array of AnsiString = nil;
144 bind
: THolmesBinding
;
145 f
, maxkeylen
: Integer;
148 for cmd
in cmdlist
do cmd
.helpmark
:= false;
151 for bind
in keybinds
do
153 if (Length(bind
.key
) = 0) then continue
;
154 if cmdlist
.get(bind
.cmdName
, cmd
) then
156 if (Length(cmd
.help
) > 0) then
158 cmd
.helpmark
:= true;
159 if (maxkeylen
< Length(bind
.key
)) then maxkeylen
:= Length(bind
.key
);
164 for cmd
in cmdlist
do
166 if not cmd
.helpmark
then continue
;
167 if (Length(cmd
.help
) = 0) then continue
;
169 while (f
< Length(slist
)) and (CompareText(slist
[f
], cmd
.section
) <> 0) do Inc(f
);
170 if (f
= Length(slist
)) then
172 SetLength(slist
, Length(slist
)+1);
173 slist
[High(slist
)] := cmd
.section
;
177 llb
:= THCtlSimpleText
.Create(0, 0);
178 for f
:= 0 to High(slist
) do
180 if (f
> 0) then llb
.appendItem('');
181 llb
.appendItem(slist
[f
], true, true);
182 for cmd
in cmdlist
do
184 if not cmd
.helpmark
then continue
;
185 if (CompareText(cmd
.section
, slist
[f
]) <> 0) then continue
;
186 for bind
in keybinds
do
188 if (Length(bind
.key
) = 0) then continue
;
189 if (cmd
.name
= bind
.cmdName
) then
192 while (Length(s
) < maxkeylen
) do s
+= ' ';
193 s
:= ' '+s
+' -- '+cmd
.help
;
201 for bind
in msbinds
do
203 if (Length(bind
.key
) = 0) then continue
;
204 if cmdlist
.get(bind
.cmdName
, cmd
) then
206 if (Length(cmd
.help
) > 0) then
208 cmd
.helpmark
:= true;
209 if (maxkeylen
< Length(bind
.key
)) then maxkeylen
:= Length(bind
.key
);
215 llb
.appendItem('mouse', true, true);
216 for bind
in msbinds
do
218 if (Length(bind
.key
) = 0) then continue
;
219 if cmdlist
.get(bind
.cmdName
, cmd
) then
221 if (Length(cmd
.help
) > 0) then
224 while (Length(s
) < maxkeylen
) do s
+= ' ';
225 s
:= ' '+s
+' -- '+cmd
.help
;
231 winHelp
:= THTopWindow
.Create('Holmes Help', 10, 10);
232 winHelp
.escClose
:= true;
233 winHelp
.appendChild(llb
);
234 winHelp
.centerInScreen();
238 procedure winLayersClosed (me
: THControl
; dummy
: Integer); begin showLayersWindow
:= false; end;
239 procedure winOutlinesClosed (me
: THControl
; dummy
: Integer); begin showOutlineWindow
:= false; end;
241 procedure createLayersWindow ();
245 llb
:= THCtlCBListBox
.Create(0, 0);
246 llb
.appendItem('background', @g_rlayer_back
);
247 llb
.appendItem('steps', @g_rlayer_step
);
248 llb
.appendItem('walls', @g_rlayer_wall
);
249 llb
.appendItem('doors', @g_rlayer_door
);
250 llb
.appendItem('acid1', @g_rlayer_acid1
);
251 llb
.appendItem('acid2', @g_rlayer_acid2
);
252 llb
.appendItem('water', @g_rlayer_water
);
253 llb
.appendItem('foreground', @g_rlayer_fore
);
254 winLayers
:= THTopWindow
.Create('layers', 10, 10);
255 winLayers
.escClose
:= true;
256 winLayers
.appendChild(llb
);
257 winLayers
.closeCB
:= winLayersClosed
;
261 procedure createOutlinesWindow ();
265 llb
:= THCtlCBListBox
.Create(0, 0);
266 llb
.appendItem('background', @g_ol_rlayer_back
);
267 llb
.appendItem('steps', @g_ol_rlayer_step
);
268 llb
.appendItem('walls', @g_ol_rlayer_wall
);
269 llb
.appendItem('doors', @g_ol_rlayer_door
);
270 llb
.appendItem('acid1', @g_ol_rlayer_acid1
);
271 llb
.appendItem('acid2', @g_ol_rlayer_acid2
);
272 llb
.appendItem('water', @g_ol_rlayer_water
);
273 llb
.appendItem('foreground', @g_ol_rlayer_fore
);
274 llb
.appendItem('OPTIONS', nil);
275 llb
.appendItem('fill walls', @g_ol_fill_walls
);
276 llb
.appendItem('contours', @g_ol_nice
);
277 winOutlines
:= THTopWindow
.Create('outlines', 100, 10);
278 winOutlines
.escClose
:= true;
279 winOutlines
.appendChild(llb
);
280 winOutlines
.closeCB
:= winOutlinesClosed
;
284 procedure createOptionsWindow ();
288 llb
:= THCtlCBListBox
.Create(0, 0);
289 llb
.appendItem('map grid', @showGrid
);
290 llb
.appendItem('cursor position on map', @showMapCurPos
);
291 llb
.appendItem('monster info', @showMonsInfo
);
292 llb
.appendItem('monster LOS to player', @showMonsLOS2Plr
);
293 llb
.appendItem('monster cells (SLOW!)', @showAllMonsCells
);
294 llb
.appendItem('draw triggers (SLOW!)', @showTriggers
);
295 llb
.appendItem('WINDOWS', nil);
296 llb
.appendItem('layers window', @showLayersWindow
, toggleLayersWindowCB
);
297 llb
.appendItem('outline window', @showOutlineWindow
, toggleOutlineWindowCB
);
298 winOptions
:= THTopWindow
.Create('Holmes Options', 100, 100);
299 winOptions
.escClose
:= true;
300 winOptions
.appendChild(llb
);
301 winOptions
.centerInScreen();
305 procedure toggleLayersWindow (arg
: Integer=-1);
307 if (arg
< 0) then showLayersWindow
:= not showLayersWindow
else showLayersWindow
:= (arg
> 0);
308 toggleLayersWindowCB(nil, 0);
311 procedure toggleOutlineWindow (arg
: Integer=-1);
313 if (arg
< 0) then showOutlineWindow
:= not showOutlineWindow
else showOutlineWindow
:= (arg
> 0);
314 toggleOutlineWindowCB(nil, 0);
317 procedure toggleHelpWindow (arg
: Integer=-1);
319 if (winHelp
= nil) then createHelpWindow();
320 if (arg
< 0) then begin if not uiVisibleWindow(winHelp
) then uiAddWindow(winHelp
) else uiRemoveWindow(winHelp
); end
321 else if (arg
= 0) then begin if uiVisibleWindow(winHelp
) then uiRemoveWindow(winHelp
); end
322 else begin if not uiVisibleWindow(winHelp
) then uiAddWindow(winHelp
); end
325 procedure toggleOptionsWindow (arg
: Integer=-1);
327 if (winOptions
= nil) then createOptionsWindow();
328 if (arg
< 0) then begin if not uiVisibleWindow(winOptions
) then uiAddWindow(winOptions
) else uiRemoveWindow(winOptions
); end
329 else if (arg
= 0) then begin if uiVisibleWindow(winOptions
) then uiRemoveWindow(winOptions
); end
330 else begin if not uiVisibleWindow(winOptions
) then uiAddWindow(winOptions
); end
334 // ////////////////////////////////////////////////////////////////////////// //
336 vpSet
: Boolean = false;
339 laserSet
: Boolean = false;
340 laserX0
, laserY0
, laserX1
, laserY1
: Integer;
341 monMarkedUID
: Integer = -1;
342 platMarkedGUID
: Integer = -1;
345 procedure g_Holmes_plrViewPos (viewPortX
, viewPortY
: Integer);
352 procedure g_Holmes_plrViewSize (viewPortW
, viewPortH
: Integer);
359 procedure g_Holmes_plrLaser (ax0
, ay0
, ax1
, ay1
: Integer);
366 laserSet
:= laserSet
; // shut up, fpc!
370 function pmsCurMapX (): Integer; inline; begin result
:= round(msX
/g_dbg_scale
)+vpx
; end;
371 function pmsCurMapY (): Integer; inline; begin result
:= round(msY
/g_dbg_scale
)+vpy
; end;
374 procedure plrDebugMouse (var ev
: THMouseEvent
);
376 //e_WriteLog(Format('mouse: x=%d; y=%d; but=%d; bstate=%d', [msx, msy, but, bstate]), MSG_NOTIFY);
377 if (gPlayer1
= nil) or not vpSet
then exit
;
378 //if (ev.kind <> THMouseEvent.Press) then exit;
379 //e_WriteLog(Format('mev: %d', [Integer(ev.kind)]), MSG_NOTIFY);
384 {$IFDEF HOLMES_OLD_OUTLINES}
386 edgeBmp
: array of Byte = nil;
389 procedure drawOutlines ();
393 procedure clearEdgeBmp ();
395 SetLength(edgeBmp
, (gWinSizeX
+4)*(gWinSizeY
+4));
396 FillChar(edgeBmp
[0], Length(edgeBmp
)*sizeof(edgeBmp
[0]), 0);
399 procedure drawPanel (pan
: TPanel
);
401 sx
, len
, y0
, y1
: Integer;
403 if (pan
= nil) or (pan
.Width
< 1) or (pan
.Height
< 1) then exit
;
404 if (pan
.X
+pan
.Width
<= vpx
-1) or (pan
.Y
+pan
.Height
<= vpy
-1) then exit
;
405 if (pan
.X
>= vpx
+vpw
+1) or (pan
.Y
>= vpy
+vph
+1) then exit
;
406 if g_ol_nice
or g_ol_fill_walls
then
410 if (len
> gWinSizeX
+4) then len
:= gWinSizeX
+4;
411 if (sx
< 0) then begin len
+= sx
; sx
:= 0; end;
412 if (sx
+len
> gWinSizeX
+4) then len
:= gWinSizeX
+4-sx
;
413 if (len
< 1) then exit
;
415 assert(sx
+len
<= gWinSizeX
+4);
418 if (y0
< 0) then y0
:= 0;
419 if (y1
> gWinSizeY
+4) then y1
:= gWinSizeY
+4;
422 FillChar(edgeBmp
[y0
*(gWinSizeX
+4)+sx
], len
*sizeof(edgeBmp
[0]), 1);
428 drawRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, r
, g
, b
);
437 procedure flushLine ();
439 if (lsy
> 0) and (lsx
> 0) then
444 glVertex2f(lsx
-1+vpx
+0.37, lsy
-1+vpy
+0.37);
450 glVertex2f(lsx
-1+vpx
+0.37, lsy
-1+vpy
+0.37);
451 glVertex2f(lex
-0+vpx
+0.37, lsy
-1+vpy
+0.37);
459 procedure startLine (y
: Integer);
465 procedure putPixel (x
: Integer);
467 if (x
< 1) then exit
;
468 if (lex
+1 <> x
) then flushLine();
469 if (lsx
< 0) then lsx
:= x
;
473 procedure drawEdges ();
479 glDisable(GL_TEXTURE_2D
);
482 glDisable(GL_LINE_SMOOTH
);
483 glDisable(GL_POLYGON_SMOOTH
);
484 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
487 a
:= @edgeBmp
[y
*(gWinSizeX
+4)+1];
493 if (a
[-1] = 0) or (a
[1] = 0) or (a
[-(gWinSizeX
+4)] = 0) or (a
[gWinSizeX
+4] = 0) or
494 (a
[-(gWinSizeX
+4)-1] = 0) or (a
[-(gWinSizeX
+4)+1] = 0) or
495 (a
[gWinSizeX
+4-1] = 0) or (a
[gWinSizeX
+4+1] = 0) then
506 procedure drawFilledWalls ();
512 glDisable(GL_TEXTURE_2D
);
515 glDisable(GL_LINE_SMOOTH
);
516 glDisable(GL_POLYGON_SMOOTH
);
517 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
520 a
:= @edgeBmp
[y
*(gWinSizeX
+4)+1];
524 if (a
[0] <> 0) then putPixel(x
);
531 procedure doWallsOld (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
539 if g_ol_nice
or g_ol_fill_walls
then clearEdgeBmp();
540 for f
:= 0 to High(parr
) do
543 if (pan
= nil) or not pan
.Enabled
or (pan
.Width
< 1) or (pan
.Height
< 1) then continue
;
544 if ((pan
.PanelType
and ptype
) = 0) then continue
;
547 if g_ol_nice
then drawEdges();
548 if g_ol_fill_walls
then drawFilledWalls();
554 function doWallCB (pan
: TPanel
; tag
: Integer): Boolean;
556 result
:= false; // don't stop
557 //if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then exit;
558 if ((pan
.PanelType
and xptag
) = 0) then exit
;
562 procedure doWalls (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
568 if ((ptype
and (PANEL_WALL
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) <> 0) then ptype
:= GridTagWall
or GridTagDoor
569 else panelTypeToTag(ptype
);
570 if g_ol_nice
or g_ol_fill_walls
then clearEdgeBmp();
571 mapGrid
.forEachInAABB(vpx
-1, vpy
-1, vpw
+2, vph
+2, doWallCB
, ptype
);
572 if g_ol_nice
then drawEdges();
573 if g_ol_fill_walls
then drawFilledWalls();
577 if g_ol_rlayer_back
then doWallsOld(gRenderBackgrounds
, PANEL_BACK
, 255, 127, 0);
578 if g_ol_rlayer_step
then doWallsOld(gSteps
, PANEL_STEP
, 192, 192, 192);
579 if g_ol_rlayer_wall
then doWallsOld(gWalls
, PANEL_WALL
, 255, 255, 255);
580 if g_ol_rlayer_door
then doWallsOld(gWalls
, PANEL_OPENDOOR
or PANEL_CLOSEDOOR
, 0, 255, 0);
581 if g_ol_rlayer_acid1
then doWallsOld(gAcid1
, PANEL_ACID1
, 255, 0, 0);
582 if g_ol_rlayer_acid2
then doWallsOld(gAcid2
, PANEL_ACID2
, 198, 198, 0);
583 if g_ol_rlayer_water
then doWallsOld(gWater
, PANEL_WATER
, 0, 255, 255);
584 if g_ol_rlayer_fore
then doWallsOld(gRenderForegrounds
, PANEL_FORE
, 210, 210, 210);
589 oliner
: TOutliner
= nil;
591 procedure drawOutlines ();
595 procedure clearOliner ();
597 //if (oliner <> nil) and ((oliner.height <> vph+2) or (oliner.width <> vpw+2)) then begin oliner.Free(); oliner := nil; end;
598 if (oliner
= nil) then oliner
:= TOutliner
.Create(vpw
+2, vph
+2) else oliner
.setup(vpw
+2, vph
+2);
601 procedure drawOutline (ol
: TOutliner
; sx
, sy
: Integer);
602 procedure xline (x0
, x1
, y
: Integer);
606 if (g_dbg_scale
< 1.0) then
609 for x
:= x0
to x1
do glVertex2f(sx
+x
+0.375, sy
+y
+0.375);
615 glVertex2f(sx
+x0
+0, sy
+y
+0);
616 glVertex2f(sx
+x1
+1, sy
+y
+0);
617 glVertex2f(sx
+x1
+1, sy
+y
+1);
618 glVertex2f(sx
+x0
+0, sy
+y
+1);
624 sp
: TOutliner
.TSpanX
;
626 if (ol
= nil) then exit
;
628 glDisable(GL_POINT_SMOOTH
);
629 for y
:= 0 to ol
.height
-1 do
631 for sp
in ol
.eachSpanAtY(y
) do
633 if (g_dbg_scale
<= 1.0) then
636 glVertex2f(sx
+sp
.x0
+0.375, sy
+y
+0.375);
637 glVertex2f(sx
+sp
.x1
+0.375, sy
+y
+0.375);
643 glVertex2f(sx
+sp
.x0
+0, sy
+y
+0);
644 glVertex2f(sx
+sp
.x0
+1, sy
+y
+0);
645 glVertex2f(sx
+sp
.x0
+1, sy
+y
+1);
646 glVertex2f(sx
+sp
.x0
+0, sy
+y
+1);
648 glVertex2f(sx
+sp
.x1
+0, sy
+y
+0);
649 glVertex2f(sx
+sp
.x1
+1, sy
+y
+0);
650 glVertex2f(sx
+sp
.x1
+1, sy
+y
+1);
651 glVertex2f(sx
+sp
.x1
+0, sy
+y
+1);
655 for sp
in ol
.eachSpanEdgeAtY(y
, -1) do
657 xline(sp
.x0
, sp
.x1
, y
);
660 glVertex2f(sx+sp.x0+0, sy+y+0);
661 glVertex2f(sx+sp.x1+1, sy+y+0);
662 glVertex2f(sx+sp.x1+1, sy+y+1);
663 glVertex2f(sx+sp.x0+0, sy+y+1);
667 for sp
in ol
.eachSpanEdgeAtY(y
, +1) do
669 xline(sp
.x0
, sp
.x1
, y
);
672 glVertex2f(sx+sp.x0+0, sy+y+0);
673 glVertex2f(sx+sp.x1+1, sy+y+0);
674 glVertex2f(sx+sp.x1+1, sy+y+1);
675 glVertex2f(sx+sp.x0+0, sy+y+1);
682 procedure doWallsOld (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
690 if g_ol_nice
then clearOliner();
691 for f
:= 0 to High(parr
) do
694 if (pan
= nil) or not pan
.Enabled
or (pan
.Width
< 1) or (pan
.Height
< 1) then continue
;
695 if ((pan
.PanelType
and ptype
) = 0) then continue
;
696 if (pan
.X
> vpx
+vpw
+41) or (pan
.Y
> vpy
+vph
+41) then continue
;
697 if (pan
.X
+pan
.Width
< vpx
-41) then continue
;
698 if (pan
.Y
+pan
.Height
< vpy
-41) then continue
;
701 oliner
.addRect(pan
.X
-(vpx
+1), pan
.Y
-(vpy
+1), pan
.Width
, pan
.Height
);
703 if g_ol_fill_walls
then
705 fillRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, r
, g
, b
);
707 else if not g_ol_nice
then
709 drawRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, r
, g
, b
);
714 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
715 drawOutline(oliner
, vpx
+1, vpy
+1);
720 if (vpw
< 2) or (vph
< 2) then exit
;
721 if g_ol_rlayer_back
then doWallsOld(gRenderBackgrounds
, PANEL_BACK
, 255, 127, 0);
722 if g_ol_rlayer_step
then doWallsOld(gSteps
, PANEL_STEP
, 192, 192, 192);
723 if g_ol_rlayer_wall
then doWallsOld(gWalls
, PANEL_WALL
, 255, 255, 255);
724 if g_ol_rlayer_door
then doWallsOld(gWalls
, PANEL_OPENDOOR
or PANEL_CLOSEDOOR
, 0, 255, 0);
725 if g_ol_rlayer_acid1
then doWallsOld(gAcid1
, PANEL_ACID1
, 255, 0, 0);
726 if g_ol_rlayer_acid2
then doWallsOld(gAcid2
, PANEL_ACID2
, 198, 198, 0);
727 if g_ol_rlayer_water
then doWallsOld(gWater
, PANEL_WATER
, 0, 255, 255);
728 if g_ol_rlayer_fore
then doWallsOld(gRenderForegrounds
, PANEL_FORE
, 210, 210, 210);
733 procedure plrDebugDraw ();
734 procedure drawTileGrid ();
738 for y
:= 0 to (mapGrid
.gridHeight
div mapGrid
.tileSize
) do
740 drawLine(mapGrid
.gridX0
, mapGrid
.gridY0
+y
*mapGrid
.tileSize
, mapGrid
.gridX0
+mapGrid
.gridWidth
, mapGrid
.gridY0
+y
*mapGrid
.tileSize
, 96, 96, 96, 255);
743 for x
:= 0 to (mapGrid
.gridWidth
div mapGrid
.tileSize
) do
745 drawLine(mapGrid
.gridX0
+x
*mapGrid
.tileSize
, mapGrid
.gridY0
, mapGrid
.gridX0
+x
*mapGrid
.tileSize
, mapGrid
.gridY0
+y
*mapGrid
.gridHeight
, 96, 96, 96, 255);
749 procedure drawAwakeCells ();
753 for y
:= 0 to (mapGrid
.gridHeight
div mapGrid
.tileSize
) do
755 for x
:= 0 to (mapGrid
.gridWidth
div mapGrid
.tileSize
) do
757 if awmIsSetHolmes(x
*mapGrid
.tileSize
+mapGrid
.gridX0
+1, y
*mapGrid
.tileSize
++mapGrid
.gridY0
+1) then
759 fillRect(x
*mapGrid
.tileSize
++mapGrid
.gridX0
, y
*mapGrid
.tileSize
++mapGrid
.gridY0
, monsGrid
.tileSize
, monsGrid
.tileSize
, 128, 0, 128, 64);
765 procedure drawTraceBox ();
768 px
, py
, pw
, ph
: Integer;
773 if (Length(gPlayers
) < 1) then exit
;
775 if (plr
= nil) then exit
;
776 plr
.getMapBox(px
, py
, pw
, ph
);
777 drawRect(px
, py
, pw
, ph
, 255, 0, 255, 200);
778 pdx
:= pmsCurMapX
-(px
+pw
div 2);
779 pdy
:= pmsCurMapY
-(py
+ph
div 2);
780 drawLine(px
+pw
div 2, py
+ph
div 2, px
+pw
div 2+pdx
, py
+ph
div 2+pdy
, 255, 0, 255, 200);
781 pan
:= mapGrid
.traceBox(ex
, ey
, px
, py
, pw
, ph
, pdx
, pdy
, nil, GridTagObstacle
);
784 drawRect(px
+pdx
, py
+pdy
, pw
, ph
, 255, 255, 255, 180);
788 drawRect(px
+pdx
, py
+pdy
, pw
, ph
, 255, 255, 0, 180);
790 drawRect(ex
, ey
, pw
, ph
, 255, 127, 0, 180);
793 procedure hilightCell (cx
, cy
: Integer);
795 fillRect(cx
, cy
, monsGrid
.tileSize
, monsGrid
.tileSize
, 0, 128, 0, 64);
798 procedure hilightCell1 (cx
, cy
: Integer);
800 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
801 cx
:= cx
and (not (monsGrid
.tileSize
-1));
802 cy
:= cy
and (not (monsGrid
.tileSize
-1));
803 fillRect(cx
, cy
, monsGrid
.tileSize
, monsGrid
.tileSize
, 255, 255, 0, 92);
806 function hilightWallTrc (pan
: TPanel
; tag
: Integer; x
, y
, prevx
, prevy
: Integer): Boolean;
808 result
:= false; // don't stop
809 if (pan
= nil) then exit
; // cell completion, ignore
810 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
811 fillRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, 0, 128, 128, 64);
814 function monsCollector (mon
: TMonster
; tag
: Integer): Boolean;
817 mx
, my
, mw
, mh
: Integer;
820 mon
.getMapBox(mx
, my
, mw
, mh
);
821 e_DrawQuad(mx
, my
, mx
+mw
-1, my
+mh
-1, 255, 255, 0, 96);
822 if lineAABBIntersects(laserX0
, laserY0
, laserX1
, laserY1
, mx
, my
, mw
, mh
, ex
, ey
) then
824 e_DrawPoint(8, ex
, ey
, 0, 255, 0);
828 procedure drawMonsterInfo (mon
: TMonster
);
830 mx
, my
, mw
, mh
: Integer;
832 procedure drawMonsterTargetLine ();
834 emx
, emy
, emw
, emh
: Integer;
839 if (g_GetUIDType(mon
.MonsterTargetUID
) = UID_PLAYER
) then
841 eplr
:= g_Player_Get(mon
.MonsterTargetUID
);
842 if (eplr
<> nil) then eplr
.getMapBox(emx
, emy
, emw
, emh
) else exit
;
844 else if (g_GetUIDType(mon
.MonsterTargetUID
) = UID_MONSTER
) then
846 enemy
:= g_Monsters_ByUID(mon
.MonsterTargetUID
);
847 if (enemy
<> nil) then enemy
.getMapBox(emx
, emy
, emw
, emh
) else exit
;
853 mon
.getMapBox(mx
, my
, mw
, mh
);
854 drawLine(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, 255, 0, 0, 255);
855 if (g_Map_traceToNearestWall(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, @ex
, @ey
) <> nil) then
857 drawLine(mx
+mw
div 2, my
+mh
div 2, ex
, ey
, 0, 255, 0, 255);
861 procedure drawLOS2Plr ();
863 emx
, emy
, emw
, emh
: Integer;
868 if (eplr
= nil) then exit
;
869 eplr
.getMapBox(emx
, emy
, emw
, emh
);
870 mon
.getMapBox(mx
, my
, mw
, mh
);
871 drawLine(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, 255, 0, 0, 255);
872 {$IF DEFINED(D2F_DEBUG)}
873 mapGrid
.dbgRayTraceTileHitCB
:= hilightCell1
;
875 if (g_Map_traceToNearestWall(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, @ex
, @ey
) <> nil) then
876 //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
878 drawLine(mx
+mw
div 2, my
+mh
div 2, ex
, ey
, 0, 255, 0, 255);
880 {$IF DEFINED(D2F_DEBUG)}
881 mapGrid
.dbgRayTraceTileHitCB
:= nil;
886 if (mon
= nil) then exit
;
887 mon
.getMapBox(mx
, my
, mw
, mh
);
890 monsGrid
.forEachBodyCell(mon
.proxyId
, hilightCell
);
894 //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
895 darkenRect(mx
-4, my
-7*8-6, 110, 7*8+6, 128);
900 drawText6(mx
, my
, Format('%s(U:%u)', [monsTypeToString(mon
.MonsterType
), mon
.UID
]), 255, 127, 0); my
-= 8;
902 drawText6(mx
, my
, Format('Beh: %s', [monsBehToString(mon
.MonsterBehaviour
)]), 255, 127, 0); my
-= 8;
904 drawText6(mx
, my
, Format('State:%s (%d)', [monsStateToString(mon
.MonsterState
), mon
.MonsterSleep
]), 255, 127, 0); my
-= 8;
906 drawText6(mx
, my
, Format('Health:%d', [mon
.MonsterHealth
]), 255, 127, 0); my
-= 8;
908 drawText6(mx
, my
, Format('Ammo:%d', [mon
.MonsterAmmo
]), 255, 127, 0); my
-= 8;
910 drawText6(mx
, my
, Format('TgtUID:%u', [mon
.MonsterTargetUID
]), 255, 127, 0); my
-= 8;
911 drawText6(mx
, my
, Format('TgtTime:%d', [mon
.MonsterTargetTime
]), 255, 127, 0); my
-= 8;
914 drawMonsterTargetLine();
915 if showMonsLOS2Plr
then drawLOS2Plr();
917 property MonsterRemoved: Boolean read FRemoved write FRemoved;
918 property MonsterPain: Integer read FPain write FPain;
919 property MonsterAnim: Byte read FCurAnim write FCurAnim;
923 function highlightAllMonsterCells (mon
: TMonster
): Boolean;
925 result
:= false; // don't stop
926 monsGrid
.forEachBodyCell(mon
.proxyId
, hilightCell
);
929 procedure drawSelectedPlatformCells ();
933 if not showGrid
then exit
;
934 pan
:= g_Map_PanelByGUID(platMarkedGUID
);
935 if (pan
= nil) then exit
;
936 mapGrid
.forEachBodyCell(pan
.proxyId
, hilightCell
);
937 drawRect(pan
.x
, pan
.y
, pan
.width
, pan
.height
, 0, 200, 0, 200);
940 procedure drawTrigger (var trig
: TTrigger
);
942 procedure drawPanelDest (pguid
: Integer);
946 pan
:= g_Map_PanelByGUID(pguid
);
947 if (pan
= nil) then exit
;
949 trig
.trigCenter
.x
, trig
.trigCenter
.y
,
950 pan
.x
+pan
.width
div 2, pan
.y
+pan
.height
div 2,
958 fillRect(trig
.x
, trig
.y
, trig
.width
, trig
.height
, 255, 0, 255, 96);
959 tts
:= trigType2Str(trig
.TriggerType
);
960 tx
:= trig
.x
+(trig
.width
-Length(tts
)*6) div 2;
961 darkenRect(tx
-2, trig
.y
-10, Length(tts
)*6+4, 10, 64);
962 drawText6(tx
, trig
.y
-9, tts
, 255, 127, 0);
963 tx
:= trig
.x
+(trig
.width
-Length(trig
.mapId
)*6) div 2;
964 darkenRect(tx
-2, trig
.y
-20, Length(trig
.mapId
)*6+4, 10, 64);
965 drawText6(tx
, trig
.y
-19, trig
.mapId
, 255, 255, 0);
966 drawPanelDest(trig
.trigPanelGUID
);
967 case trig
.TriggerType
of
968 TRIGGER_NONE
: begin end;
969 TRIGGER_EXIT
: begin end;
970 TRIGGER_TELEPORT
: begin end;
971 TRIGGER_OPENDOOR
: begin end;
972 TRIGGER_CLOSEDOOR
: begin end;
973 TRIGGER_DOOR
: begin end;
974 TRIGGER_DOOR5
: begin end;
975 TRIGGER_CLOSETRAP
: begin end;
976 TRIGGER_TRAP
: begin end;
977 TRIGGER_SECRET
: begin end;
978 TRIGGER_LIFTUP
: begin end;
979 TRIGGER_LIFTDOWN
: begin end;
980 TRIGGER_LIFT
: begin end;
981 TRIGGER_TEXTURE
: begin end;
982 TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
, TRIGGER_PRESS
:
984 if (trig
.trigDataRec
.trigTWidth
> 0) and (trig
.trigDataRec
.trigTHeight
> 0) then
987 trig
.trigDataRec
.trigTX
, trig
.trigDataRec
.trigTY
,
988 trig
.trigDataRec
.trigTWidth
, trig
.trigDataRec
.trigTHeight
,
991 trig
.trigCenter
.x
, trig
.trigCenter
.y
,
992 trig
.trigDataRec
.trigTX
+trig
.trigDataRec
.trigTWidth
div 2,
993 trig
.trigDataRec
.trigTY
+trig
.trigDataRec
.trigTHeight
div 2,
997 TRIGGER_SOUND
: begin end;
998 TRIGGER_SPAWNMONSTER
: begin end;
999 TRIGGER_SPAWNITEM
: begin end;
1000 TRIGGER_MUSIC
: begin end;
1001 TRIGGER_PUSH
: begin end;
1002 TRIGGER_SCORE
: begin end;
1003 TRIGGER_MESSAGE
: begin end;
1004 TRIGGER_DAMAGE
: begin end;
1005 TRIGGER_HEALTH
: begin end;
1006 TRIGGER_SHOT
: begin end;
1007 TRIGGER_EFFECT
: begin end;
1008 TRIGGER_SCRIPT
: begin end;
1011 //trigPanelId: Integer;
1014 procedure drawTriggers ();
1018 for f
:= 0 to High(gTriggers
) do drawTrigger(gTriggers
[f
]);
1021 procedure drawGibsBoxes ();
1024 px
, py
, pw
, ph
: Integer;
1027 for f
:= 0 to High(gGibs
) do
1032 gib
.getMapBox(px
, py
, pw
, ph
);
1033 drawRect(px
, py
, pw
, ph
, 255, 0, 255);
1039 scisave
: TScissorSave
;
1041 mx
, my
, mw
, mh
: Integer;
1045 if (gPlayer1
= nil) then exit
;
1047 scisave
.save(true); // enable scissoring
1050 //glScissor(0, gWinSizeY-gPlayerScreenSize.Y-1, vpw, vph);
1051 glScissor(0, gScreenHeight
-gPlayerScreenSize
.Y
-1, gPlayerScreenSize
.X
, gPlayerScreenSize
.Y
);
1053 glScalef(g_dbg_scale
, g_dbg_scale
, 1.0);
1054 glTranslatef(-vpx
, -vpy
, 0);
1056 if (showGrid
) then drawTileGrid();
1059 if (laserSet
) then g_Mons_AlongLine(laserX0
, laserY0
, laserX1
, laserY1
, monsCollector
, true);
1061 if (monMarkedUID
<> -1) then
1063 mon
:= g_Monsters_ByUID(monMarkedUID
);
1064 if (mon
<> nil) then
1066 mon
.getMapBox(mx
, my
, mw
, mh
);
1067 e_DrawQuad(mx
, my
, mx
+mw
-1, my
+mh
-1, 255, 0, 0, 30);
1068 drawMonsterInfo(mon
);
1072 if showAllMonsCells
and showGrid
then g_Mons_ForEach(highlightAllMonsterCells
);
1073 if showTriggers
then drawTriggers();
1074 if showGrid
then drawSelectedPlatformCells();
1078 if showTraceBox
then drawTraceBox();
1083 //pan := g_Map_traceToNearest(16, 608, 16, 8, (GridTagObstacle or GridTagLiquid), @ex, @ey);
1085 {$IF DEFINED(D2F_DEBUG)}
1086 mapGrid.dbgRayTraceTileHitCB := hilightCell1;
1088 pan := mapGrid.traceRay(ex, ey, 16, 608, 16, 8, nil, (GridTagObstacle or GridTagLiquid));
1089 if (pan <> nil) then writeln('end=(', ex, ',', ey, ')');
1090 {$IF DEFINED(D2F_DEBUG)}
1091 mapGrid.dbgRayTraceTileHitCB := nil;
1094 pan := g_Map_PanelAtPoint(16, 608, (GridTagObstacle or GridTagLiquid));
1095 if (pan <> nil) then writeln('hit!');
1103 if showMapCurPos
then drawText8(4, gWinSizeY
-10, Format('mappos:(%d,%d)', [pmsCurMapX
, pmsCurMapY
]), 255, 255, 0);
1107 // ////////////////////////////////////////////////////////////////////////// //
1108 function g_Holmes_MouseEvent (var ev
: THMouseEvent
): Boolean;
1112 if g_Game_IsNet
then begin result
:= false; exit
; end;
1113 if not g_holmes_enabled
then begin result
:= false; exit
; end;
1115 holmesInitCommands();
1126 if not uiMouseEvent(he
) then plrDebugMouse(he
);
1130 // ////////////////////////////////////////////////////////////////////////// //
1131 function g_Holmes_KeyEvent (var ev
: THKeyEvent
): Boolean;
1132 {$IF DEFINED(D2F_DEBUG)}
1139 procedure dummyWallTrc (cx
, cy
: Integer);
1144 if g_Game_IsNet
then begin result
:= false; exit
; end;
1145 if not g_holmes_enabled
then begin result
:= false; exit
; end;
1147 holmesInitCommands();
1153 SDL_SCANCODE_LCTRL
, SDL_SCANCODE_RCTRL
,
1154 SDL_SCANCODE_LALT
, SDL_SCANCODE_RALT
,
1155 SDL_SCANCODE_LSHIFT
, SDL_SCANCODE_RSHIFT
:
1158 if uiKeyEvent(ev
) then begin result
:= true; exit
; end;
1159 if keybindExecute(ev
) then begin result
:= true; exit
; end;
1163 {$IF DEFINED(D2F_DEBUG)}
1164 // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction
1165 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
1166 ((ev
.kstate
and THKeyEvent
.ModCtrl
) <> 0) then
1172 SDL_SCANCODE_UP
: dy
-= 120;
1173 SDL_SCANCODE_DOWN
: dy
+= 120;
1174 SDL_SCANCODE_LEFT
: dx
-= 120;
1175 SDL_SCANCODE_RIGHT
: dx
+= 120;
1177 {$IF DEFINED(D2F_DEBUG)}
1178 //mapGrid.dbgRayTraceTileHitCB := dummyWallTrc;
1179 mapGrid
.dbgShowTraceLog
:= true;
1181 pan
:= g_Map_traceToNearest(pmsCurMapX
, pmsCurMapY
, dx
, dy
, (GridTagWall
or GridTagDoor
or GridTagStep
or GridTagAcid1
or GridTagAcid2
or GridTagWater
), @ex
, @ey
);
1182 {$IF DEFINED(D2F_DEBUG)}
1183 //mapGrid.dbgRayTraceTileHitCB := nil;
1184 mapGrid
.dbgShowTraceLog
:= false;
1186 e_LogWritefln('v-trace: (%d,%d)-(%d,%d); end=(%d,%d); hit=%d', [pmsCurMapX
, pmsCurMapY
, dx
, dy
, ex
, ey
, (pan
<> nil)]);
1194 // ////////////////////////////////////////////////////////////////////////// //
1195 procedure g_Holmes_Draw ();
1197 if g_Game_IsNet
then exit
;
1199 {$IF not DEFINED(HEADLESS)}
1200 holmesInitCommands();
1203 glColorMask(GL_TRUE
, GL_TRUE
, GL_TRUE
, GL_TRUE
); // modify color buffer
1204 glDisable(GL_STENCIL_TEST
);
1205 glDisable(GL_BLEND
);
1206 glDisable(GL_SCISSOR_TEST
);
1207 glDisable(GL_TEXTURE_2D
);
1209 if gGameOn
then plrDebugDraw();
1216 procedure g_Holmes_DrawUI ();
1218 if g_Game_IsNet
then exit
;
1219 if not g_holmes_enabled
then exit
;
1220 {$IF not DEFINED(HEADLESS)}
1221 gGfxDoClear
:= false;
1222 //if assigned(prerenderFrameCB) then prerenderFrameCB();
1224 glMatrixMode(GL_MODELVIEW
);
1228 if assigned(postrenderFrameCB
) then postrenderFrameCB();
1236 // ////////////////////////////////////////////////////////////////////////// //
1237 procedure bcOneMonsterThinkStep (); begin gmon_debug_think
:= false; gmon_debug_one_think_step
:= true; end;
1238 procedure bcOneMPlatThinkStep (); begin g_dbgpan_mplat_active
:= false; g_dbgpan_mplat_step
:= true; end;
1239 procedure bcMPlatToggle (); begin g_dbgpan_mplat_active
:= not g_dbgpan_mplat_active
; end;
1241 procedure bcToggleMonsterInfo (arg
: Integer=-1); begin if (arg
< 0) then showMonsInfo
:= not showMonsInfo
else showMonsInfo
:= (arg
> 0); end;
1242 procedure bcToggleMonsterLOSPlr (arg
: Integer=-1); begin if (arg
< 0) then showMonsLOS2Plr
:= not showMonsLOS2Plr
else showMonsLOS2Plr
:= (arg
> 0); end;
1243 procedure bcToggleMonsterCells (arg
: Integer=-1); begin if (arg
< 0) then showAllMonsCells
:= not showAllMonsCells
else showAllMonsCells
:= (arg
> 0); end;
1244 procedure bcToggleDrawTriggers (arg
: Integer=-1); begin if (arg
< 0) then showTriggers
:= not showTriggers
else showTriggers
:= (arg
> 0); end;
1246 procedure bcToggleCurPos (arg
: Integer=-1); begin if (arg
< 0) then showMapCurPos
:= not showMapCurPos
else showMapCurPos
:= (arg
> 0); end;
1247 procedure bcToggleGrid (arg
: Integer=-1); begin if (arg
< 0) then showGrid
:= not showGrid
else showGrid
:= (arg
> 0); end;
1249 procedure bcMonsterSpawn (s
: AnsiString);
1253 if not gGameOn
or g_Game_IsClient
then
1255 conwriteln('cannot spawn monster in this mode');
1258 mon
:= g_Mons_SpawnAt(s
, pmsCurMapX
, pmsCurMapY
);
1259 if (mon
= nil) then begin conwritefln('unknown monster id: ''%s''', [s
]); exit
; end;
1260 monMarkedUID
:= mon
.UID
;
1263 procedure bcMonsterWakeup ();
1267 if (monMarkedUID
<> -1) then
1269 mon
:= g_Monsters_ByUID(monMarkedUID
);
1270 if (mon
<> nil) then mon
.WakeUp();
1274 procedure bcPlayerTeleport ();
1276 x
, y
, w
, h
: Integer;
1278 //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY);
1279 if (gPlayers
[0] <> nil) then
1281 gPlayers
[0].getMapBox(x
, y
, w
, h
);
1282 gPlayers
[0].TeleportTo(pmsCurMapX
-w
div 2, pmsCurMapY
-h
div 2, true, 69); // 69: don't change dir
1286 procedure dbgToggleTraceBox (arg
: Integer=-1); begin if (arg
< 0) then showTraceBox
:= not showTraceBox
else showTraceBox
:= (arg
> 0); end;
1288 procedure dbgToggleHolmesPause (arg
: Integer=-1); begin if (arg
< 0) then g_Game_HolmesPause(not gPauseHolmes
) else g_Game_HolmesPause(arg
> 0); end;
1290 procedure cbAtcurSelectMonster ();
1291 function monsAtDump (mon
: TMonster
; tag
: Integer): Boolean;
1293 result
:= true; // stop
1294 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon
.arrIdx
, mon
.UID
, mon
.proxyId
]), TMsgType
.Notify
);
1295 monMarkedUID
:= mon
.UID
;
1296 dumpPublishedProperties(mon
);
1300 x
, y
, w
, h
: Integer;
1303 if (Length(gPlayers
) > 0) then
1306 if (plr
<> nil) then
1308 plr
.getMapBox(x
, y
, w
, h
);
1309 if (pmsCurMapX
>= x
) and (pmsCurMapY
>= y
) and (pmsCurMapX
< x
+w
) and (pmsCurMapY
< y
+h
) then
1311 dumpPublishedProperties(plr
);
1315 //e_WriteLog('===========================', MSG_NOTIFY);
1316 monsGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, monsAtDump
);
1317 //e_WriteLog('---------------------------', MSG_NOTIFY);
1320 procedure cbAtcurDumpMonsters ();
1321 function monsAtDump (mon
: TMonster
; tag
: Integer): Boolean;
1323 result
:= false; // don't stop
1324 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon
.arrIdx
, mon
.UID
, mon
.proxyId
]), TMsgType
.Notify
);
1327 e_WriteLog('===========================', TMsgType
.Notify
);
1328 monsGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, monsAtDump
);
1329 e_WriteLog('---------------------------', TMsgType
.Notify
);
1332 procedure cbAtcurDumpWalls ();
1333 function wallToggle (pan
: TPanel
; tag
: Integer): Boolean;
1335 result
:= false; // don't stop
1336 if (platMarkedGUID
= -1) then platMarkedGUID
:= pan
.guid
;
1337 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
]);
1338 dumpPublishedProperties(pan
);
1341 hasTrigs
: Boolean = false;
1345 platMarkedGUID
:= -1;
1346 e_WriteLog('=== TOGGLE WALL ===', TMsgType
.Notify
);
1347 mapGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, wallToggle
, (GridTagWall
or GridTagDoor
));
1348 e_WriteLog('--- toggle wall ---', TMsgType
.Notify
);
1349 if showTriggers
then
1351 for f
:= 0 to High(gTriggers
) do
1353 trig
:= @gTriggers
[f
];
1354 if (pmsCurMapX
>= trig
.x
) and (pmsCurMapY
>= trig
.y
) and (pmsCurMapX
< trig
.x
+trig
.width
) and (pmsCurMapY
< trig
.y
+trig
.height
) then
1356 if not hasTrigs
then begin writeln('=== TRIGGERS ==='); hasTrigs
:= true; end;
1357 writeln('trigger ''', trig
.mapId
, ''' of type ''', trigType2Str(trig
.TriggerType
), '''');
1360 if hasTrigs
then writeln('--- triggers ---');
1364 procedure cbAtcurToggleWalls ();
1365 function wallToggle (pan
: TPanel
; tag
: Integer): Boolean;
1367 result
:= false; // don't stop
1368 //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);
1369 if pan
.Enabled
then g_Map_DisableWallGUID(pan
.guid
) else g_Map_EnableWallGUID(pan
.guid
);
1372 //e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
1373 mapGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, wallToggle
, (GridTagWall
or GridTagDoor
));
1374 //e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
1378 // ////////////////////////////////////////////////////////////////////////// //
1379 procedure holmesInitCommands ();
1381 if (cmdlist
<> nil) then exit
;
1382 cmdAdd('win_layers', toggleLayersWindow
, 'toggle layers window', 'window control');
1383 cmdAdd('win_outline', toggleOutlineWindow
, 'toggle outline window', 'window control');
1384 cmdAdd('win_help', toggleHelpWindow
, 'toggle help window', 'window control');
1385 cmdAdd('win_options', toggleOptionsWindow
, 'toggle options window', 'window control');
1387 cmdAdd('mon_think_step', bcOneMonsterThinkStep
, 'one monster think step', 'monster control');
1388 cmdAdd('mon_info', bcToggleMonsterInfo
, 'toggle monster info', 'monster control');
1389 cmdAdd('mon_los_plr', bcToggleMonsterLOSPlr
, 'toggle monster LOS to player', 'monster control');
1390 cmdAdd('mon_cells', bcToggleMonsterCells
, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control');
1391 cmdAdd('mon_wakeup', bcMonsterWakeup
, 'wake up selected monster', 'monster control');
1393 cmdAdd('mon_spawn', bcMonsterSpawn
, 'spawn monster', 'monster control');
1395 cmdAdd('mplat_step', bcOneMPlatThinkStep
, 'one mplat think step', 'mplat control');
1396 cmdAdd('mplat_toggle', bcMPlatToggle
, 'activate/deactivate moving platforms', 'mplat control');
1398 cmdAdd('plr_teleport', bcPlayerTeleport
, 'teleport player', 'player control');
1400 cmdAdd('dbg_curpos', bcToggleCurPos
, 'toggle "show cursor position on the map"', 'various');
1401 cmdAdd('dbg_grid', bcToggleGrid
, 'toggle grid', 'various');
1402 cmdAdd('dbg_triggers', bcToggleDrawTriggers
, 'show/hide triggers (SLOW!)', 'various');
1404 cmdAdd('atcur_select_monster', cbAtcurSelectMonster
, 'select monster to operate', 'monster control');
1405 cmdAdd('atcur_dump_monsters', cbAtcurDumpMonsters
, 'dump monsters in cell', 'monster control');
1406 cmdAdd('atcur_dump_walls', cbAtcurDumpWalls
, 'dump walls in cell', 'wall control');
1407 cmdAdd('atcur_disable_walls', cbAtcurToggleWalls
, 'disable walls', 'wall control');
1409 cmdAdd('dbg_tracebox', dbgToggleTraceBox
, 'test traceBox()', 'player control');
1411 cmdAdd('hlm_pause', dbgToggleHolmesPause
, '"Holmes" pause mode', 'game control');
1415 procedure holmesInitBinds ();
1418 pr
: TTextParser
= nil;
1419 s
, kn
, v
: AnsiString;
1424 if not keybindsInited
then
1427 keybindAdd('F1', 'win_help');
1428 keybindAdd('M-F1', 'win_options');
1429 keybindAdd('C-O', 'win_outline');
1430 keybindAdd('C-L', 'win_layers');
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');
1438 keybindAdd('M-P', 'mplat_step');
1439 keybindAdd('M-O', 'mplat_toggle');
1441 keybindAdd('C-T', 'plr_teleport');
1442 keybindAdd('M-T', 'dbg_tracebox');
1444 keybindAdd('C-P', 'dbg_curpos');
1445 keybindAdd('C-G', 'dbg_grid');
1446 keybindAdd('C-X', 'dbg_triggers');
1448 keybindAdd('C-1', 'mon_spawn zombie');
1450 keybindAdd('C-S-P', 'hlm_pause');
1453 msbindAdd('LMB', 'atcur_select_monster');
1454 msbindAdd('M-LMB', 'atcur_dump_monsters');
1455 msbindAdd('RMB', 'atcur_dump_walls');
1456 msbindAdd('M-RMB', 'atcur_disable_walls');
1458 // load bindings from file
1460 st
:= openDiskFileRO(GameDir
+'holmes.rc');
1461 pr
:= TFileTextParser
.Create(st
);
1462 conwriteln('parsing "holmes.rc"...');
1463 while (pr
.tokType
<> pr
.TTEOF
) do
1466 if (s
= 'stop') then break
1467 else if (s
= 'unbind_keys') then keybinds
:= nil
1468 else if (s
= 'unbind_mouse') then msbinds
:= nil
1469 else if (s
= 'bind') then
1471 if (pr
.tokType
= pr
.TTStr
) then s
:= pr
.expectStr(false)
1472 else if (pr
.tokType
= pr
.TTInt
) then s
:= Format('%d', [pr
.expectInt()])
1473 else s
:= pr
.expectId();
1475 if (pr
.tokType
= pr
.TTStr
) then v
:= pr
.expectStr(false)
1476 else if (pr
.tokType
= pr
.TTInt
) then v
:= Format('%d', [pr
.expectInt()])
1477 else v
:= pr
.expectId();
1479 kn
:= parseModKeys(s
, kmods
, mbuts
);
1480 if (CompareText(kn
, 'lmb') = 0) or (CompareText(kn
, 'rmb') = 0) or (CompareText(kn
, 'mmb') = 0) or (CompareText(kn
, 'None') = 0) then
1490 except on e
: Exception
do // sorry
1491 if (pr
<> nil) then conwritefln('Holmes config parse error at (%s,%s): %s', [pr
.tokLine
, pr
.tokCol
, e
.message]);
1493 if (pr
<> nil) then pr
.Free() else st
.Free(); // ownership
1498 function onMouseEvent (var ev
: THMouseEvent
): Boolean;
1500 result
:= g_Holmes_MouseEvent(ev
);
1503 function onKeyEvent (var ev
: THKeyEvent
): Boolean;
1505 if not g_holmes_enabled
then begin result
:= false; exit
; end;
1506 result
:= g_Holmes_keyEvent(ev
);
1511 evMouseCB
:= onMouseEvent
;
1512 evKeyCB
:= onKeyEvent
;
1514 conRegVar('hlm_ui_scale', @gh_ui_scale
, 0.01, 5.0, 'Holmes UI scale', '', false);