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};
109 //globalInited: Boolean = false;
112 msB
: Word = 0; // button state
113 kbS
: Word = 0; // keyboard modifiers state
114 showGrid
: Boolean = true;
115 showMonsInfo
: Boolean = false;
116 showMonsLOS2Plr
: Boolean = false;
117 showAllMonsCells
: Boolean = false;
118 showMapCurPos
: Boolean = false;
119 showLayersWindow
: Boolean = false;
120 showOutlineWindow
: Boolean = false;
122 // ////////////////////////////////////////////////////////////////////////// //
123 {$INCLUDE g_holmes.inc}
124 {$INCLUDE g_holmes_ui.inc}
127 // ////////////////////////////////////////////////////////////////////////// //
128 // any mods = 255: nothing was defined
129 function parseModKeys (const s
: AnsiString; out kmods
: Byte; out mbuts
: Byte): AnsiString;
136 while (pos
<= Length(s
)) and (s
[pos
] <= ' ') do Inc(pos
);
137 while (pos
< Length(s
)) do
139 if (Length(s
)-pos
>= 2) and (s
[pos
+1] = '-') then
142 'C', 'c': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModCtrl
; Inc(pos
, 2); continue
; end;
143 'M', 'm': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModAlt
; Inc(pos
, 2); continue
; end;
144 'S', 's': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModShift
; Inc(pos
, 2); continue
; end;
148 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
151 'L', 'l': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Left
; Inc(pos
, 4); continue
; end;
152 'R', 'r': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Right
; Inc(pos
, 4); continue
; end;
153 'M', 'm': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Middle
; Inc(pos
, 4); continue
; end;
160 while (epos
> pos
) and (s
[epos
-1] <= ' ') do Dec(epos
);
161 if (epos
> pos
) then result
:= Copy(s
, pos
, epos
-pos
) else result
:= '';
165 operator
= (constref ev
: THKeyEvent
; const s
: AnsiString): Boolean;
173 kname
:= parseModKeys(s
, kmods
, mbuts
);
174 if (kmods
= 255) then kmods
:= 0;
175 if (ev
.kstate
<> kmods
) then exit
;
176 if (mbuts
<> 255) and (ev
.bstate
<> mbuts
) then exit
;
177 for f
:= 1 to High(e_KeyNames
) do
179 if (CompareText(kname
, e_KeyNames
[f
]) = 0) then
181 result
:= (ev
.scan
= f
);
188 operator
= (const s
: AnsiString; constref ev
: THKeyEvent
): Boolean;
194 operator
= (constref ev
: THMouseEvent
; const s
: AnsiString): Boolean;
202 kname
:= parseModKeys(s
, kmods
, mbuts
);
203 if (CompareText(kname
, 'LMB') = 0) then but
:= THMouseEvent
.Left
204 else if (CompareText(kname
, 'RMB') = 0) then but
:= THMouseEvent
.Right
205 else if (CompareText(kname
, 'MMB') = 0) then but
:= THMouseEvent
.Middle
206 else if (CompareText(kname
, 'None') = 0) then but
:= 0
209 //conwritefln('s=[%s]; kname=[%s]; kmods=%s; mbuts=%s; but=%s', [s, kname, kmods, mbuts, but]);
211 if (mbuts
= 255) then mbuts
:= 0;
212 if (kmods
<> 255) and (ev
.kstate
<> kmods
) then exit
;
214 if (ev
.kind
= ev
.Press
) then mbuts
:= mbuts
or but
215 else if (ev
.kind
= ev
.Release
) then mbuts
:= mbuts
and (not but
);
217 //conwritefln(' ev.bstate=%s; ev.but=%s; mbuts=%s', [ev.bstate, ev.but, mbuts]);
219 result
:= (ev
.bstate
= mbuts
) and (ev
.but
= but
);
223 operator
= (const s
: AnsiString; constref ev
: THMouseEvent
): Boolean;
229 // ////////////////////////////////////////////////////////////////////////// //
231 g_ol_nice
: Boolean = false;
232 g_ol_fill_walls
: Boolean = false;
233 g_ol_rlayer_back
: Boolean = false;
234 g_ol_rlayer_step
: Boolean = false;
235 g_ol_rlayer_wall
: Boolean = false;
236 g_ol_rlayer_door
: Boolean = false;
237 g_ol_rlayer_acid1
: Boolean = false;
238 g_ol_rlayer_acid2
: Boolean = false;
239 g_ol_rlayer_water
: Boolean = false;
240 g_ol_rlayer_fore
: Boolean = false;
243 // ////////////////////////////////////////////////////////////////////////// //
245 winHelp
: THTopWindow
= nil;
246 winOptions
: THTopWindow
= nil;
247 winLayers
: THTopWindow
= nil;
248 winOutlines
: THTopWindow
= nil;
251 procedure createHelpWindow ();
253 llb
: THCtlSimpleText
;
255 llb
:= THCtlSimpleText
.Create(0, 0);
256 llb
.appendItem('common keys', true, true);
257 llb
.appendItem(' F1 -- toggle this window');
258 llb
.appendItem(' M-F1 -- toggle options window');
260 llb
.appendItem('control keys', true, true);
261 llb
.appendItem(' M-M -- one monster think step');
262 llb
.appendItem(' M-I -- toggle monster info');
263 llb
.appendItem(' M-K -- toggle monster LOS to player');
264 llb
.appendItem(' M-G -- toggle "show all cells occupied by monsters" (SLOW!)');
265 llb
.appendItem(' M-A -- wake up monster');
266 llb
.appendItem(' C-T -- teleport player');
267 llb
.appendItem(' C-P -- show cursor position on the map');
268 llb
.appendItem(' C-G -- toggle grid');
269 llb
.appendItem(' C-L -- toggle layers window');
270 llb
.appendItem(' C-O -- toggle outlines window');
272 llb
.appendItem('mouse', true, true);
273 llb
.appendItem(' LMB -- select monster');
274 llb
.appendItem(' M-LMB -- dump monsters in cell (to log)');
275 llb
.appendItem(' RMB -- dump wall info to log');
276 llb
.appendItem(' M-LMB -- disable wall');
277 winHelp
:= THTopWindow
.Create('Holmes Help', 10, 10);
278 winHelp
.escClose
:= true;
279 winHelp
.appendChild(llb
);
280 winHelp
.centerInScreen();
284 procedure winLayersClosed (me
: THControl
; dummy
: Integer); begin showLayersWindow
:= false; end;
285 procedure winOutlinesClosed (me
: THControl
; dummy
: Integer); begin showOutlineWindow
:= false; end;
287 procedure createLayersWindow ();
291 llb
:= THCtlCBListBox
.Create(0, 0);
292 llb
.appendItem('background', @g_rlayer_back
);
293 llb
.appendItem('steps', @g_rlayer_step
);
294 llb
.appendItem('walls', @g_rlayer_wall
);
295 llb
.appendItem('doors', @g_rlayer_door
);
296 llb
.appendItem('acid1', @g_rlayer_acid1
);
297 llb
.appendItem('acid2', @g_rlayer_acid2
);
298 llb
.appendItem('water', @g_rlayer_water
);
299 llb
.appendItem('foreground', @g_rlayer_fore
);
300 winLayers
:= THTopWindow
.Create('layers', 10, 10);
301 winLayers
.escClose
:= true;
302 winLayers
.appendChild(llb
);
303 winLayers
.closeCB
:= winLayersClosed
;
307 procedure createOutlinesWindow ();
311 llb
:= THCtlCBListBox
.Create(0, 0);
312 llb
.appendItem('background', @g_ol_rlayer_back
);
313 llb
.appendItem('steps', @g_ol_rlayer_step
);
314 llb
.appendItem('walls', @g_ol_rlayer_wall
);
315 llb
.appendItem('doors', @g_ol_rlayer_door
);
316 llb
.appendItem('acid1', @g_ol_rlayer_acid1
);
317 llb
.appendItem('acid2', @g_ol_rlayer_acid2
);
318 llb
.appendItem('water', @g_ol_rlayer_water
);
319 llb
.appendItem('foreground', @g_ol_rlayer_fore
);
320 llb
.appendItem('OPTIONS', nil);
321 llb
.appendItem('fill walls', @g_ol_fill_walls
);
322 llb
.appendItem('contours', @g_ol_nice
);
323 winOutlines
:= THTopWindow
.Create('outlines', 100, 10);
324 winOutlines
.escClose
:= true;
325 winOutlines
.appendChild(llb
);
326 winOutlines
.closeCB
:= winOutlinesClosed
;
330 procedure toggleLayersWindow (me
: THControl
; checked
: Integer);
332 if showLayersWindow
then
334 if (winLayers
= nil) then createLayersWindow();
335 uiAddWindow(winLayers
);
339 uiRemoveWindow(winLayers
);
344 procedure toggleOutlineWindow (me
: THControl
; checked
: Integer);
346 if showOutlineWindow
then
348 if (winOutlines
= nil) then createOutlinesWindow();
349 uiAddWindow(winOutlines
);
353 uiRemoveWindow(winOutlines
);
358 procedure createOptionsWindow ();
362 llb
:= THCtlCBListBox
.Create(0, 0);
363 llb
.appendItem('map grid', @showGrid
);
364 llb
.appendItem('cursor position on map', @showMapCurPos
);
365 llb
.appendItem('monster info', @showMonsInfo
);
366 llb
.appendItem('monster LOS to player', @showMonsLOS2Plr
);
367 llb
.appendItem('monster cells (SLOW!)', @showAllMonsCells
);
368 llb
.appendItem('WINDOWS', nil);
369 llb
.appendItem('layers window', @showLayersWindow
, toggleLayersWindow
);
370 llb
.appendItem('outline window', @showOutlineWindow
, toggleOutlineWindow
);
371 winOptions
:= THTopWindow
.Create('Holmes Options', 100, 100);
372 winOptions
.escClose
:= true;
373 winOptions
.appendChild(llb
);
374 winOptions
.centerInScreen();
378 // ////////////////////////////////////////////////////////////////////////// //
379 procedure g_Holmes_VidModeChanged ();
381 e_WriteLog(Format('Holmes: videomode changed: %dx%d', [gScreenWidth
, gScreenHeight
]), MSG_NOTIFY
);
382 // texture space is possibly lost here, idc
388 //createCursorTexture();
391 procedure g_Holmes_WindowFocused ();
397 procedure g_Holmes_WindowBlured ();
402 // ////////////////////////////////////////////////////////////////////////// //
404 vpSet
: Boolean = false;
407 laserSet
: Boolean = false;
408 laserX0
, laserY0
, laserX1
, laserY1
: Integer;
409 monMarkedUID
: Integer = -1;
412 procedure g_Holmes_plrView (viewPortX
, viewPortY
, viewPortW
, viewPortH
: Integer);
421 procedure g_Holmes_plrLaser (ax0
, ay0
, ax1
, ay1
: Integer);
428 laserSet
:= laserSet
; // shut up, fpc!
432 function pmsCurMapX (): Integer; inline; begin result
:= msX
+vpx
; end;
433 function pmsCurMapY (): Integer; inline; begin result
:= msY
+vpy
; end;
436 procedure plrDebugMouse (var ev
: THMouseEvent
);
438 function wallToggle (pan
: TPanel
; tag
: Integer): Boolean;
440 result
:= false; // don't stop
441 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
);
442 if (kbS
= THKeyEvent
.ModAlt
) then
444 if pan
.Enabled
then g_Map_DisableWall(pan
.arrIdx
) else g_Map_EnableWall(pan
.arrIdx
);
448 function monsAtDump (mon
: TMonster
; tag
: Integer): Boolean;
450 result
:= false; // don't stop
451 e_WriteLog(Format('monster #%d; UID=%d', [mon
.arrIdx
, mon
.UID
]), MSG_NOTIFY
);
452 monMarkedUID
:= mon
.UID
;
453 //if pan.Enabled then g_Map_DisableWall(pan.arrIdx) else g_Map_EnableWall(pan.arrIdx);
456 function monsInCell (mon
: TMonster
; tag
: Integer): Boolean;
458 result
:= false; // don't stop
459 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon
.arrIdx
, mon
.UID
, mon
.proxyId
]), MSG_NOTIFY
);
463 //e_WriteLog(Format('mouse: x=%d; y=%d; but=%d; bstate=%d', [msx, msy, but, bstate]), MSG_NOTIFY);
464 if (gPlayer1
= nil) or not vpSet
then exit
;
465 if (ev
.kind
<> THMouseEvent
.Press
) then exit
;
467 e_WriteLog(Format('mev: %d', [Integer(ev
.kind
)]), MSG_NOTIFY
);
469 if (ev
.but
= THMouseEvent
.Right
) then
472 e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY
);
473 mapGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, wallToggle
, (GridTagWall
or GridTagDoor
));
474 e_WriteLog('--- toggle wall ---', MSG_NOTIFY
);
478 if (ev
.but
= THMouseEvent
.Left
) then
480 if (kbS
= THKeyEvent
.ModAlt
) then
482 // dump monsters in cell
483 e_WriteLog('===========================', MSG_NOTIFY
);
484 monsGrid
.forEachInCell(pmsCurMapX
, pmsCurMapY
, monsInCell
);
485 e_WriteLog('---------------------------', MSG_NOTIFY
);
487 else if (kbS
= 0) then
490 e_WriteLog('===========================', MSG_NOTIFY
);
491 monsGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, monsAtDump
);
492 e_WriteLog('---------------------------', MSG_NOTIFY
);
500 edgeBmp
: array of Byte = nil;
503 procedure drawOutlines ();
507 procedure clearEdgeBmp ();
509 SetLength(edgeBmp
, (gWinSizeX
+4)*(gWinSizeY
+4));
510 FillChar(edgeBmp
[0], Length(edgeBmp
)*sizeof(edgeBmp
[0]), 0);
513 procedure drawPanel (pan
: TPanel
);
515 sx
, len
, y0
, y1
: Integer;
517 if (pan
= nil) or (pan
.Width
< 1) or (pan
.Height
< 1) then exit
;
518 if (pan
.X
+pan
.Width
<= vpx
-1) or (pan
.Y
+pan
.Height
<= vpy
-1) then exit
;
519 if (pan
.X
>= vpx
+vpw
+1) or (pan
.Y
>= vpy
+vph
+1) then exit
;
520 if g_ol_nice
or g_ol_fill_walls
then
524 if (len
> gWinSizeX
+4) then len
:= gWinSizeX
+4;
525 if (sx
< 0) then begin len
+= sx
; sx
:= 0; end;
526 if (sx
+len
> gWinSizeX
+4) then len
:= gWinSizeX
+4-sx
;
527 if (len
< 1) then exit
;
529 assert(sx
+len
<= gWinSizeX
+4);
532 if (y0
< 0) then y0
:= 0;
533 if (y1
> gWinSizeY
+4) then y1
:= gWinSizeY
+4;
536 FillChar(edgeBmp
[y0
*(gWinSizeX
+4)+sx
], len
*sizeof(edgeBmp
[0]), 1);
542 drawRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, r
, g
, b
);
551 procedure flushLine ();
553 if (lsy
> 0) and (lsx
> 0) then
558 glVertex2f(lsx
-1+vpx
+0.37, lsy
-1+vpy
+0.37);
564 glVertex2f(lsx
-1+vpx
+0.37, lsy
-1+vpy
+0.37);
565 glVertex2f(lex
-0+vpx
+0.37, lsy
-1+vpy
+0.37);
573 procedure startLine (y
: Integer);
579 procedure putPixel (x
: Integer);
581 if (x
< 1) then exit
;
582 if (lex
+1 <> x
) then flushLine();
583 if (lsx
< 0) then lsx
:= x
;
587 procedure drawEdges ();
593 glDisable(GL_TEXTURE_2D
);
596 glDisable(GL_LINE_SMOOTH
);
597 glDisable(GL_POLYGON_SMOOTH
);
598 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
601 a
:= @edgeBmp
[y
*(gWinSizeX
+4)+1];
607 if (a
[-1] = 0) or (a
[1] = 0) or (a
[-(gWinSizeX
+4)] = 0) or (a
[gWinSizeX
+4] = 0) or
608 (a
[-(gWinSizeX
+4)-1] = 0) or (a
[-(gWinSizeX
+4)+1] = 0) or
609 (a
[gWinSizeX
+4-1] = 0) or (a
[gWinSizeX
+4+1] = 0) then
620 procedure drawFilledWalls ();
626 glDisable(GL_TEXTURE_2D
);
629 glDisable(GL_LINE_SMOOTH
);
630 glDisable(GL_POLYGON_SMOOTH
);
631 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
634 a
:= @edgeBmp
[y
*(gWinSizeX
+4)+1];
638 if (a
[0] <> 0) then putPixel(x
);
645 procedure doWallsOld (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
653 if g_ol_nice
or g_ol_fill_walls
then clearEdgeBmp();
654 for f
:= 0 to High(parr
) do
657 if (pan
= nil) or not pan
.Enabled
or (pan
.Width
< 1) or (pan
.Height
< 1) then continue
;
658 if ((pan
.PanelType
and ptype
) = 0) then continue
;
661 if g_ol_nice
then drawEdges();
662 if g_ol_fill_walls
then drawFilledWalls();
668 function doWallCB (pan
: TPanel
; tag
: Integer): Boolean;
670 result
:= false; // don't stop
671 //if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then exit;
672 if ((pan
.PanelType
and xptag
) = 0) then exit
;
676 procedure doWalls (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
682 if ((ptype
and (PANEL_WALL
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) <> 0) then ptype
:= GridTagWall
or GridTagDoor
683 else panelTypeToTag(ptype
);
684 if g_ol_nice
or g_ol_fill_walls
then clearEdgeBmp();
685 mapGrid
.forEachInAABB(vpx
-1, vpy
-1, vpw
+2, vph
+2, doWallCB
, ptype
);
686 if g_ol_nice
then drawEdges();
687 if g_ol_fill_walls
then drawFilledWalls();
691 if g_ol_rlayer_back
then doWallsOld(gRenderBackgrounds
, PANEL_BACK
, 255, 127, 0);
692 if g_ol_rlayer_step
then doWallsOld(gSteps
, PANEL_STEP
, 192, 192, 192);
693 if g_ol_rlayer_wall
then doWallsOld(gWalls
, PANEL_WALL
, 255, 255, 255);
694 if g_ol_rlayer_door
then doWallsOld(gWalls
, PANEL_OPENDOOR
or PANEL_CLOSEDOOR
, 0, 255, 0);
695 if g_ol_rlayer_acid1
then doWallsOld(gAcid1
, PANEL_ACID1
, 255, 0, 0);
696 if g_ol_rlayer_acid2
then doWallsOld(gAcid2
, PANEL_ACID2
, 198, 198, 0);
697 if g_ol_rlayer_water
then doWallsOld(gWater
, PANEL_WATER
, 0, 255, 255);
698 if g_ol_rlayer_fore
then doWallsOld(gRenderForegrounds
, PANEL_FORE
, 210, 210, 210);
702 procedure plrDebugDraw ();
704 procedure drawTileGrid ();
708 for y
:= 0 to (mapGrid
.gridHeight
div mapGrid
.tileSize
) do
710 drawLine(mapGrid
.gridX0
, mapGrid
.gridY0
+y
*mapGrid
.tileSize
, mapGrid
.gridX0
+mapGrid
.gridWidth
, mapGrid
.gridY0
+y
*mapGrid
.tileSize
, 96, 96, 96, 255);
713 for x
:= 0 to (mapGrid
.gridWidth
div mapGrid
.tileSize
) do
715 drawLine(mapGrid
.gridX0
+x
*mapGrid
.tileSize
, mapGrid
.gridY0
, mapGrid
.gridX0
+x
*mapGrid
.tileSize
, mapGrid
.gridY0
+y
*mapGrid
.gridHeight
, 96, 96, 96, 255);
719 procedure hilightCell (cx
, cy
: Integer);
721 fillRect(cx
, cy
, monsGrid
.tileSize
, monsGrid
.tileSize
, 0, 128, 0, 64);
724 procedure hilightCell1 (cx
, cy
: Integer);
726 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
727 fillRect(cx
, cy
, monsGrid
.tileSize
, monsGrid
.tileSize
, 255, 255, 0, 92);
730 function hilightWallTrc (pan
: TPanel
; tag
: Integer; x
, y
, prevx
, prevy
: Integer): Boolean;
732 result
:= false; // don't stop
733 if (pan
= nil) then exit
; // cell completion, ignore
734 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
735 fillRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, 0, 128, 128, 64);
738 function monsCollector (mon
: TMonster
; tag
: Integer): Boolean;
741 mx
, my
, mw
, mh
: Integer;
744 mon
.getMapBox(mx
, my
, mw
, mh
);
745 e_DrawQuad(mx
, my
, mx
+mw
-1, my
+mh
-1, 255, 255, 0, 96);
746 if lineAABBIntersects(laserX0
, laserY0
, laserX1
, laserY1
, mx
, my
, mw
, mh
, ex
, ey
) then
748 e_DrawPoint(8, ex
, ey
, 0, 255, 0);
752 procedure drawMonsterInfo (mon
: TMonster
);
754 mx
, my
, mw
, mh
: Integer;
756 procedure drawMonsterTargetLine ();
758 emx
, emy
, emw
, emh
: Integer;
763 if (g_GetUIDType(mon
.MonsterTargetUID
) = UID_PLAYER
) then
765 eplr
:= g_Player_Get(mon
.MonsterTargetUID
);
766 if (eplr
<> nil) then eplr
.getMapBox(emx
, emy
, emw
, emh
) else exit
;
768 else if (g_GetUIDType(mon
.MonsterTargetUID
) = UID_MONSTER
) then
770 enemy
:= g_Monsters_ByUID(mon
.MonsterTargetUID
);
771 if (enemy
<> nil) then enemy
.getMapBox(emx
, emy
, emw
, emh
) else exit
;
777 mon
.getMapBox(mx
, my
, mw
, mh
);
778 drawLine(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, 255, 0, 0, 255);
779 if (g_Map_traceToNearestWall(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, @ex
, @ey
) <> nil) then
781 drawLine(mx
+mw
div 2, my
+mh
div 2, ex
, ey
, 0, 255, 0, 255);
785 procedure drawLOS2Plr ();
787 emx
, emy
, emw
, emh
: Integer;
792 if (eplr
= nil) then exit
;
793 eplr
.getMapBox(emx
, emy
, emw
, emh
);
794 mon
.getMapBox(mx
, my
, mw
, mh
);
795 drawLine(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, 255, 0, 0, 255);
796 {$IF DEFINED(D2F_DEBUG)}
797 //mapGrid.dbgRayTraceTileHitCB := hilightCell1;
799 if (g_Map_traceToNearestWall(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, @ex
, @ey
) <> nil) then
800 //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
802 drawLine(mx
+mw
div 2, my
+mh
div 2, ex
, ey
, 0, 255, 0, 255);
804 {$IF DEFINED(D2F_DEBUG)}
805 //mapGrid.dbgRayTraceTileHitCB := nil;
810 if (mon
= nil) then exit
;
811 mon
.getMapBox(mx
, my
, mw
, mh
);
814 monsGrid
.forEachBodyCell(mon
.proxyId
, hilightCell
);
818 //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
819 darkenRect(mx
-4, my
-7*8-6, 110, 7*8+6, 128);
824 drawText6(mx
, my
, Format('%s(U:%u)', [monsTypeToString(mon
.MonsterType
), mon
.UID
]), 255, 127, 0); my
-= 8;
826 drawText6(mx
, my
, Format('Beh: %s', [monsBehToString(mon
.MonsterBehaviour
)]), 255, 127, 0); my
-= 8;
828 drawText6(mx
, my
, Format('State:%s (%d)', [monsStateToString(mon
.MonsterState
), mon
.MonsterSleep
]), 255, 127, 0); my
-= 8;
830 drawText6(mx
, my
, Format('Health:%d', [mon
.MonsterHealth
]), 255, 127, 0); my
-= 8;
832 drawText6(mx
, my
, Format('Ammo:%d', [mon
.MonsterAmmo
]), 255, 127, 0); my
-= 8;
834 drawText6(mx
, my
, Format('TgtUID:%u', [mon
.MonsterTargetUID
]), 255, 127, 0); my
-= 8;
835 drawText6(mx
, my
, Format('TgtTime:%d', [mon
.MonsterTargetTime
]), 255, 127, 0); my
-= 8;
838 drawMonsterTargetLine();
839 if showMonsLOS2Plr
then drawLOS2Plr();
841 property MonsterRemoved: Boolean read FRemoved write FRemoved;
842 property MonsterPain: Integer read FPain write FPain;
843 property MonsterAnim: Byte read FCurAnim write FCurAnim;
847 function highlightAllMonsterCells (mon
: TMonster
): Boolean;
849 result
:= false; // don't stop
850 monsGrid
.forEachBodyCell(mon
.proxyId
, hilightCell
);
855 mx
, my
, mw
, mh
: Integer;
857 if (gPlayer1
= nil) then exit
;
859 glEnable(GL_SCISSOR_TEST
);
860 glScissor(0, gWinSizeY
-gPlayerScreenSize
.Y
-1, vpw
, vph
);
863 glTranslatef(-vpx
, -vpy
, 0);
865 if (showGrid
) then drawTileGrid();
868 if (laserSet
) then g_Mons_AlongLine(laserX0
, laserY0
, laserX1
, laserY1
, monsCollector
, true);
870 if (monMarkedUID
<> -1) then
872 mon
:= g_Monsters_ByUID(monMarkedUID
);
875 mon
.getMapBox(mx
, my
, mw
, mh
);
876 e_DrawQuad(mx
, my
, mx
+mw
-1, my
+mh
-1, 255, 0, 0, 30);
877 drawMonsterInfo(mon
);
881 if showAllMonsCells
then g_Mons_ForEach(highlightAllMonsterCells
);
885 glDisable(GL_SCISSOR_TEST
);
887 if showMapCurPos
then drawText8(4, gWinSizeY
-10, Format('mappos:(%d,%d)', [pmsCurMapX
, pmsCurMapY
]), 255, 255, 0);
891 // ////////////////////////////////////////////////////////////////////////// //
892 function g_Holmes_MouseEvent (var ev
: THMouseEvent
): Boolean;
900 if not uiMouseEvent(ev
) then plrDebugMouse(ev
);
904 function g_Holmes_KeyEvent (var ev
: THKeyEvent
): Boolean;
908 {$IF DEFINED(D2F_DEBUG)}
914 procedure dummyWallTrc (cx
, cy
: Integer);
923 SDL_SCANCODE_LCTRL
, SDL_SCANCODE_RCTRL
,
924 SDL_SCANCODE_LALT
, SDL_SCANCODE_RALT
,
925 SDL_SCANCODE_LSHIFT
, SDL_SCANCODE_RSHIFT
:
928 if uiKeyEvent(ev
) then begin result
:= true; exit
; end;
930 if (ev
.kind
= THKeyEvent
.Press
) then
932 // M-M: one monster think step
936 gmon_debug_think
:= false;
937 gmon_debug_one_think_step
:= true; // do one step
940 // M-I: toggle monster info
944 showMonsInfo
:= not showMonsInfo
;
947 // M-L: toggle monster LOS to player
951 showMonsLOS2Plr
:= not showMonsLOS2Plr
;
954 // M-G: toggle "show all cells occupied by monsters"
958 showAllMonsCells
:= not showAllMonsCells
;
961 // M-A: wake up monster
965 if (monMarkedUID
<> -1) then
967 mon
:= g_Monsters_ByUID(monMarkedUID
);
968 if (mon
<> nil) then mon
.WakeUp();
972 // C-T: teleport player
976 //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY);
977 if (gPlayers
[0] <> nil) then
979 gPlayers
[0].getMapBox(x
, y
, w
, h
);
980 gPlayers
[0].TeleportTo(pmsCurMapX
-w
div 2, pmsCurMapY
-h
div 2, true, 69); // 69: don't change dir
984 // C-P: show cursor position on the map
988 showMapCurPos
:= not showMapCurPos
;
995 showGrid
:= not showGrid
;
998 // C-L: toggle layers window
1002 showLayersWindow
:= not showLayersWindow
;
1003 toggleLayersWindow(nil, 0);
1006 // C-O: toggle outlines window
1007 if (ev
= 'C-O') then
1010 showOutlineWindow
:= not showOutlineWindow
;
1011 toggleOutlineWindow(nil, 0);
1014 // F1: toggle options window
1018 if (winHelp
= nil) then createHelpWindow();
1019 if not uiVisibleWindow(winHelp
) then uiAddWindow(winHelp
) else uiRemoveWindow(winHelp
);
1022 // M-F1: toggle options window
1023 if (ev
= 'M-F1') then
1026 if (winOptions
= nil) then createOptionsWindow();
1027 if not uiVisibleWindow(winOptions
) then uiAddWindow(winOptions
) else uiRemoveWindow(winOptions
);
1030 {$IF DEFINED(D2F_DEBUG)}
1031 // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction
1032 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
1033 ((ev
.kstate
and THKeyEvent
.ModCtrl
) <> 0) then
1039 SDL_SCANCODE_UP
: dy
-= 120;
1040 SDL_SCANCODE_DOWN
: dy
+= 120;
1041 SDL_SCANCODE_LEFT
: dx
-= 120;
1042 SDL_SCANCODE_RIGHT
: dx
+= 120;
1044 {$IF DEFINED(D2F_DEBUG)}
1045 //mapGrid.dbgRayTraceTileHitCB := dummyWallTrc;
1046 mapGrid
.dbgShowTraceLog
:= true;
1048 pan
:= g_Map_traceToNearest(pmsCurMapX
, pmsCurMapY
, dx
, dy
, (GridTagWall
or GridTagDoor
or GridTagStep
or GridTagAcid1
or GridTagAcid2
or GridTagWater
), @ex
, @ey
);
1049 {$IF DEFINED(D2F_DEBUG)}
1050 //mapGrid.dbgRayTraceTileHitCB := nil;
1051 mapGrid
.dbgShowTraceLog
:= false;
1053 e_LogWritefln('v-trace: (%d,%d)-(%d,%d); end=(%d,%d); hit=%d', [pmsCurMapX
, pmsCurMapY
, dx
, dy
, ex
, ey
, (pan
<> nil)]);
1061 // ////////////////////////////////////////////////////////////////////////// //
1062 procedure g_Holmes_Draw ();
1064 glColorMask(GL_TRUE
, GL_TRUE
, GL_TRUE
, GL_TRUE
); // modify color buffer
1065 glDisable(GL_STENCIL_TEST
);
1066 glDisable(GL_BLEND
);
1067 glDisable(GL_SCISSOR_TEST
);
1068 glDisable(GL_TEXTURE_2D
);
1079 procedure g_Holmes_DrawUI ();