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}
23 g_textures
, g_basic
, r_graphics
, g_phys
, g_grid
, g_player
, g_monsters
,
24 g_map
, g_triggers
, g_items
, g_game
, g_panel
, g_console
, g_gfx
,
27 fui_common
, fui_events
, fui_ctls
,
31 procedure g_Holmes_Draw ();
32 procedure g_Holmes_DrawUI ();
34 procedure g_Holmes_OnEvent (var ev
: TFUIEvent
);
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_imfunctional
: Boolean = false;
44 g_holmes_enabled
: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}false{$ENDIF};
50 {$INCLUDE ../nogl/noGLuses.inc}
54 {rttiobj,} typinfo
, e_res
,
55 SysUtils
, Classes
, SDL2
,
57 utils
, hashtable
, xparser
;
61 hlmContext
: TGxContext
= nil;
62 //globalInited: Boolean = false;
65 msB
: Word = 0; // button state
66 kbS
: Word = 0; // keyboard modifiers state
67 showGrid
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
68 showMonsInfo
: Boolean = false;
69 showMonsLOS2Plr
: Boolean = false;
70 showAllMonsCells
: Boolean = false;
71 showMapCurPos
: Boolean = false;
72 showLayersWindow
: Boolean = false;
73 showOutlineWindow
: Boolean = false;
74 showTriggers
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
75 showTraceBox
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
78 // ////////////////////////////////////////////////////////////////////////// //
79 {$INCLUDE g_holmes.inc}
80 {$INCLUDE g_holmes_ol.inc} // outliner
83 // ////////////////////////////////////////////////////////////////////////// //
84 {$INCLUDE g_holmes_cmd.inc}
85 procedure holmesInitCommands (); forward;
86 procedure holmesInitBinds (); forward;
89 // ////////////////////////////////////////////////////////////////////////// //
91 g_ol_nice
: Boolean = false;
92 g_ol_fill_walls
: Boolean = false;
93 g_ol_rlayer_back
: Boolean = false;
94 g_ol_rlayer_step
: Boolean = false;
95 g_ol_rlayer_wall
: Boolean = false;
96 g_ol_rlayer_door
: Boolean = false;
97 g_ol_rlayer_acid1
: Boolean = false;
98 g_ol_rlayer_acid2
: Boolean = false;
99 g_ol_rlayer_water
: Boolean = false;
100 g_ol_rlayer_fore
: Boolean = false;
103 // ////////////////////////////////////////////////////////////////////////// //
105 winHelp
: TUITopWindow
= nil;
106 winOptions
: TUITopWindow
= nil;
107 winLayers
: TUITopWindow
= nil;
108 winOutlines
: TUITopWindow
= nil;
111 procedure createHelpWindow (); forward;
112 procedure createOptionsWindow (); forward;
113 procedure createLayersWindow (); forward;
114 procedure createOutlinesWindow (); forward;
117 procedure toggleLayersWindowCB (me
: TUIControl
);
119 showLayersWindow
:= not showLayersWindow
;
120 if showLayersWindow
then
122 if (winLayers
= nil) then createLayersWindow();
123 uiAddWindow(winLayers
);
127 uiRemoveWindow(winLayers
);
131 procedure toggleOutlineWindowCB (me
: TUIControl
);
133 showOutlineWindow
:= not showOutlineWindow
;
134 if showOutlineWindow
then
136 if (winOutlines
= nil) then createOutlinesWindow();
137 uiAddWindow(winOutlines
);
141 uiRemoveWindow(winOutlines
);
146 procedure createHelpWindow ();
147 procedure addHelpEmptyLine ();
151 stx
:= TUIStaticText
.Create();
152 stx
.flExpand
:= true;
153 stx
.halign
:= 0; // center
157 winHelp
.appendChild(stx
);
160 procedure addHelpCaptionLine (const txt
: AnsiString);
164 stx
:= TUIStaticText
.Create();
165 stx
.flExpand
:= true;
166 stx
.halign
:= 0; // center
170 winHelp
.appendChild(stx
);
173 procedure addHelpCaption (const txt
: AnsiString);
177 stx
:= TUIStaticText
.Create();
178 stx
.flExpand
:= true;
179 stx
.halign
:= 0; // center
183 winHelp
.appendChild(stx
);
186 procedure addHelpKeyMouse (const key
, txt
, grp
: AnsiString);
192 box
:= TUIHBox
.Create();
193 box
.flExpand
:= true;
195 stx
:= TUIStaticText
.Create();
196 stx
.flExpand
:= true;
197 stx
.halign
:= 1; // right
198 stx
.valign
:= 0; // center
203 box
.appendChild(stx
);
205 span
:= TUISpan
.Create();
206 span
.flDefaultSize
:= TLaySize
.Create(12, 1);
207 span
.flExpand
:= true;
208 box
.appendChild(span
);
210 stx
:= TUIStaticText
.Create();
211 stx
.flExpand
:= true;
212 stx
.halign
:= -1; // left
213 stx
.valign
:= 0; // center
217 box
.appendChild(stx
);
218 winHelp
.appendChild(box
);
221 procedure addHelpKey (const key
, txt
: AnsiString); begin addHelpKeyMouse(key
, txt
, 'help-keys'); end;
222 procedure addHelpMouse (const key
, txt
: AnsiString); begin addHelpKeyMouse(key
, txt
, 'help-mouse'); end;
225 slist
: array of AnsiString = nil;
227 bind
: THolmesBinding
;
235 winHelp
:= TUITopWindow
.Create('Holmes Help');
236 winHelp
.escClose
:= true;
237 winHelp
.flHoriz
:= false;
240 for cmd
in cmdlist
do cmd
.helpmark
:= false;
243 for bind
in keybinds
do
245 if (Length(bind
.key
) = 0) then continue
;
246 if cmdlist
.get(bind
.cmdName
, cmd
) then
248 if (Length(cmd
.help
) > 0) then
250 cmd
.helpmark
:= true;
251 //if (maxkeylen < Length(bind.key)) then maxkeylen := Length(bind.key);
256 for cmd
in cmdlist
do
258 if not cmd
.helpmark
then continue
;
259 if (Length(cmd
.help
) = 0) then begin cmd
.helpmark
:= false; continue
; end;
261 while (f
< Length(slist
)) and (CompareText(slist
[f
], cmd
.section
) <> 0) do Inc(f
);
262 if (f
= Length(slist
)) then
264 SetLength(slist
, Length(slist
)+1);
265 slist
[High(slist
)] := cmd
.section
;
269 addHelpCaptionLine('KEYBOARD');
270 //llb := TUISimpleText.Create(0, 0);
271 for f
:= 0 to High(slist
) do
273 //if (f > 0) then llb.appendItem('');
274 if (f
> 0) then addHelpEmptyLine();
275 //llb.appendItem(slist[f], true, true);
276 addHelpCaption(slist
[f
]);
277 for cmd
in cmdlist
do
279 if not cmd
.helpmark
then continue
;
280 if (CompareText(cmd
.section
, slist
[f
]) <> 0) then continue
;
281 for bind
in keybinds
do
283 if (Length(bind
.key
) = 0) then continue
;
284 if (cmd
.name
= bind
.cmdName
) then
287 //while (Length(s) < maxkeylen) do s += ' ';
288 //s := ' '+s+' -- '+cmd.help;
290 addHelpMouse(bind
.key
, cmd
.help
);
297 for cmd
in cmdlist
do cmd
.helpmark
:= false;
300 for bind
in msbinds
do
302 if (Length(bind
.key
) = 0) then continue
;
303 if cmdlist
.get(bind
.cmdName
, cmd
) then
305 if (Length(cmd
.help
) > 0) then
307 cmd
.helpmark
:= true;
308 //if (maxkeylen < Length(bind.key)) then maxkeylen := Length(bind.key);
313 //llb.appendItem('');
314 //llb.appendItem('mouse', true, true);
315 if (f
> 0) then addHelpEmptyLine();
316 addHelpCaptionLine('MOUSE');
317 for bind
in msbinds
do
319 if (Length(bind
.key
) = 0) then continue
;
320 if cmdlist
.get(bind
.cmdName
, cmd
) then
322 if (Length(cmd
.help
) > 0) then
325 //while (Length(s) < maxkeylen) do s += ' ';
326 //s := ' '+s+' -- '+cmd.help;
328 addHelpKey(bind
.key
, cmd
.help
);
333 //winHelp.appendChild(llb);
335 uiLayoutCtl(winHelp
);
336 winHelp
.escClose
:= true;
337 winHelp
.centerInScreen();
341 procedure winLayersClosed (me
: TUIControl
); begin showLayersWindow
:= false; end;
342 procedure winOutlinesClosed (me
: TUIControl
); begin showOutlineWindow
:= false; end;
344 procedure addCheckBox (parent
: TUIControl
; const text: AnsiString; pvar
: PBoolean; const aid
: AnsiString='');
348 cb
:= TUICheckBox
.Create();
353 parent
.appendChild(cb
);
356 procedure addButton (parent
: TUIControl
; const text: AnsiString; cb
: TUIControl
.TActionCB
);
360 but
:= TUIButton
.Create();
361 //but.flExpand := true;
364 parent
.appendChild(but
);
368 procedure actionFillWalls (cb
: TUIControl
);
370 TUICheckBox(cb
).checked
:= not TUICheckBox(cb
).checked
;
371 TUICheckBox(cb
.topLevel
['cbcontour']).enabled
:= not TUICheckBox(cb
).checked
;
374 procedure createLayersWindow ();
378 winLayers
:= TUITopWindow
.Create('layers');
379 winLayers
.flHoriz
:= false;
382 winLayers
.flHoriz
:= false;
383 winLayers
.escClose
:= true;
384 winLayers
.closeCB
:= winLayersClosed
;
386 box
:= TUIVBox
.Create();
387 addCheckBox(box
, '~background', @g_rlayer_back
);
388 addCheckBox(box
, '~steps', @g_rlayer_step
);
389 addCheckBox(box
, '~walls', @g_rlayer_wall
);
390 addCheckBox(box
, '~doors', @g_rlayer_door
);
391 addCheckBox(box
, 'acid~1', @g_rlayer_acid1
);
392 addCheckBox(box
, 'acid~2', @g_rlayer_acid2
);
393 addCheckBox(box
, 'wate~r', @g_rlayer_water
);
394 addCheckBox(box
, '~foreground', @g_rlayer_fore
);
395 winLayers
.appendChild(box
);
397 uiLayoutCtl(winLayers
);
401 procedure createOutlinesWindow ();
405 winOutlines
:= TUITopWindow
.Create('outlines');
406 winOutlines
.flHoriz
:= false;
407 winOutlines
.x0
:= 100;
408 winOutlines
.y0
:= 30;
409 winOutlines
.flHoriz
:= false;
410 winOutlines
.escClose
:= true;
411 winOutlines
.closeCB
:= winOutlinesClosed
;
413 box
:= TUIVBox
.Create();
414 box
.hasFrame
:= true;
415 box
.caption
:= 'layers';
416 addCheckBox(box
, '~background', @g_ol_rlayer_back
);
417 addCheckBox(box
, '~steps', @g_ol_rlayer_step
);
418 addCheckBox(box
, '~walls', @g_ol_rlayer_wall
);
419 addCheckBox(box
, '~doors', @g_ol_rlayer_door
);
420 addCheckBox(box
, 'acid~1', @g_ol_rlayer_acid1
);
421 addCheckBox(box
, 'acid~2', @g_ol_rlayer_acid2
);
422 addCheckBox(box
, 'wate~r', @g_ol_rlayer_water
);
423 addCheckBox(box
, '~foreground', @g_ol_rlayer_fore
);
424 winOutlines
.appendChild(box
);
426 box
:= TUIVBox
.Create();
427 box
.hasFrame
:= true;
428 box
.caption
:= 'options';
429 addCheckBox(box
, 'fi~ll walls', @g_ol_fill_walls
, 'cbfill');
430 addCheckBox(box
, 'con~tours', @g_ol_nice
, 'cbcontour');
431 winOutlines
.appendChild(box
);
433 winOutlines
.setActionCBFor('cbfill', actionFillWalls
);
435 uiLayoutCtl(winOutlines
);
439 procedure createOptionsWindow ();
444 winOptions
:= TUITopWindow
.Create('Holmes Options');
445 winOptions
.flHoriz
:= false;
446 winOptions
.flHoriz
:= false;
447 winOptions
.escClose
:= true;
449 box
:= TUIVBox
.Create();
450 box
.hasFrame
:= true;
451 box
.caption
:= 'visual';
452 addCheckBox(box
, 'map ~grid', @showGrid
);
453 addCheckBox(box
, 'cursor ~position on map', @showMapCurPos
);
454 addCheckBox(box
, '~monster info', @showMonsInfo
);
455 addCheckBox(box
, 'monster LO~S to player', @showMonsLOS2Plr
);
456 addCheckBox(box
, 'monster ~cells (SLOW!)', @showAllMonsCells
);
457 addCheckBox(box
, 'draw ~triggers (SLOW!)', @showTriggers
);
458 winOptions
.appendChild(box
);
460 box
:= TUIHBox
.Create();
461 box
.hasFrame
:= true;
462 box
.caption
:= 'windows';
463 box
.captionAlign
:= 0;
465 addButton(box
, '~layers', toggleLayersWindowCB
);
466 span
:= TUISpan
.Create();
467 span
.flExpand
:= true;
468 span
.flDefaultSize
:= TLaySize
.Create(4, 1);
469 box
.appendChild(span
);
470 addButton(box
, '~outline', toggleOutlineWindowCB
);
471 winOptions
.appendChild(box
);
473 uiLayoutCtl(winOptions
);
474 winOptions
.centerInScreen();
478 procedure toggleLayersWindow (arg
: Integer=-1);
480 if (arg
< 0) then showLayersWindow
:= not showLayersWindow
else showLayersWindow
:= (arg
> 0);
481 showLayersWindow
:= not showLayersWindow
; // hack for callback
482 toggleLayersWindowCB(nil);
485 procedure toggleOutlineWindow (arg
: Integer=-1);
487 if (arg
< 0) then showOutlineWindow
:= not showOutlineWindow
else showOutlineWindow
:= (arg
> 0);
488 showOutlineWindow
:= not showOutlineWindow
; // hack for callback
489 toggleOutlineWindowCB(nil);
492 procedure toggleHelpWindow (arg
: Integer=-1);
494 if (winHelp
= nil) then
496 if (arg
= 0) then exit
;
499 if (arg
< 0) then begin if not uiVisibleWindow(winHelp
) then uiAddWindow(winHelp
) else uiRemoveWindow(winHelp
); end
500 else if (arg
= 0) then begin if uiVisibleWindow(winHelp
) then uiRemoveWindow(winHelp
); end
501 else begin if (not uiVisibleWindow(winHelp
)) then uiAddWindow(winHelp
); end;
502 if (not uiVisibleWindow(winHelp
)) then FreeAndNil(winHelp
);
505 procedure toggleOptionsWindow (arg
: Integer=-1);
507 if (winOptions
= nil) then createOptionsWindow();
508 if (arg
< 0) then begin if not uiVisibleWindow(winOptions
) then uiAddWindow(winOptions
) else uiRemoveWindow(winOptions
); end
509 else if (arg
= 0) then begin if uiVisibleWindow(winOptions
) then uiRemoveWindow(winOptions
); end
510 else begin if not uiVisibleWindow(winOptions
) then uiAddWindow(winOptions
); end
514 // ////////////////////////////////////////////////////////////////////////// //
516 vpSet
: Boolean = false;
519 laserSet
: Boolean = false;
520 laserX0
, laserY0
, laserX1
, laserY1
: Integer;
521 monMarkedUID
: Integer = -1;
522 platMarkedGUID
: Integer = -1;
525 procedure g_Holmes_plrViewPos (viewPortX
, viewPortY
: Integer);
532 procedure g_Holmes_plrViewSize (viewPortW
, viewPortH
: Integer);
539 procedure g_Holmes_plrLaser (ax0
, ay0
, ax1
, ay1
: Integer);
546 laserSet
:= laserSet
; // shut up, fpc!
550 function pmsCurMapX (): Integer; inline; begin result
:= round(msX
/g_dbg_scale
)+vpx
; end;
551 function pmsCurMapY (): Integer; inline; begin result
:= round(msY
/g_dbg_scale
)+vpy
; end;
554 {$IFDEF HOLMES_OLD_OUTLINES}
556 edgeBmp
: array of Byte = nil;
559 procedure drawOutlines ();
563 procedure clearEdgeBmp ();
565 SetLength(edgeBmp
, (gScreenWidth
+4)*(gScreenHeight
+4));
566 FillChar(edgeBmp
[0], Length(edgeBmp
)*sizeof(edgeBmp
[0]), 0);
569 procedure drawPanel (pan
: TPanel
);
571 sx
, len
, y0
, y1
: Integer;
573 if (pan
= nil) or (pan
.Width
< 1) or (pan
.Height
< 1) then exit
;
574 if (pan
.X
+pan
.Width
<= vpx
-1) or (pan
.Y
+pan
.Height
<= vpy
-1) then exit
;
575 if (pan
.X
>= vpx
+vpw
+1) or (pan
.Y
>= vpy
+vph
+1) then exit
;
576 if g_ol_nice
or g_ol_fill_walls
then
580 if (len
> gScreenWidth
+4) then len
:= gScreenWidth
+4;
581 if (sx
< 0) then begin len
+= sx
; sx
:= 0; end;
582 if (sx
+len
> gScreenWidth
+4) then len
:= gScreenWidth
+4-sx
;
583 if (len
< 1) then exit
;
585 assert(sx
+len
<= gScreenWidth
+4);
588 if (y0
< 0) then y0
:= 0;
589 if (y1
> gScreenHeight
+4) then y1
:= gScreenHeight
+4;
592 FillChar(edgeBmp
[y0
*(gScreenWidth
+4)+sx
], len
*sizeof(edgeBmp
[0]), 1);
598 drawRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, r
, g
, b
);
607 procedure flushLine ();
609 if (lsy
> 0) and (lsx
> 0) then
614 glVertex2f(lsx
-1+vpx
+0.37, lsy
-1+vpy
+0.37);
620 glVertex2f(lsx
-1+vpx
+0.37, lsy
-1+vpy
+0.37);
621 glVertex2f(lex
-0+vpx
+0.37, lsy
-1+vpy
+0.37);
629 procedure startLine (y
: Integer);
635 procedure putPixel (x
: Integer);
637 if (x
< 1) then exit
;
638 if (lex
+1 <> x
) then flushLine();
639 if (lsx
< 0) then lsx
:= x
;
643 procedure drawEdges ();
649 glDisable(GL_TEXTURE_2D
);
652 glDisable(GL_LINE_SMOOTH
);
653 glDisable(GL_POLYGON_SMOOTH
);
654 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
657 a
:= @edgeBmp
[y
*(gScreenWidth
+4)+1];
663 if (a
[-1] = 0) or (a
[1] = 0) or (a
[-(gScreenWidth
+4)] = 0) or (a
[gScreenWidth
+4] = 0) or
664 (a
[-(gScreenWidth
+4)-1] = 0) or (a
[-(gScreenWidth
+4)+1] = 0) or
665 (a
[gScreenWidth
+4-1] = 0) or (a
[gScreenWidth
+4+1] = 0) then
676 procedure drawFilledWalls ();
682 glDisable(GL_TEXTURE_2D
);
685 glDisable(GL_LINE_SMOOTH
);
686 glDisable(GL_POLYGON_SMOOTH
);
687 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
690 a
:= @edgeBmp
[y
*(gScreenWidth
+4)+1];
694 if (a
[0] <> 0) then putPixel(x
);
701 procedure doWallsOld (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
709 if g_ol_nice
or g_ol_fill_walls
then clearEdgeBmp();
710 for f
:= 0 to High(parr
) do
713 if (pan
= nil) or not pan
.Enabled
or (pan
.Width
< 1) or (pan
.Height
< 1) then continue
;
714 if ((pan
.PanelType
and ptype
) = 0) then continue
;
717 if g_ol_nice
then drawEdges();
718 if g_ol_fill_walls
then drawFilledWalls();
724 function doWallCB (pan
: TPanel
; tag
: Integer): Boolean;
726 result
:= false; // don't stop
727 //if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then exit;
728 if ((pan
.PanelType
and xptag
) = 0) then exit
;
732 procedure doWalls (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
738 if ((ptype
and (PANEL_WALL
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) <> 0) then ptype
:= GridTagWall
or GridTagDoor
739 else panelTypeToTag(ptype
);
740 if g_ol_nice
or g_ol_fill_walls
then clearEdgeBmp();
741 mapGrid
.forEachInAABB(vpx
-1, vpy
-1, vpw
+2, vph
+2, doWallCB
, ptype
);
742 if g_ol_nice
then drawEdges();
743 if g_ol_fill_walls
then drawFilledWalls();
747 if g_ol_rlayer_back
then doWallsOld(gRenderBackgrounds
, PANEL_BACK
, 255, 127, 0);
748 if g_ol_rlayer_step
then doWallsOld(gSteps
, PANEL_STEP
, 192, 192, 192);
749 if g_ol_rlayer_wall
then doWallsOld(gWalls
, PANEL_WALL
, 255, 255, 255);
750 if g_ol_rlayer_door
then doWallsOld(gWalls
, PANEL_OPENDOOR
or PANEL_CLOSEDOOR
, 0, 255, 0);
751 if g_ol_rlayer_acid1
then doWallsOld(gAcid1
, PANEL_ACID1
, 255, 0, 0);
752 if g_ol_rlayer_acid2
then doWallsOld(gAcid2
, PANEL_ACID2
, 198, 198, 0);
753 if g_ol_rlayer_water
then doWallsOld(gWater
, PANEL_WATER
, 0, 255, 255);
754 if g_ol_rlayer_fore
then doWallsOld(gRenderForegrounds
, PANEL_FORE
, 210, 210, 210);
759 oliner
: TOutliner
= nil;
761 procedure drawOutlines ();
765 procedure clearOliner ();
767 //if (oliner <> nil) and ((oliner.height <> vph+2) or (oliner.width <> vpw+2)) then begin oliner.Free(); oliner := nil; end;
768 if (oliner
= nil) then oliner
:= TOutliner
.Create(vpw
+2, vph
+2) else oliner
.setup(vpw
+2, vph
+2);
771 procedure drawOutline (ol
: TOutliner
; sx
, sy
: Integer);
772 procedure xline (x0
, x1
, y
: Integer);
776 if (g_dbg_scale
< 1.0) then
779 for x
:= x0
to x1
do glVertex2f(sx
+x
+0.375, sy
+y
+0.375);
785 glVertex2f(sx
+x0
+0, sy
+y
+0);
786 glVertex2f(sx
+x1
+1, sy
+y
+0);
787 glVertex2f(sx
+x1
+1, sy
+y
+1);
788 glVertex2f(sx
+x0
+0, sy
+y
+1);
794 sp
: TOutliner
.TSpanX
;
796 if (ol
= nil) then exit
;
798 glDisable(GL_POINT_SMOOTH
);
799 for y
:= 0 to ol
.height
-1 do
801 for sp
in ol
.eachSpanAtY(y
) do
803 if (g_dbg_scale
<= 1.0) then
806 glVertex2f(sx
+sp
.x0
+0.375, sy
+y
+0.375);
807 glVertex2f(sx
+sp
.x1
+0.375, sy
+y
+0.375);
813 glVertex2f(sx
+sp
.x0
+0, sy
+y
+0);
814 glVertex2f(sx
+sp
.x0
+1, sy
+y
+0);
815 glVertex2f(sx
+sp
.x0
+1, sy
+y
+1);
816 glVertex2f(sx
+sp
.x0
+0, sy
+y
+1);
818 glVertex2f(sx
+sp
.x1
+0, sy
+y
+0);
819 glVertex2f(sx
+sp
.x1
+1, sy
+y
+0);
820 glVertex2f(sx
+sp
.x1
+1, sy
+y
+1);
821 glVertex2f(sx
+sp
.x1
+0, sy
+y
+1);
825 for sp
in ol
.eachSpanEdgeAtY(y
, -1) do
827 xline(sp
.x0
, sp
.x1
, y
);
830 glVertex2f(sx+sp.x0+0, sy+y+0);
831 glVertex2f(sx+sp.x1+1, sy+y+0);
832 glVertex2f(sx+sp.x1+1, sy+y+1);
833 glVertex2f(sx+sp.x0+0, sy+y+1);
837 for sp
in ol
.eachSpanEdgeAtY(y
, +1) do
839 xline(sp
.x0
, sp
.x1
, y
);
842 glVertex2f(sx+sp.x0+0, sy+y+0);
843 glVertex2f(sx+sp.x1+1, sy+y+0);
844 glVertex2f(sx+sp.x1+1, sy+y+1);
845 glVertex2f(sx+sp.x0+0, sy+y+1);
852 procedure doWallsOld (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
860 if g_ol_nice
then clearOliner();
861 hlmContext
.color
:= TGxRGBA
.Create(r
, g
, b
);
862 for f
:= 0 to High(parr
) do
865 if (pan
= nil) or not pan
.Enabled
or (pan
.Width
< 1) or (pan
.Height
< 1) then continue
;
866 if ((pan
.PanelType
and ptype
) = 0) then continue
;
867 if (pan
.X
> vpx
+vpw
+41) or (pan
.Y
> vpy
+vph
+41) then continue
;
868 if (pan
.X
+pan
.Width
< vpx
-41) then continue
;
869 if (pan
.Y
+pan
.Height
< vpy
-41) then continue
;
872 oliner
.addRect(pan
.X
-(vpx
+1), pan
.Y
-(vpy
+1), pan
.Width
, pan
.Height
);
874 if g_ol_fill_walls
then
876 hlmContext
.fillRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
);
878 else if not g_ol_nice
then
880 hlmContext
.rect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
);
885 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
886 drawOutline(oliner
, vpx
+1, vpy
+1);
891 if (vpw
< 2) or (vph
< 2) then exit
;
892 if g_ol_rlayer_back
then doWallsOld(gRenderBackgrounds
, PANEL_BACK
, 255, 127, 0);
893 if g_ol_rlayer_step
then doWallsOld(gSteps
, PANEL_STEP
, 192, 192, 192);
894 if g_ol_rlayer_wall
then doWallsOld(gWalls
, PANEL_WALL
, 255, 255, 255);
895 if g_ol_rlayer_door
then doWallsOld(gWalls
, PANEL_OPENDOOR
or PANEL_CLOSEDOOR
, 0, 255, 0);
896 if g_ol_rlayer_acid1
then doWallsOld(gAcid1
, PANEL_ACID1
, 255, 0, 0);
897 if g_ol_rlayer_acid2
then doWallsOld(gAcid2
, PANEL_ACID2
, 198, 198, 0);
898 if g_ol_rlayer_water
then doWallsOld(gWater
, PANEL_WATER
, 0, 255, 255);
899 if g_ol_rlayer_fore
then doWallsOld(gRenderForegrounds
, PANEL_FORE
, 210, 210, 210);
904 procedure plrDebugDraw ();
905 procedure drawTileGrid ();
909 hlmContext
.color
:= TGxRGBA
.Create(96, 96, 96);
910 for y
:= 0 to (mapGrid
.gridHeight
div mapGrid
.tileSize
) do
912 hlmContext
.line(mapGrid
.gridX0
, mapGrid
.gridY0
+y
*mapGrid
.tileSize
, mapGrid
.gridX0
+mapGrid
.gridWidth
, mapGrid
.gridY0
+y
*mapGrid
.tileSize
);
915 hlmContext
.color
:= TGxRGBA
.Create(96, 96, 96);
916 for x
:= 0 to (mapGrid
.gridWidth
div mapGrid
.tileSize
) do
918 hlmContext
.line(mapGrid
.gridX0
+x
*mapGrid
.tileSize
, mapGrid
.gridY0
, mapGrid
.gridX0
+x
*mapGrid
.tileSize
, mapGrid
.gridY0
+y
*mapGrid
.gridHeight
);
922 procedure drawAwakeCells ();
926 hlmContext
.color
:= TGxRGBA
.Create(128, 0, 128, 64);
927 for y
:= 0 to (mapGrid
.gridHeight
div mapGrid
.tileSize
) do
929 for x
:= 0 to (mapGrid
.gridWidth
div mapGrid
.tileSize
) do
931 if awmIsSetHolmes(x
*mapGrid
.tileSize
+mapGrid
.gridX0
+1, y
*mapGrid
.tileSize
++mapGrid
.gridY0
+1) then
933 hlmContext
.fillRect(x
*mapGrid
.tileSize
++mapGrid
.gridX0
, y
*mapGrid
.tileSize
++mapGrid
.gridY0
, monsGrid
.tileSize
, monsGrid
.tileSize
);
939 procedure drawTraceBox ();
942 px
, py
, pw
, ph
: Integer;
947 if (Length(gPlayers
) < 1) then exit
;
949 if (plr
= nil) then exit
;
950 plr
.getMapBox(px
, py
, pw
, ph
);
951 hlmContext
.color
:= TGxRGBA
.Create(255, 0, 255, 200);
952 hlmContext
.rect(px
, py
, pw
, ph
);
953 pdx
:= pmsCurMapX
-(px
+pw
div 2);
954 pdy
:= pmsCurMapY
-(py
+ph
div 2);
955 hlmContext
.color
:= TGxRGBA
.Create(255, 0, 255, 200);
956 hlmContext
.line(px
+pw
div 2, py
+ph
div 2, px
+pw
div 2+pdx
, py
+ph
div 2+pdy
);
957 pan
:= mapGrid
.traceBox(ex
, ey
, px
, py
, pw
, ph
, pdx
, pdy
, GridTagObstacle
);
960 hlmContext
.color
:= TGxRGBA
.Create(255, 255, 255, 180);
961 hlmContext
.rect(px
+pdx
, py
+pdy
, pw
, ph
);
965 hlmContext
.color
:= TGxRGBA
.Create(255, 255, 0, 180);
966 hlmContext
.rect(px
+pdx
, py
+pdy
, pw
, ph
);
968 hlmContext
.color
:= TGxRGBA
.Create(255, 127, 0, 180);
969 hlmContext
.rect(ex
, ey
, pw
, ph
);
972 procedure hilightCell (cx
, cy
: Integer);
974 hlmContext
.color
:= TGxRGBA
.Create(0, 128, 0, 64);
975 hlmContext
.fillRect(cx
, cy
, monsGrid
.tileSize
, monsGrid
.tileSize
);
978 procedure hilightBodyCells (proxyId
: Integer);
981 pcellxy
: PGridCellCoord
;
983 //monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
984 it
:= monsGrid
.forEachBodyCell(proxyId
);
985 for pcellxy
in it
do hilightCell(pcellxy
^.x
, pcellxy
^.y
);
989 procedure hilightCell1 (cx
, cy
: Integer);
991 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
992 cx
:= cx
and (not (monsGrid
.tileSize
-1));
993 cy
:= cy
and (not (monsGrid
.tileSize
-1));
994 hlmContext
.color
:= TGxRGBA
.Create(255, 255, 0, 92);
995 hlmContext
.fillRect(cx
, cy
, monsGrid
.tileSize
, monsGrid
.tileSize
);
998 function hilightWallTrc (pan
: TPanel
; tag
: Integer; x
, y
, prevx
, prevy
: Integer): Boolean;
1000 result
:= false; // don't stop
1001 if (pan
= nil) then exit
; // cell completion, ignore
1002 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
1003 hlmContext
.color
:= TGxRGBA
.Create(0, 128, 128, 64);
1004 hlmContext
.fillRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
);
1007 procedure monsCollector (mon
: TMonster
);
1010 mx
, my
, mw
, mh
: Integer;
1012 mon
.getMapBox(mx
, my
, mw
, mh
);
1013 hlmContext
.color
:= TGxRGBA
.Create(255, 255, 0, 160);
1014 hlmContext
.rect(mx
, my
, mw
, mh
);
1015 //e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 255, 0, 96);
1016 if lineAABBIntersects(laserX0
, laserY0
, laserX1
, laserY1
, mx
, my
, mw
, mh
, ex
, ey
) then
1018 //e_DrawPoint(8, ex, ey, 0, 255, 0);
1019 hlmContext
.color
:= TGxRGBA
.Create(0, 255, 0, 220);
1020 hlmContext
.fillRect(ex
-2, ey
-2, 7, 7);
1024 procedure drawMonsterInfo (mon
: TMonster
);
1026 mx
, my
, mw
, mh
: Integer;
1028 procedure drawMonsterTargetLine ();
1030 emx
, emy
, emw
, emh
: Integer;
1035 if (g_GetUIDType(mon
.MonsterTargetUID
) = UID_PLAYER
) then
1037 eplr
:= g_Player_Get(mon
.MonsterTargetUID
);
1038 if (eplr
<> nil) then eplr
.getMapBox(emx
, emy
, emw
, emh
) else exit
;
1040 else if (g_GetUIDType(mon
.MonsterTargetUID
) = UID_MONSTER
) then
1042 enemy
:= g_Monsters_ByUID(mon
.MonsterTargetUID
);
1043 if (enemy
<> nil) then enemy
.getMapBox(emx
, emy
, emw
, emh
) else exit
;
1049 mon
.getMapBox(mx
, my
, mw
, mh
);
1050 hlmContext
.color
:= TGxRGBA
.Create(255, 0, 0);
1051 hlmContext
.line(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2);
1052 if (g_Map_traceToNearestWall(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, @ex
, @ey
) <> nil) then
1054 hlmContext
.color
:= TGxRGBA
.Create(0, 255, 0);
1055 hlmContext
.line(mx
+mw
div 2, my
+mh
div 2, ex
, ey
);
1059 procedure drawLOS2Plr ();
1061 emx
, emy
, emw
, emh
: Integer;
1065 eplr
:= gPlayers
[0];
1066 if (eplr
= nil) then exit
;
1067 eplr
.getMapBox(emx
, emy
, emw
, emh
);
1068 mon
.getMapBox(mx
, my
, mw
, mh
);
1069 hlmContext
.color
:= TGxRGBA
.Create(255, 0, 0);
1070 hlmContext
.line(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2);
1071 {$IF DEFINED(D2F_DEBUG)}
1072 mapGrid
.dbgRayTraceTileHitCB
:= hilightCell1
;
1074 if (g_Map_traceToNearestWall(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, @ex
, @ey
) <> nil) then
1075 //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
1077 hlmContext
.color
:= TGxRGBA
.Create(0, 255, 0);
1078 hlmContext
.line(mx
+mw
div 2, my
+mh
div 2, ex
, ey
);
1080 {$IF DEFINED(D2F_DEBUG)}
1081 mapGrid
.dbgRayTraceTileHitCB
:= nil;
1086 if (mon
= nil) then exit
;
1087 mon
.getMapBox(mx
, my
, mw
, mh
);
1090 //monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
1091 hilightBodyCells(mon
.proxyId
);
1093 if showMonsInfo
then
1095 //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
1096 hlmContext
.font
:= 'msx6';
1097 hlmContext
.color
:= TGxRGBA
.Create(255, 127, 0);
1099 hlmContext
.darkenRect(mx
-4, my
-7*hlmContext
.charWidth(' ')-6, 110, 7*hlmContext
.charWidth(' ')+6, 128);
1104 hlmContext
.drawText(mx
, my
, Format('%s(U:%u)', [monsTypeToString(mon
.MonsterType
), mon
.UID
])); my
-= hlmContext
.charWidth(' ');
1106 hlmContext
.drawText(mx
, my
, Format('Beh: %s', [monsBehToString(mon
.MonsterBehaviour
)])); my
-= hlmContext
.charWidth(' ');
1108 hlmContext
.drawText(mx
, my
, Format('State:%s (%d)', [monsStateToString(mon
.MonsterState
), mon
.MonsterSleep
])); my
-= hlmContext
.charWidth(' ');
1110 hlmContext
.drawText(mx
, my
, Format('Health:%d', [mon
.MonsterHealth
])); my
-= hlmContext
.charWidth(' ');
1112 hlmContext
.drawText(mx
, my
, Format('Ammo:%d', [mon
.MonsterAmmo
])); my
-= hlmContext
.charWidth(' ');
1114 hlmContext
.drawText(mx
, my
, Format('TgtUID:%u', [mon
.MonsterTargetUID
])); my
-= hlmContext
.charWidth(' ');
1115 hlmContext
.drawText(mx
, my
, Format('TgtTime:%d', [mon
.MonsterTargetTime
])); my
-= hlmContext
.charWidth(' ');
1118 drawMonsterTargetLine();
1119 if showMonsLOS2Plr
then drawLOS2Plr();
1121 property MonsterRemoved: Boolean read FRemoved write FRemoved;
1122 property MonsterPain: Integer read FPain write FPain;
1123 property MonsterAnim: Byte read FCurAnim write FCurAnim;
1127 function highlightAllMonsterCells (mon
: TMonster
): Boolean;
1129 result
:= false; // don't stop
1130 //monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
1131 hilightBodyCells(mon
.proxyId
);
1134 procedure drawSelectedPlatformCells ();
1138 if not showGrid
then exit
;
1139 pan
:= g_Map_PanelByGUID(platMarkedGUID
);
1140 if (pan
= nil) then exit
;
1141 //mapGrid.forEachBodyCell(pan.proxyId, hilightCell);
1142 hilightBodyCells(pan
.proxyId
);
1143 hlmContext
.color
:= TGxRGBA
.Create(0, 200, 0, 200);
1144 hlmContext
.rect(pan
.x
, pan
.y
, pan
.width
, pan
.height
);
1147 procedure drawTrigger (var trig
: TTrigger
);
1149 procedure drawPanelDest (pguid
: Integer);
1153 pan
:= g_Map_PanelByGUID(pguid
);
1154 if (pan
= nil) then exit
;
1155 hlmContext
.color
:= TGxRGBA
.Create(255, 0, 255, 220);
1156 hlmContext
.line(trig
.trigCenter
.x
, trig
.trigCenter
.y
, pan
.x
+pan
.width
div 2, pan
.y
+pan
.height
div 2);
1163 hlmContext
.font
:= 'msx6';
1164 hlmContext
.color
:= TGxRGBA
.Create(255, 0, 255, 96);
1165 hlmContext
.fillRect(trig
.x
, trig
.y
, trig
.width
, trig
.height
);
1166 tts
:= trigType2Str(trig
.TriggerType
);
1167 tx
:= trig
.x
+(trig
.width
-Length(tts
)*6) div 2;
1168 hlmContext
.darkenRect(tx
-2, trig
.y
-10, Length(tts
)*6+4, 10, 64);
1169 hlmContext
.color
:= TGxRGBA
.Create(255, 127, 0);
1170 hlmContext
.drawText(tx
, trig
.y
-9, tts
);
1171 tx
:= trig
.x
+(trig
.width
-Length(trig
.mapId
)*6) div 2;
1172 hlmContext
.darkenRect(tx
-2, trig
.y
-20, Length(trig
.mapId
)*6+4, 10, 64);
1173 hlmContext
.color
:= TGxRGBA
.Create(255, 255, 0);
1174 hlmContext
.drawText(tx
, trig
.y
-19, trig
.mapId
);
1175 drawPanelDest(trig
.trigPanelGUID
);
1176 case trig
.TriggerType
of
1177 TRIGGER_NONE
: begin end;
1178 TRIGGER_EXIT
: begin end;
1179 TRIGGER_TELEPORT
: begin end;
1180 TRIGGER_OPENDOOR
: begin end;
1181 TRIGGER_CLOSEDOOR
: begin end;
1182 TRIGGER_DOOR
: begin end;
1183 TRIGGER_DOOR5
: begin end;
1184 TRIGGER_CLOSETRAP
: begin end;
1185 TRIGGER_TRAP
: begin end;
1186 TRIGGER_SECRET
: begin end;
1187 TRIGGER_LIFTUP
: begin end;
1188 TRIGGER_LIFTDOWN
: begin end;
1189 TRIGGER_LIFT
: begin end;
1190 TRIGGER_TEXTURE
: begin end;
1191 TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
, TRIGGER_PRESS
:
1193 if (trig
.trigDataRec
.trigTWidth
> 0) and (trig
.trigDataRec
.trigTHeight
> 0) then
1195 hlmContext
.color
:= TGxRGBA
.Create(0, 255, 255, 42);
1196 hlmContext
.fillRect(
1197 trig
.trigDataRec
.trigTX
, trig
.trigDataRec
.trigTY
,
1198 trig
.trigDataRec
.trigTWidth
, trig
.trigDataRec
.trigTHeight
);
1199 hlmContext
.color
:= TGxRGBA
.Create(255, 0, 255, 220);
1201 trig
.trigCenter
.x
, trig
.trigCenter
.y
,
1202 trig
.trigDataRec
.trigTX
+trig
.trigDataRec
.trigTWidth
div 2,
1203 trig
.trigDataRec
.trigTY
+trig
.trigDataRec
.trigTHeight
div 2);
1206 TRIGGER_SOUND
: begin end;
1207 TRIGGER_SPAWNMONSTER
: begin end;
1208 TRIGGER_SPAWNITEM
: begin end;
1209 TRIGGER_MUSIC
: begin end;
1210 TRIGGER_PUSH
: begin end;
1211 TRIGGER_SCORE
: begin end;
1212 TRIGGER_MESSAGE
: begin end;
1213 TRIGGER_DAMAGE
: begin end;
1214 TRIGGER_HEALTH
: begin end;
1215 TRIGGER_SHOT
: begin end;
1216 TRIGGER_EFFECT
: begin end;
1217 TRIGGER_SCRIPT
: begin end;
1220 //trigPanelId: Integer;
1223 procedure drawTriggers ();
1227 for f
:= 0 to High(gTriggers
) do drawTrigger(gTriggers
[f
]);
1230 {$IFDEF ENABLE_GIBS}
1231 procedure drawGibsBoxes ();
1234 px
, py
, pw
, ph
: Integer;
1237 for f
:= 0 to High(gGibs
) do
1242 gib
.getMapBox(px
, py
, pw
, ph
);
1243 hlmContext
.color
:= TGxRGBA
.Create(255, 0, 255);
1244 hlmContext
.rect(px
, py
, pw
, ph
);
1253 it
: TMonsterGrid
.Iter
;
1254 mx
, my
, mw
, mh
: Integer;
1260 if (gPlayer1
= nil) then exit
;
1262 if (hlmContext
= nil) then hlmContext
:= TGxContext
.Create();
1264 gxSetContext(hlmContext
);
1266 //glScissor(0, gScreenHeight-gPlayerScreenSize.Y-1, vpw, vph);
1267 //hlmContext.clip := TGxRect.Create(0, gScreenHeight-gPlayerScreenSize.Y-1, gPlayerScreenSize.X, gPlayerScreenSize.Y);
1270 glScalef(g_dbg_scale, g_dbg_scale, 1.0);
1271 glTranslatef(-vpx, -vpy, 0);
1273 hlmContext
.glSetScaleTrans(g_dbg_scale
, -vpx
, -vpy
);
1274 glEnable(GL_SCISSOR_TEST
);
1275 glScissor(0, gScreenHeight
-gPlayerScreenSize
.Y
-1, gPlayerScreenSize
.X
, gPlayerScreenSize
.Y
);
1277 if (showGrid
) then drawTileGrid();
1282 //g_Mons_AlongLine(laserX0, laserY0, laserX1, laserY1, monsCollector, true);
1283 it
:= monsGrid
.forEachAlongLine(laserX0
, laserY0
, laserX1
, laserY1
, -1, true);
1284 for mit
in it
do monsCollector(mit
^);
1288 if (monMarkedUID
<> -1) then
1290 mon
:= g_Monsters_ByUID(monMarkedUID
);
1291 if (mon
<> nil) then
1293 mon
.getMapBox(mx
, my
, mw
, mh
);
1294 //e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 0, 0, 30);
1295 hlmContext
.color
:= TGxRGBA
.Create(255, 0, 0, 220);
1296 hlmContext
.rect(mx
, my
, mw
, mh
);
1297 drawMonsterInfo(mon
);
1301 if showAllMonsCells
and showGrid
then g_Mons_ForEach(highlightAllMonsterCells
);
1302 if showTriggers
then drawTriggers();
1303 if showGrid
then drawSelectedPlatformCells();
1307 if showTraceBox
then drawTraceBox();
1309 {$IFDEF ENABLE_GIBS}
1313 //pan := g_Map_traceToNearest(16, 608, 16, 8, (GridTagObstacle or GridTagLiquid), @ex, @ey);
1315 {$IF DEFINED(D2F_DEBUG)}
1316 mapGrid.dbgRayTraceTileHitCB := hilightCell1;
1318 pan := mapGrid.traceRay(ex, ey, 16, 608, 16, 8, nil, (GridTagObstacle or GridTagLiquid));
1319 if (pan <> nil) then writeln('end=(', ex, ',', ey, ')');
1320 {$IF DEFINED(D2F_DEBUG)}
1321 mapGrid.dbgRayTraceTileHitCB := nil;
1324 pan := g_Map_PanelAtPoint(16, 608, (GridTagObstacle or GridTagLiquid));
1325 if (pan <> nil) then writeln('hit!');
1332 if showMapCurPos
then
1334 s
:= Format('mappos:(%d,%d)', [pmsCurMapX
, pmsCurMapY
]);
1335 gxSetContext(hlmContext
);
1336 hlmContext
.font
:= 'win8';
1337 hlmContext
.color
:= TGxRGBA
.Create(0, 0, 0);
1338 for dy
:= -1 to 1 do
1340 for dx
:= -1 to 1 do
1342 if (dx
<> 0) or (dy
<> 0) then hlmContext
.drawText(4+dx
, gScreenHeight
-10+dy
, s
);
1345 hlmContext
.color
:= TGxRGBA
.Create(255, 255, 0);
1346 hlmContext
.drawText(4, gScreenHeight
-10, s
);
1352 // ////////////////////////////////////////////////////////////////////////// //
1353 procedure onKeyEvent (var ev
: TFUIEvent
);
1354 {$IF DEFINED(D2F_DEBUG)}
1361 procedure dummyWallTrc (cx
, cy
: Integer);
1369 {$IF DEFINED(D2F_DEBUG)}
1370 // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction
1371 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
1372 ((ev
.kstate
and TFUIEvent
.ModCtrl
) <> 0) then
1378 SDL_SCANCODE_UP
: dy
-= 120;
1379 SDL_SCANCODE_DOWN
: dy
+= 120;
1380 SDL_SCANCODE_LEFT
: dx
-= 120;
1381 SDL_SCANCODE_RIGHT
: dx
+= 120;
1383 {$IF DEFINED(D2F_DEBUG)}
1384 //mapGrid.dbgRayTraceTileHitCB := dummyWallTrc;
1385 mapGrid
.dbgShowTraceLog
:= true;
1387 pan
:= g_Map_traceToNearest(pmsCurMapX
, pmsCurMapY
, dx
, dy
, (GridTagWall
or GridTagDoor
or GridTagStep
or GridTagAcid1
or GridTagAcid2
or GridTagWater
), @ex
, @ey
);
1388 {$IF DEFINED(D2F_DEBUG)}
1389 //mapGrid.dbgRayTraceTileHitCB := nil;
1390 mapGrid
.dbgShowTraceLog
:= false;
1392 e_LogWritefln('v-trace: (%d,%d)-(%d,%d); end=(%d,%d); hit=%d', [pmsCurMapX
, pmsCurMapY
, dx
, dy
, ex
, ey
, (pan
<> nil)]);
1400 // ////////////////////////////////////////////////////////////////////////// //
1401 procedure g_Holmes_OnEvent (var ev
: TFUIEvent
);
1402 {$IF not DEFINED(HEADLESS)}
1404 doeat
: Boolean = false;
1407 {$IF not DEFINED(HEADLESS)}
1408 if g_Game_IsNet
then exit
;
1409 if not g_holmes_enabled
then exit
;
1410 if g_holmes_imfunctional
then exit
;
1412 holmesInitCommands();
1421 SDL_SCANCODE_LCTRL
, SDL_SCANCODE_RCTRL
,
1422 SDL_SCANCODE_LALT
, SDL_SCANCODE_RALT
,
1423 SDL_SCANCODE_LSHIFT
, SDL_SCANCODE_RSHIFT
:
1427 else if (ev
.mouse
) then
1436 uiDispatchEvent(ev
);
1437 if (not ev
.alive
) then exit
;
1441 if (gPlayer1
<> nil) and (vpSet
) then msbindExecute(ev
);
1446 if keybindExecute(ev
) then ev
.eat();
1447 if (ev
.alive
) then onKeyEvent(ev
);
1450 if (doeat
) then ev
.eat();
1455 // ////////////////////////////////////////////////////////////////////////// //
1456 procedure g_Holmes_Draw ();
1458 if g_Game_IsNet
then exit
;
1459 if not g_holmes_enabled
then exit
;
1460 if g_holmes_imfunctional
then exit
;
1462 {$IF not DEFINED(HEADLESS)}
1463 holmesInitCommands();
1466 glColorMask(GL_TRUE
, GL_TRUE
, GL_TRUE
, GL_TRUE
); // modify color buffer
1467 glDisable(GL_STENCIL_TEST
);
1468 glDisable(GL_BLEND
);
1469 glDisable(GL_SCISSOR_TEST
);
1470 glDisable(GL_TEXTURE_2D
);
1472 if gGameOn
then plrDebugDraw();
1479 procedure g_Holmes_DrawUI ();
1481 if g_Game_IsNet
then exit
;
1482 if not g_holmes_enabled
then exit
;
1483 if g_holmes_imfunctional
then exit
;
1485 {$IF not DEFINED(HEADLESS)}
1486 gGfxDoClear
:= false;
1487 //if assigned(prerenderFrameCB) then prerenderFrameCB();
1489 glMatrixMode(GL_MODELVIEW
);
1493 if assigned(postrenderFrameCB
) then postrenderFrameCB();
1501 // ////////////////////////////////////////////////////////////////////////// //
1502 procedure bcOneMonsterThinkStep (); begin gmon_debug_think
:= false; gmon_debug_one_think_step
:= true; end;
1503 procedure bcOneMPlatThinkStep (); begin g_dbgpan_mplat_active
:= false; g_dbgpan_mplat_step
:= true; end;
1504 procedure bcMPlatToggle (); begin g_dbgpan_mplat_active
:= not g_dbgpan_mplat_active
; end;
1506 procedure bcToggleMonsterInfo (arg
: Integer=-1); begin if (arg
< 0) then showMonsInfo
:= not showMonsInfo
else showMonsInfo
:= (arg
> 0); end;
1507 procedure bcToggleMonsterLOSPlr (arg
: Integer=-1); begin if (arg
< 0) then showMonsLOS2Plr
:= not showMonsLOS2Plr
else showMonsLOS2Plr
:= (arg
> 0); end;
1508 procedure bcToggleMonsterCells (arg
: Integer=-1); begin if (arg
< 0) then showAllMonsCells
:= not showAllMonsCells
else showAllMonsCells
:= (arg
> 0); end;
1509 procedure bcToggleDrawTriggers (arg
: Integer=-1); begin if (arg
< 0) then showTriggers
:= not showTriggers
else showTriggers
:= (arg
> 0); end;
1511 procedure bcToggleCurPos (arg
: Integer=-1); begin if (arg
< 0) then showMapCurPos
:= not showMapCurPos
else showMapCurPos
:= (arg
> 0); end;
1512 procedure bcToggleGrid (arg
: Integer=-1); begin if (arg
< 0) then showGrid
:= not showGrid
else showGrid
:= (arg
> 0); end;
1514 procedure bcMonsterSpawn (s
: AnsiString);
1518 if not gGameOn
or g_Game_IsClient
then
1520 conwriteln('cannot spawn monster in this mode');
1523 mon
:= g_Mons_SpawnAt(s
, pmsCurMapX
, pmsCurMapY
);
1524 if (mon
= nil) then begin conwritefln('unknown monster id: ''%s''', [s
]); exit
; end;
1525 monMarkedUID
:= mon
.UID
;
1528 procedure bcMonsterWakeup ();
1532 if (monMarkedUID
<> -1) then
1534 mon
:= g_Monsters_ByUID(monMarkedUID
);
1535 if (mon
<> nil) then mon
.WakeUp();
1539 procedure bcPlayerTeleport ();
1541 x
, y
, w
, h
: Integer;
1543 //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY);
1544 if (gPlayers
[0] <> nil) then
1546 gPlayers
[0].getMapBox(x
, y
, w
, h
);
1547 gPlayers
[0].TeleportTo(pmsCurMapX
-w
div 2, pmsCurMapY
-h
div 2, true, 69); // 69: don't change dir
1551 procedure dbgToggleTraceBox (arg
: Integer=-1); begin if (arg
< 0) then showTraceBox
:= not showTraceBox
else showTraceBox
:= (arg
> 0); end;
1553 procedure dbgToggleHolmesPause (arg
: Integer=-1); begin if (arg
< 0) then g_Game_HolmesPause(not gPauseHolmes
) else g_Game_HolmesPause(arg
> 0); end;
1555 procedure cbAtcurSelectMonster ();
1556 function monsAtDump (mon
: TMonster
{; tag: Integer}): Boolean;
1558 result
:= true; // stop
1559 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon
.arrIdx
, mon
.UID
, mon
.proxyId
]), TMsgType
.Notify
);
1560 monMarkedUID
:= mon
.UID
;
1561 dumpPublishedProperties(mon
);
1565 x
, y
, w
, h
: Integer;
1567 it
: TMonsterGrid
.Iter
;
1570 if (Length(gPlayers
) > 0) then
1573 if (plr
<> nil) then
1575 plr
.getMapBox(x
, y
, w
, h
);
1576 if (pmsCurMapX
>= x
) and (pmsCurMapY
>= y
) and (pmsCurMapX
< x
+w
) and (pmsCurMapY
< y
+h
) then
1578 dumpPublishedProperties(plr
);
1582 //e_WriteLog('===========================', MSG_NOTIFY);
1583 it
:= monsGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
);
1584 for mit
in it
do monsAtDump(mit
^);
1586 //e_WriteLog('---------------------------', MSG_NOTIFY);
1589 procedure cbAtcurDumpMonsters ();
1590 function monsAtDump (mon
: TMonster
{; tag: Integer}): Boolean;
1592 result
:= false; // don't stop
1593 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon
.arrIdx
, mon
.UID
, mon
.proxyId
]), TMsgType
.Notify
);
1597 it
: TMonsterGrid
.Iter
;
1599 it
:= monsGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
);
1600 if (it
.length
> 0) then
1602 e_WriteLog('===========================', TMsgType
.Notify
);
1603 for mit
in it
do monsAtDump(mit
^);
1604 e_WriteLog('---------------------------', TMsgType
.Notify
);
1609 procedure cbAtcurDumpWalls ();
1610 function wallToggle (pan
: TPanel
{; tag: Integer}): Boolean;
1612 result
:= false; // don't stop
1613 if (platMarkedGUID
= -1) then platMarkedGUID
:= pan
.guid
;
1614 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
]);
1615 dumpPublishedProperties(pan
);
1618 hasTrigs
: Boolean = false;
1622 it
: TPanelGrid
.Iter
;
1624 platMarkedGUID
:= -1;
1625 it
:= mapGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, (GridTagWall
or GridTagDoor
));
1626 if (it
.length
> 0) then
1628 e_WriteLog('=== TOGGLE WALL ===', TMsgType
.Notify
);
1629 for mwit
in it
do wallToggle(mwit
^);
1630 e_WriteLog('--- toggle wall ---', TMsgType
.Notify
);
1633 if showTriggers
then
1635 for f
:= 0 to High(gTriggers
) do
1637 trig
:= @gTriggers
[f
];
1638 if (pmsCurMapX
>= trig
.x
) and (pmsCurMapY
>= trig
.y
) and (pmsCurMapX
< trig
.x
+trig
.width
) and (pmsCurMapY
< trig
.y
+trig
.height
) then
1640 if not hasTrigs
then begin writeln('=== TRIGGERS ==='); hasTrigs
:= true; end;
1641 writeln('trigger ''', trig
.mapId
, ''' of type ''', trigType2Str(trig
.TriggerType
), '''');
1644 if hasTrigs
then writeln('--- triggers ---');
1648 procedure cbAtcurToggleWalls ();
1649 function wallToggle (pan
: TPanel
{; tag: Integer}): Boolean;
1651 result
:= false; // don't stop
1652 //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);
1653 if pan
.Enabled
then g_Map_DisableWallGUID(pan
.guid
) else g_Map_EnableWallGUID(pan
.guid
);
1657 it
: TPanelGrid
.Iter
;
1659 //e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
1660 //e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
1661 it
:= mapGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, (GridTagWall
or GridTagDoor
));
1662 for mwit
in it
do wallToggle(mwit
^);
1667 // ////////////////////////////////////////////////////////////////////////// //
1668 procedure holmesInitCommands ();
1670 if (cmdlist
<> nil) then exit
;
1671 cmdAdd('win_layers', toggleLayersWindow
, 'toggle layers window', 'window control');
1672 cmdAdd('win_outline', toggleOutlineWindow
, 'toggle outline window', 'window control');
1673 cmdAdd('win_help', toggleHelpWindow
, 'toggle help window', 'window control');
1674 cmdAdd('win_options', toggleOptionsWindow
, 'toggle options window', 'window control');
1676 cmdAdd('mon_think_step', bcOneMonsterThinkStep
, 'one monster think step', 'monster control');
1677 cmdAdd('mon_info', bcToggleMonsterInfo
, 'toggle monster info', 'monster control');
1678 cmdAdd('mon_los_plr', bcToggleMonsterLOSPlr
, 'toggle monster LOS to player', 'monster control');
1679 cmdAdd('mon_cells', bcToggleMonsterCells
, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control');
1680 cmdAdd('mon_wakeup', bcMonsterWakeup
, 'wake up selected monster', 'monster control');
1682 cmdAdd('mon_spawn', bcMonsterSpawn
, 'spawn monster', 'monster control');
1684 cmdAdd('mplat_step', bcOneMPlatThinkStep
, 'one mplat think step', 'mplat control');
1685 cmdAdd('mplat_toggle', bcMPlatToggle
, 'activate/deactivate moving platforms', 'mplat control');
1687 cmdAdd('plr_teleport', bcPlayerTeleport
, 'teleport player', 'player control');
1689 cmdAdd('dbg_curpos', bcToggleCurPos
, 'toggle "show cursor position on the map"', 'various');
1690 cmdAdd('dbg_grid', bcToggleGrid
, 'toggle grid', 'various');
1691 cmdAdd('dbg_triggers', bcToggleDrawTriggers
, 'show/hide triggers (SLOW!)', 'various');
1693 cmdAdd('atcur_select_monster', cbAtcurSelectMonster
, 'select monster to operate', 'monster control');
1694 cmdAdd('atcur_dump_monsters', cbAtcurDumpMonsters
, 'dump monsters in cell', 'monster control');
1695 cmdAdd('atcur_dump_walls', cbAtcurDumpWalls
, 'dump walls in cell', 'wall control');
1696 cmdAdd('atcur_disable_walls', cbAtcurToggleWalls
, 'disable walls', 'wall control');
1698 cmdAdd('dbg_tracebox', dbgToggleTraceBox
, 'test traceBox()', 'player control');
1700 cmdAdd('hlm_pause', dbgToggleHolmesPause
, '"Holmes" pause mode', 'game control');
1704 procedure holmesInitBinds ();
1707 pr
: TTextParser
= nil;
1708 s
, kn
, v
: AnsiString;
1713 if not keybindsInited
then
1716 keybindAdd('F1', 'win_help');
1717 keybindAdd('M-F1', 'win_options');
1718 keybindAdd('C-O', 'win_outline');
1719 keybindAdd('C-L', 'win_layers');
1721 keybindAdd('M-M', 'mon_think_step');
1722 keybindAdd('M-I', 'mon_info');
1723 keybindAdd('M-L', 'mon_los_plr');
1724 keybindAdd('M-G', 'mon_cells');
1725 keybindAdd('M-A', 'mon_wakeup');
1727 keybindAdd('M-P', 'mplat_step');
1728 keybindAdd('M-O', 'mplat_toggle');
1730 keybindAdd('C-T', 'plr_teleport');
1731 keybindAdd('M-T', 'dbg_tracebox');
1733 keybindAdd('C-P', 'dbg_curpos');
1734 keybindAdd('C-G', 'dbg_grid');
1735 keybindAdd('C-X', 'dbg_triggers');
1737 keybindAdd('C-1', 'mon_spawn zombie');
1739 keybindAdd('C-S-P', 'hlm_pause');
1742 msbindAdd('LMB', 'atcur_select_monster');
1743 msbindAdd('M-LMB', 'atcur_dump_monsters');
1744 msbindAdd('RMB', 'atcur_dump_walls');
1745 msbindAdd('M-RMB', 'atcur_disable_walls');
1747 // load bindings from file
1749 st
:= e_OpenResourceRO(ConfigDirs
, 'holmes.rc');
1750 pr
:= TFileTextParser
.Create(st
);
1751 conwriteln('parsing "holmes.rc"...');
1752 while (pr
.tokType
<> pr
.TTEOF
) do
1755 if (s
= 'stop') then break
1756 else if (s
= 'unbind_keys') then keybinds
:= nil
1757 else if (s
= 'unbind_mouse') then msbinds
:= nil
1758 else if (s
= 'bind') then
1760 if (pr
.tokType
= pr
.TTStr
) then s
:= pr
.expectStr(false)
1761 else if (pr
.tokType
= pr
.TTInt
) then s
:= Format('%d', [pr
.expectInt()])
1762 else s
:= pr
.expectId();
1764 if (pr
.tokType
= pr
.TTStr
) then v
:= pr
.expectStr(false)
1765 else if (pr
.tokType
= pr
.TTInt
) then v
:= Format('%d', [pr
.expectInt()])
1766 else v
:= pr
.expectId();
1768 kn
:= parseModKeys(s
, kmods
, mbuts
);
1769 if (CompareText(kn
, 'lmb') = 0) or (CompareText(kn
, 'rmb') = 0) or (CompareText(kn
, 'mmb') = 0) or (CompareText(kn
, 'None') = 0) then
1779 except on e
: Exception
do // sorry
1780 if (pr
<> nil) then conwritefln('Holmes config parse error at (%s,%s): %s', [pr
.tokLine
, pr
.tokCol
, e
.message]);
1782 if (pr
<> nil) then pr
.Free() else st
.Free(); // ownership
1792 fuiEventCB
:= g_Holmes_OnEvent
;
1793 //uiContext.font := 'win14';
1795 conRegVar('hlm_ui_scale', @fuiRenderScale
, 0.01, 5.0, 'Holmes UI scale', '', false);