e64c20508a3411567a8571300da18f0605b2f677
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}
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
,
33 // both for but and for bstate
46 kind
: Byte; // motion, press, release
48 dx
, dy
: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion
49 but
: Word; // current pressed/released button, or 0 for motion
50 bstate
: Word; // button state
51 kstate
: Word; // keyboard state (see THKeyEvent);
68 scan
: Word; // SDL_SCANCODE_XXX
69 sym
: Word; // SDLK_XXX
70 bstate
: Word; // button state
71 kstate
: Word; // keyboard state
76 procedure g_Holmes_VidModeChanged ();
77 procedure g_Holmes_WindowFocused ();
78 procedure g_Holmes_WindowBlured ();
80 procedure g_Holmes_Draw ();
81 procedure g_Holmes_DrawUI ();
83 function g_Holmes_MouseEvent (var ev
: THMouseEvent
): Boolean; // returns `true` if event was eaten
84 function g_Holmes_KeyEvent (var ev
: THKeyEvent
): Boolean; // returns `true` if event was eaten
87 procedure g_Holmes_plrViewPos (viewPortX
, viewPortY
: Integer);
88 procedure g_Holmes_plrViewSize (viewPortW
, viewPortH
: Integer);
89 procedure g_Holmes_plrLaser (ax0
, ay0
, ax1
, ay1
: Integer);
92 operator
= (constref ev
: THKeyEvent
; const s
: AnsiString): Boolean;
93 operator
= (const s
: AnsiString; constref ev
: THKeyEvent
): Boolean;
95 operator
= (constref ev
: THMouseEvent
; const s
: AnsiString): Boolean;
96 operator
= (const s
: AnsiString; constref ev
: THMouseEvent
): Boolean;
100 g_holmes_enabled
: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}false{$ENDIF};
101 g_holmes_ui_scale
: Single = 1.0;
107 {rttiobj,} typinfo
, e_texture
,
108 SysUtils
, Classes
, GL
, SDL2
,
109 MAPDEF
, g_main
, g_options
,
110 utils
, hashtable
, xparser
;
114 //globalInited: Boolean = false;
117 msB
: Word = 0; // button state
118 kbS
: Word = 0; // keyboard modifiers state
119 showGrid
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
120 showMonsInfo
: Boolean = false;
121 showMonsLOS2Plr
: Boolean = false;
122 showAllMonsCells
: Boolean = false;
123 showMapCurPos
: Boolean = false;
124 showLayersWindow
: Boolean = false;
125 showOutlineWindow
: Boolean = false;
126 showTriggers
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
127 showTraceBox
: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
130 // ////////////////////////////////////////////////////////////////////////// //
131 {$INCLUDE g_holmes.inc}
132 {$INCLUDE g_holmes_ui.inc}
133 {$INCLUDE g_holmes_ol.inc} // outliner
136 // ////////////////////////////////////////////////////////////////////////// //
137 // any mods = 255: nothing was defined
138 function parseModKeys (const s
: AnsiString; out kmods
: Byte; out mbuts
: Byte): AnsiString;
145 //while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos);
146 if (pos
< Length(s
)) and ((s
[pos
] = '+') or (s
[pos
] = '-') or (s
[pos
] = '*')) then Inc(pos
);
147 while (pos
< Length(s
)) do
149 if (Length(s
)-pos
>= 2) and (s
[pos
+1] = '-') then
152 'C', 'c': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModCtrl
; Inc(pos
, 2); continue
; end;
153 'M', 'm': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModAlt
; Inc(pos
, 2); continue
; end;
154 'S', 's': begin if (kmods
= 255) then kmods
:= 0; kmods
:= kmods
or THKeyEvent
.ModShift
; Inc(pos
, 2); continue
; end;
158 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
161 'L', 'l': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Left
; Inc(pos
, 4); continue
; end;
162 'R', 'r': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Right
; Inc(pos
, 4); continue
; end;
163 'M', 'm': begin if (mbuts
= 255) then mbuts
:= 0; mbuts
:= mbuts
or THMouseEvent
.Middle
; Inc(pos
, 4); continue
; end;
170 while (epos
> pos
) and (s
[epos
-1] <= ' ') do Dec(epos
);
171 if (epos
> pos
) then result
:= Copy(s
, pos
, epos
-pos
) else result
:= '';
175 operator
= (constref ev
: THKeyEvent
; const s
: AnsiString): Boolean;
183 if (Length(s
) > 0) then
185 if (s
[1] = '+') then begin if (ev
.kind
<> ev
.Press
) then exit
; end
186 else if (s
[1] = '-') then begin if (ev
.kind
<> ev
.Release
) then exit
; end
187 else if (s
[1] = '*') then begin end
188 else if (ev
.kind
<> ev
.Press
) then exit
;
190 kname
:= parseModKeys(s
, kmods
, mbuts
);
191 if (kmods
= 255) then kmods
:= 0;
192 if (ev
.kstate
<> kmods
) then exit
;
193 if (mbuts
<> 255) and (ev
.bstate
<> mbuts
) then exit
;
194 for f
:= 1 to High(e_KeyNames
) do
196 if (CompareText(kname
, e_KeyNames
[f
]) = 0) then
198 result
:= (ev
.scan
= f
);
205 operator
= (const s
: AnsiString; constref ev
: THKeyEvent
): Boolean;
211 operator
= (constref ev
: THMouseEvent
; const s
: AnsiString): Boolean;
220 if (Length(s
) > 0) then
222 if (s
[1] = '+') then begin if (ev
.kind
<> ev
.Press
) then exit
; end
223 else if (s
[1] = '-') then begin if (ev
.kind
<> ev
.Release
) then exit
; end
224 else if (s
[1] = '*') then begin if (ev
.kind
<> ev
.Motion
) then exit
; end
225 else if (ev
.kind
<> ev
.Press
) then exit
;
228 kname
:= parseModKeys(s
, kmods
, mbuts
);
229 if (CompareText(kname
, 'LMB') = 0) then but
:= THMouseEvent
.Left
230 else if (CompareText(kname
, 'RMB') = 0) then but
:= THMouseEvent
.Right
231 else if (CompareText(kname
, 'MMB') = 0) then but
:= THMouseEvent
.Middle
232 else if (CompareText(kname
, 'None') = 0) then but
:= 0
235 //conwritefln('s=[%s]; kname=[%s]; kmods=%s; mbuts=%s; but=%s', [s, kname, kmods, mbuts, but]);
237 if (mbuts
= 255) then mbuts
:= 0;
238 if (kmods
= 255) then kmods
:= 0;
239 if (ev
.kstate
<> kmods
) then exit
;
241 if (ev
.kind
= ev
.Press
) then mbuts
:= mbuts
or but
242 else if (ev
.kind
= ev
.Release
) then mbuts
:= mbuts
and (not but
);
244 //conwritefln(' ev.bstate=%s; ev.but=%s; mbuts=%s', [ev.bstate, ev.but, mbuts]);
246 result
:= (ev
.bstate
= mbuts
) and (ev
.but
= but
);
250 operator
= (const s
: AnsiString; constref ev
: THMouseEvent
): Boolean;
256 // ////////////////////////////////////////////////////////////////////////// //
257 function typeKind2Str (t
: TTypeKind
): AnsiString;
260 tkUnknown
: result
:= 'Unknown';
261 tkInteger
: result
:= 'Integer';
262 tkChar
: result
:= 'Char';
263 tkEnumeration
: result
:= 'Enumeration';
264 tkFloat
: result
:= 'Float';
265 tkSet
: result
:= 'Set';
266 tkMethod
: result
:= 'Method';
267 tkSString
: result
:= 'SString';
268 tkLString
: result
:= 'LString';
269 tkAString
: result
:= 'AString';
270 tkWString
: result
:= 'WString';
271 tkVariant
: result
:= 'Variant';
272 tkArray
: result
:= 'Array';
273 tkRecord
: result
:= 'Record';
274 tkInterface
: result
:= 'Interface';
275 tkClass
: result
:= 'Class';
276 tkObject
: result
:= 'Object';
277 tkWChar
: result
:= 'WChar';
278 tkBool
: result
:= 'Bool';
279 tkInt64
: result
:= 'Int64';
280 tkQWord
: result
:= 'QWord';
281 tkDynArray
: result
:= 'DynArray';
282 tkInterfaceRaw
: result
:= 'InterfaceRaw';
283 tkProcVar
: result
:= 'ProcVar';
284 tkUString
: result
:= 'UString';
285 tkUChar
: result
:= 'UChar';
286 tkHelper
: result
:= 'Helper';
287 tkFile
: result
:= 'File';
288 tkClassRef
: result
:= 'ClassRef';
289 tkPointer
: result
:= 'Pointer';
290 else result
:= '<unknown>';
295 procedure dumpPublishedProperties (obj
: TObject
);
302 if (obj
= nil) then exit
;
303 e_LogWritefln('Object of type ''%s'':', [obj
.ClassName
]);
305 pt
:= GetTypeData(pi
);
306 e_LogWritefln('property count: %s', [pt
.PropCount
]);
307 GetMem(pp
, pt
^.PropCount
*sizeof(Pointer));
309 j
:= GetPropList(pi
, [tkInteger
, tkBool
, tkSString
, tkLString
, tkAString
, tkSet
, tkEnumeration
], pp
);
310 //e_LogWritefln('ordinal property count: %s', [j]);
313 if (typinfo
.PropType(obj
, pp
^[i
].name
) in [tkSString
, tkLString
, tkAString
]) then
315 e_LogWritefln(' #%s: <%s>; type: %s; value: <%s>', [i
+1, pp
^[i
].name
, typeKind2Str(typinfo
.PropType(obj
, pp
^[i
].name
)), GetStrProp(obj
, pp
^[i
])]);
317 else if (typinfo
.PropType(obj
, pp
^[i
].name
) = tkSet
) then
319 e_LogWritefln(' #%s: <%s>; type: %s; value: %s', [i
+1, pp
^[i
].name
, typeKind2Str(typinfo
.PropType(obj
, pp
^[i
].name
)), GetSetProp(obj
, pp
^[i
], true)]);
321 else if (typinfo
.PropType(obj
, pp
^[i
].name
) = tkEnumeration
) then
323 e_LogWritefln(' #%s: <%s>; type: %s; value: <%s>', [i
+1, pp
^[i
].name
, typeKind2Str(typinfo
.PropType(obj
, pp
^[i
].name
)), GetEnumProp(obj
, pp
^[i
])]);
327 e_LogWritefln(' #%s: <%s>; type: %s; value: %s', [i
+1, pp
^[i
].name
, typeKind2Str(typinfo
.PropType(obj
, pp
^[i
].name
)), GetOrdProp(obj
, pp
^[i
])]);
336 //FIXME: autogenerate
337 function trigType2Str (ttype
: Integer): AnsiString;
339 result
:= '<unknown>';
341 TRIGGER_NONE
: result
:= 'none';
342 TRIGGER_EXIT
: result
:= 'exit';
343 TRIGGER_TELEPORT
: result
:= 'teleport';
344 TRIGGER_OPENDOOR
: result
:= 'opendoor';
345 TRIGGER_CLOSEDOOR
: result
:= 'closedoor';
346 TRIGGER_DOOR
: result
:= 'door';
347 TRIGGER_DOOR5
: result
:= 'door5';
348 TRIGGER_CLOSETRAP
: result
:= 'closetrap';
349 TRIGGER_TRAP
: result
:= 'trap';
350 TRIGGER_PRESS
: result
:= 'press';
351 TRIGGER_SECRET
: result
:= 'secret';
352 TRIGGER_LIFTUP
: result
:= 'liftup';
353 TRIGGER_LIFTDOWN
: result
:= 'liftdown';
354 TRIGGER_LIFT
: result
:= 'lift';
355 TRIGGER_TEXTURE
: result
:= 'texture';
356 TRIGGER_ON
: result
:= 'on';
357 TRIGGER_OFF
: result
:= 'off';
358 TRIGGER_ONOFF
: result
:= 'onoff';
359 TRIGGER_SOUND
: result
:= 'sound';
360 TRIGGER_SPAWNMONSTER
: result
:= 'spawnmonster';
361 TRIGGER_SPAWNITEM
: result
:= 'spawnitem';
362 TRIGGER_MUSIC
: result
:= 'music';
363 TRIGGER_PUSH
: result
:= 'push';
364 TRIGGER_SCORE
: result
:= 'score';
365 TRIGGER_MESSAGE
: result
:= 'message';
366 TRIGGER_DAMAGE
: result
:= 'damage';
367 TRIGGER_HEALTH
: result
:= 'health';
368 TRIGGER_SHOT
: result
:= 'shot';
369 TRIGGER_EFFECT
: result
:= 'effect';
370 TRIGGER_SCRIPT
: result
:= 'script';
374 // ////////////////////////////////////////////////////////////////////////// //
375 {$INCLUDE g_holmes_cmd.inc}
376 procedure holmesInitCommands (); forward;
377 procedure holmesInitBinds (); forward;
380 // ////////////////////////////////////////////////////////////////////////// //
382 g_ol_nice
: Boolean = false;
383 g_ol_fill_walls
: Boolean = false;
384 g_ol_rlayer_back
: Boolean = false;
385 g_ol_rlayer_step
: Boolean = false;
386 g_ol_rlayer_wall
: Boolean = false;
387 g_ol_rlayer_door
: Boolean = false;
388 g_ol_rlayer_acid1
: Boolean = false;
389 g_ol_rlayer_acid2
: Boolean = false;
390 g_ol_rlayer_water
: Boolean = false;
391 g_ol_rlayer_fore
: Boolean = false;
394 // ////////////////////////////////////////////////////////////////////////// //
396 winHelp
: THTopWindow
= nil;
397 winOptions
: THTopWindow
= nil;
398 winLayers
: THTopWindow
= nil;
399 winOutlines
: THTopWindow
= nil;
402 procedure createHelpWindow (); forward;
403 procedure createOptionsWindow (); forward;
404 procedure createLayersWindow (); forward;
405 procedure createOutlinesWindow (); forward;
408 procedure toggleLayersWindowCB (me
: THControl
; checked
: Integer);
410 if showLayersWindow
then
412 if (winLayers
= nil) then createLayersWindow();
413 uiAddWindow(winLayers
);
417 uiRemoveWindow(winLayers
);
422 procedure toggleOutlineWindowCB (me
: THControl
; checked
: Integer);
424 if showOutlineWindow
then
426 if (winOutlines
= nil) then createOutlinesWindow();
427 uiAddWindow(winOutlines
);
431 uiRemoveWindow(winOutlines
);
436 procedure createHelpWindow ();
438 llb
: THCtlSimpleText
;
439 slist
: array of AnsiString = nil;
441 bind
: THolmesBinding
;
442 f
, maxkeylen
: Integer;
445 for cmd
in cmdlist
do cmd
.helpmark
:= false;
448 for bind
in keybinds
do
450 if (Length(bind
.key
) = 0) then continue
;
451 if cmdlist
.get(bind
.cmdName
, cmd
) then
453 if (Length(cmd
.help
) > 0) then
455 cmd
.helpmark
:= true;
456 if (maxkeylen
< Length(bind
.key
)) then maxkeylen
:= Length(bind
.key
);
461 for cmd
in cmdlist
do
463 if not cmd
.helpmark
then continue
;
464 if (Length(cmd
.help
) = 0) then continue
;
466 while (f
< Length(slist
)) and (CompareText(slist
[f
], cmd
.section
) <> 0) do Inc(f
);
467 if (f
= Length(slist
)) then
469 SetLength(slist
, Length(slist
)+1);
470 slist
[High(slist
)] := cmd
.section
;
474 llb
:= THCtlSimpleText
.Create(0, 0);
475 for f
:= 0 to High(slist
) do
477 if (f
> 0) then llb
.appendItem('');
478 llb
.appendItem(slist
[f
], true, true);
479 for cmd
in cmdlist
do
481 if not cmd
.helpmark
then continue
;
482 if (CompareText(cmd
.section
, slist
[f
]) <> 0) then continue
;
483 for bind
in keybinds
do
485 if (Length(bind
.key
) = 0) then continue
;
486 if (cmd
.name
= bind
.cmdName
) then
489 while (Length(s
) < maxkeylen
) do s
+= ' ';
490 s
:= ' '+s
+' -- '+cmd
.help
;
498 for bind
in msbinds
do
500 if (Length(bind
.key
) = 0) then continue
;
501 if cmdlist
.get(bind
.cmdName
, cmd
) then
503 if (Length(cmd
.help
) > 0) then
505 cmd
.helpmark
:= true;
506 if (maxkeylen
< Length(bind
.key
)) then maxkeylen
:= Length(bind
.key
);
512 llb
.appendItem('mouse', true, true);
513 for bind
in msbinds
do
515 if (Length(bind
.key
) = 0) then continue
;
516 if cmdlist
.get(bind
.cmdName
, cmd
) then
518 if (Length(cmd
.help
) > 0) then
521 while (Length(s
) < maxkeylen
) do s
+= ' ';
522 s
:= ' '+s
+' -- '+cmd
.help
;
528 winHelp
:= THTopWindow
.Create('Holmes Help', 10, 10);
529 winHelp
.escClose
:= true;
530 winHelp
.appendChild(llb
);
531 winHelp
.centerInScreen();
535 procedure winLayersClosed (me
: THControl
; dummy
: Integer); begin showLayersWindow
:= false; end;
536 procedure winOutlinesClosed (me
: THControl
; dummy
: Integer); begin showOutlineWindow
:= false; end;
538 procedure createLayersWindow ();
542 llb
:= THCtlCBListBox
.Create(0, 0);
543 llb
.appendItem('background', @g_rlayer_back
);
544 llb
.appendItem('steps', @g_rlayer_step
);
545 llb
.appendItem('walls', @g_rlayer_wall
);
546 llb
.appendItem('doors', @g_rlayer_door
);
547 llb
.appendItem('acid1', @g_rlayer_acid1
);
548 llb
.appendItem('acid2', @g_rlayer_acid2
);
549 llb
.appendItem('water', @g_rlayer_water
);
550 llb
.appendItem('foreground', @g_rlayer_fore
);
551 winLayers
:= THTopWindow
.Create('layers', 10, 10);
552 winLayers
.escClose
:= true;
553 winLayers
.appendChild(llb
);
554 winLayers
.closeCB
:= winLayersClosed
;
558 procedure createOutlinesWindow ();
562 llb
:= THCtlCBListBox
.Create(0, 0);
563 llb
.appendItem('background', @g_ol_rlayer_back
);
564 llb
.appendItem('steps', @g_ol_rlayer_step
);
565 llb
.appendItem('walls', @g_ol_rlayer_wall
);
566 llb
.appendItem('doors', @g_ol_rlayer_door
);
567 llb
.appendItem('acid1', @g_ol_rlayer_acid1
);
568 llb
.appendItem('acid2', @g_ol_rlayer_acid2
);
569 llb
.appendItem('water', @g_ol_rlayer_water
);
570 llb
.appendItem('foreground', @g_ol_rlayer_fore
);
571 llb
.appendItem('OPTIONS', nil);
572 llb
.appendItem('fill walls', @g_ol_fill_walls
);
573 llb
.appendItem('contours', @g_ol_nice
);
574 winOutlines
:= THTopWindow
.Create('outlines', 100, 10);
575 winOutlines
.escClose
:= true;
576 winOutlines
.appendChild(llb
);
577 winOutlines
.closeCB
:= winOutlinesClosed
;
581 procedure createOptionsWindow ();
585 llb
:= THCtlCBListBox
.Create(0, 0);
586 llb
.appendItem('map grid', @showGrid
);
587 llb
.appendItem('cursor position on map', @showMapCurPos
);
588 llb
.appendItem('monster info', @showMonsInfo
);
589 llb
.appendItem('monster LOS to player', @showMonsLOS2Plr
);
590 llb
.appendItem('monster cells (SLOW!)', @showAllMonsCells
);
591 llb
.appendItem('draw triggers (SLOW!)', @showTriggers
);
592 llb
.appendItem('WINDOWS', nil);
593 llb
.appendItem('layers window', @showLayersWindow
, toggleLayersWindowCB
);
594 llb
.appendItem('outline window', @showOutlineWindow
, toggleOutlineWindowCB
);
595 winOptions
:= THTopWindow
.Create('Holmes Options', 100, 100);
596 winOptions
.escClose
:= true;
597 winOptions
.appendChild(llb
);
598 winOptions
.centerInScreen();
602 procedure toggleLayersWindow (arg
: Integer=-1);
604 showLayersWindow
:= not showLayersWindow
;
605 toggleLayersWindowCB(nil, 0);
608 procedure toggleOutlineWindow (arg
: Integer=-1);
610 showOutlineWindow
:= not showOutlineWindow
;
611 toggleOutlineWindowCB(nil, 0);
614 procedure toggleHelpWindow (arg
: Integer=-1);
616 if (winHelp
= nil) then createHelpWindow();
617 if not uiVisibleWindow(winHelp
) then uiAddWindow(winHelp
) else uiRemoveWindow(winHelp
);
620 procedure toggleOptionsWindow (arg
: Integer=-1);
622 if (winOptions
= nil) then createOptionsWindow();
623 if not uiVisibleWindow(winOptions
) then uiAddWindow(winOptions
) else uiRemoveWindow(winOptions
);
627 // ////////////////////////////////////////////////////////////////////////// //
628 procedure g_Holmes_VidModeChanged ();
630 e_WriteLog(Format('Holmes: videomode changed: %dx%d', [gScreenWidth
, gScreenHeight
]), TMsgType
.Notify
);
631 // texture space is possibly lost here, idc
637 //createCursorTexture();
640 procedure g_Holmes_WindowFocused ();
646 procedure g_Holmes_WindowBlured ();
651 // ////////////////////////////////////////////////////////////////////////// //
653 vpSet
: Boolean = false;
656 laserSet
: Boolean = false;
657 laserX0
, laserY0
, laserX1
, laserY1
: Integer;
658 monMarkedUID
: Integer = -1;
659 platMarkedGUID
: Integer = -1;
662 procedure g_Holmes_plrViewPos (viewPortX
, viewPortY
: Integer);
669 procedure g_Holmes_plrViewSize (viewPortW
, viewPortH
: Integer);
676 procedure g_Holmes_plrLaser (ax0
, ay0
, ax1
, ay1
: Integer);
683 laserSet
:= laserSet
; // shut up, fpc!
687 function pmsCurMapX (): Integer; inline; begin result
:= round(msX
/g_dbg_scale
)+vpx
; end;
688 function pmsCurMapY (): Integer; inline; begin result
:= round(msY
/g_dbg_scale
)+vpy
; end;
691 procedure plrDebugMouse (var ev
: THMouseEvent
);
693 //e_WriteLog(Format('mouse: x=%d; y=%d; but=%d; bstate=%d', [msx, msy, but, bstate]), MSG_NOTIFY);
694 if (gPlayer1
= nil) or not vpSet
then exit
;
695 //if (ev.kind <> THMouseEvent.Press) then exit;
696 //e_WriteLog(Format('mev: %d', [Integer(ev.kind)]), MSG_NOTIFY);
701 {$IFDEF HOLMES_OLD_OUTLINES}
703 edgeBmp
: array of Byte = nil;
706 procedure drawOutlines ();
710 procedure clearEdgeBmp ();
712 SetLength(edgeBmp
, (gWinSizeX
+4)*(gWinSizeY
+4));
713 FillChar(edgeBmp
[0], Length(edgeBmp
)*sizeof(edgeBmp
[0]), 0);
716 procedure drawPanel (pan
: TPanel
);
718 sx
, len
, y0
, y1
: Integer;
720 if (pan
= nil) or (pan
.Width
< 1) or (pan
.Height
< 1) then exit
;
721 if (pan
.X
+pan
.Width
<= vpx
-1) or (pan
.Y
+pan
.Height
<= vpy
-1) then exit
;
722 if (pan
.X
>= vpx
+vpw
+1) or (pan
.Y
>= vpy
+vph
+1) then exit
;
723 if g_ol_nice
or g_ol_fill_walls
then
727 if (len
> gWinSizeX
+4) then len
:= gWinSizeX
+4;
728 if (sx
< 0) then begin len
+= sx
; sx
:= 0; end;
729 if (sx
+len
> gWinSizeX
+4) then len
:= gWinSizeX
+4-sx
;
730 if (len
< 1) then exit
;
732 assert(sx
+len
<= gWinSizeX
+4);
735 if (y0
< 0) then y0
:= 0;
736 if (y1
> gWinSizeY
+4) then y1
:= gWinSizeY
+4;
739 FillChar(edgeBmp
[y0
*(gWinSizeX
+4)+sx
], len
*sizeof(edgeBmp
[0]), 1);
745 drawRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, r
, g
, b
);
754 procedure flushLine ();
756 if (lsy
> 0) and (lsx
> 0) then
761 glVertex2f(lsx
-1+vpx
+0.37, lsy
-1+vpy
+0.37);
767 glVertex2f(lsx
-1+vpx
+0.37, lsy
-1+vpy
+0.37);
768 glVertex2f(lex
-0+vpx
+0.37, lsy
-1+vpy
+0.37);
776 procedure startLine (y
: Integer);
782 procedure putPixel (x
: Integer);
784 if (x
< 1) then exit
;
785 if (lex
+1 <> x
) then flushLine();
786 if (lsx
< 0) then lsx
:= x
;
790 procedure drawEdges ();
796 glDisable(GL_TEXTURE_2D
);
799 glDisable(GL_LINE_SMOOTH
);
800 glDisable(GL_POLYGON_SMOOTH
);
801 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
804 a
:= @edgeBmp
[y
*(gWinSizeX
+4)+1];
810 if (a
[-1] = 0) or (a
[1] = 0) or (a
[-(gWinSizeX
+4)] = 0) or (a
[gWinSizeX
+4] = 0) or
811 (a
[-(gWinSizeX
+4)-1] = 0) or (a
[-(gWinSizeX
+4)+1] = 0) or
812 (a
[gWinSizeX
+4-1] = 0) or (a
[gWinSizeX
+4+1] = 0) then
823 procedure drawFilledWalls ();
829 glDisable(GL_TEXTURE_2D
);
832 glDisable(GL_LINE_SMOOTH
);
833 glDisable(GL_POLYGON_SMOOTH
);
834 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
837 a
:= @edgeBmp
[y
*(gWinSizeX
+4)+1];
841 if (a
[0] <> 0) then putPixel(x
);
848 procedure doWallsOld (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
856 if g_ol_nice
or g_ol_fill_walls
then clearEdgeBmp();
857 for f
:= 0 to High(parr
) do
860 if (pan
= nil) or not pan
.Enabled
or (pan
.Width
< 1) or (pan
.Height
< 1) then continue
;
861 if ((pan
.PanelType
and ptype
) = 0) then continue
;
864 if g_ol_nice
then drawEdges();
865 if g_ol_fill_walls
then drawFilledWalls();
871 function doWallCB (pan
: TPanel
; tag
: Integer): Boolean;
873 result
:= false; // don't stop
874 //if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then exit;
875 if ((pan
.PanelType
and xptag
) = 0) then exit
;
879 procedure doWalls (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
885 if ((ptype
and (PANEL_WALL
or PANEL_OPENDOOR
or PANEL_CLOSEDOOR
)) <> 0) then ptype
:= GridTagWall
or GridTagDoor
886 else panelTypeToTag(ptype
);
887 if g_ol_nice
or g_ol_fill_walls
then clearEdgeBmp();
888 mapGrid
.forEachInAABB(vpx
-1, vpy
-1, vpw
+2, vph
+2, doWallCB
, ptype
);
889 if g_ol_nice
then drawEdges();
890 if g_ol_fill_walls
then drawFilledWalls();
894 if g_ol_rlayer_back
then doWallsOld(gRenderBackgrounds
, PANEL_BACK
, 255, 127, 0);
895 if g_ol_rlayer_step
then doWallsOld(gSteps
, PANEL_STEP
, 192, 192, 192);
896 if g_ol_rlayer_wall
then doWallsOld(gWalls
, PANEL_WALL
, 255, 255, 255);
897 if g_ol_rlayer_door
then doWallsOld(gWalls
, PANEL_OPENDOOR
or PANEL_CLOSEDOOR
, 0, 255, 0);
898 if g_ol_rlayer_acid1
then doWallsOld(gAcid1
, PANEL_ACID1
, 255, 0, 0);
899 if g_ol_rlayer_acid2
then doWallsOld(gAcid2
, PANEL_ACID2
, 198, 198, 0);
900 if g_ol_rlayer_water
then doWallsOld(gWater
, PANEL_WATER
, 0, 255, 255);
901 if g_ol_rlayer_fore
then doWallsOld(gRenderForegrounds
, PANEL_FORE
, 210, 210, 210);
906 oliner
: TOutliner
= nil;
908 procedure drawOutlines ();
912 procedure clearOliner ();
914 //if (oliner <> nil) and ((oliner.height <> vph+2) or (oliner.width <> vpw+2)) then begin oliner.Free(); oliner := nil; end;
915 if (oliner
= nil) then oliner
:= TOutliner
.Create(vpw
+2, vph
+2) else oliner
.setup(vpw
+2, vph
+2);
918 procedure drawOutline (ol
: TOutliner
; sx
, sy
: Integer);
919 procedure xline (x0
, x1
, y
: Integer);
923 if (g_dbg_scale
< 1.0) then
926 for x
:= x0
to x1
do glVertex2f(sx
+x
+0.375, sy
+y
+0.375);
932 glVertex2f(sx
+x0
+0, sy
+y
+0);
933 glVertex2f(sx
+x1
+1, sy
+y
+0);
934 glVertex2f(sx
+x1
+1, sy
+y
+1);
935 glVertex2f(sx
+x0
+0, sy
+y
+1);
941 sp
: TOutliner
.TSpanX
;
943 if (ol
= nil) then exit
;
945 glDisable(GL_POINT_SMOOTH
);
946 for y
:= 0 to ol
.height
-1 do
948 for sp
in ol
.eachSpanAtY(y
) do
950 if (g_dbg_scale
<= 1.0) then
953 glVertex2f(sx
+sp
.x0
+0.375, sy
+y
+0.375);
954 glVertex2f(sx
+sp
.x1
+0.375, sy
+y
+0.375);
960 glVertex2f(sx
+sp
.x0
+0, sy
+y
+0);
961 glVertex2f(sx
+sp
.x0
+1, sy
+y
+0);
962 glVertex2f(sx
+sp
.x0
+1, sy
+y
+1);
963 glVertex2f(sx
+sp
.x0
+0, sy
+y
+1);
965 glVertex2f(sx
+sp
.x1
+0, sy
+y
+0);
966 glVertex2f(sx
+sp
.x1
+1, sy
+y
+0);
967 glVertex2f(sx
+sp
.x1
+1, sy
+y
+1);
968 glVertex2f(sx
+sp
.x1
+0, sy
+y
+1);
972 for sp
in ol
.eachSpanEdgeAtY(y
, -1) do
974 xline(sp
.x0
, sp
.x1
, y
);
977 glVertex2f(sx+sp.x0+0, sy+y+0);
978 glVertex2f(sx+sp.x1+1, sy+y+0);
979 glVertex2f(sx+sp.x1+1, sy+y+1);
980 glVertex2f(sx+sp.x0+0, sy+y+1);
984 for sp
in ol
.eachSpanEdgeAtY(y
, +1) do
986 xline(sp
.x0
, sp
.x1
, y
);
989 glVertex2f(sx+sp.x0+0, sy+y+0);
990 glVertex2f(sx+sp.x1+1, sy+y+0);
991 glVertex2f(sx+sp.x1+1, sy+y+1);
992 glVertex2f(sx+sp.x0+0, sy+y+1);
999 procedure doWallsOld (parr
: array of TPanel
; ptype
: Word; ar
, ag
, ab
: Integer);
1007 if g_ol_nice
then clearOliner();
1008 for f
:= 0 to High(parr
) do
1011 if (pan
= nil) or not pan
.Enabled
or (pan
.Width
< 1) or (pan
.Height
< 1) then continue
;
1012 if ((pan
.PanelType
and ptype
) = 0) then continue
;
1013 if (pan
.X
> vpx
+vpw
+41) or (pan
.Y
> vpy
+vph
+41) then continue
;
1014 if (pan
.X
+pan
.Width
< vpx
-41) then continue
;
1015 if (pan
.Y
+pan
.Height
< vpy
-41) then continue
;
1018 oliner
.addRect(pan
.X
-(vpx
+1), pan
.Y
-(vpy
+1), pan
.Width
, pan
.Height
);
1020 if g_ol_fill_walls
then
1022 fillRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, r
, g
, b
);
1024 else if not g_ol_nice
then
1026 drawRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, r
, g
, b
);
1031 glColor4f(r
/255.0, g
/255.0, b
/255.0, 1.0);
1032 drawOutline(oliner
, vpx
+1, vpy
+1);
1037 if (vpw
< 2) or (vph
< 2) then exit
;
1038 glScissor(0, gScreenHeight
-gPlayerScreenSize
.Y
, gPlayerScreenSize
.X
, gPlayerScreenSize
.Y
);
1039 glEnable(GL_SCISSOR_TEST
);
1040 if g_ol_rlayer_back
then doWallsOld(gRenderBackgrounds
, PANEL_BACK
, 255, 127, 0);
1041 if g_ol_rlayer_step
then doWallsOld(gSteps
, PANEL_STEP
, 192, 192, 192);
1042 if g_ol_rlayer_wall
then doWallsOld(gWalls
, PANEL_WALL
, 255, 255, 255);
1043 if g_ol_rlayer_door
then doWallsOld(gWalls
, PANEL_OPENDOOR
or PANEL_CLOSEDOOR
, 0, 255, 0);
1044 if g_ol_rlayer_acid1
then doWallsOld(gAcid1
, PANEL_ACID1
, 255, 0, 0);
1045 if g_ol_rlayer_acid2
then doWallsOld(gAcid2
, PANEL_ACID2
, 198, 198, 0);
1046 if g_ol_rlayer_water
then doWallsOld(gWater
, PANEL_WATER
, 0, 255, 255);
1047 if g_ol_rlayer_fore
then doWallsOld(gRenderForegrounds
, PANEL_FORE
, 210, 210, 210);
1048 glScissor(0, 0, gScreenWidth
, gScreenHeight
);
1049 glDisable(GL_SCISSOR_TEST
);
1054 procedure plrDebugDraw ();
1055 procedure drawTileGrid ();
1059 for y
:= 0 to (mapGrid
.gridHeight
div mapGrid
.tileSize
) do
1061 drawLine(mapGrid
.gridX0
, mapGrid
.gridY0
+y
*mapGrid
.tileSize
, mapGrid
.gridX0
+mapGrid
.gridWidth
, mapGrid
.gridY0
+y
*mapGrid
.tileSize
, 96, 96, 96, 255);
1064 for x
:= 0 to (mapGrid
.gridWidth
div mapGrid
.tileSize
) do
1066 drawLine(mapGrid
.gridX0
+x
*mapGrid
.tileSize
, mapGrid
.gridY0
, mapGrid
.gridX0
+x
*mapGrid
.tileSize
, mapGrid
.gridY0
+y
*mapGrid
.gridHeight
, 96, 96, 96, 255);
1070 procedure drawAwakeCells ();
1074 for y
:= 0 to (mapGrid
.gridHeight
div mapGrid
.tileSize
) do
1076 for x
:= 0 to (mapGrid
.gridWidth
div mapGrid
.tileSize
) do
1078 if awmIsSetHolmes(x
*mapGrid
.tileSize
+mapGrid
.gridX0
+1, y
*mapGrid
.tileSize
++mapGrid
.gridY0
+1) then
1080 fillRect(x
*mapGrid
.tileSize
++mapGrid
.gridX0
, y
*mapGrid
.tileSize
++mapGrid
.gridY0
, monsGrid
.tileSize
, monsGrid
.tileSize
, 128, 0, 128, 64);
1086 procedure drawTraceBox ();
1089 px
, py
, pw
, ph
: Integer;
1094 if (Length(gPlayers
) < 1) then exit
;
1096 if (plr
= nil) then exit
;
1097 plr
.getMapBox(px
, py
, pw
, ph
);
1098 drawRect(px
, py
, pw
, ph
, 255, 0, 255, 200);
1099 pdx
:= pmsCurMapX
-(px
+pw
div 2);
1100 pdy
:= pmsCurMapY
-(py
+ph
div 2);
1101 drawLine(px
+pw
div 2, py
+ph
div 2, px
+pw
div 2+pdx
, py
+ph
div 2+pdy
, 255, 0, 255, 200);
1102 pan
:= mapGrid
.traceBox(ex
, ey
, px
, py
, pw
, ph
, pdx
, pdy
, nil, GridTagObstacle
);
1105 drawRect(px
+pdx
, py
+pdy
, pw
, ph
, 255, 255, 255, 180);
1109 drawRect(px
+pdx
, py
+pdy
, pw
, ph
, 255, 255, 0, 180);
1111 drawRect(ex
, ey
, pw
, ph
, 255, 127, 0, 180);
1114 procedure hilightCell (cx
, cy
: Integer);
1116 fillRect(cx
, cy
, monsGrid
.tileSize
, monsGrid
.tileSize
, 0, 128, 0, 64);
1119 procedure hilightCell1 (cx
, cy
: Integer);
1121 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
1122 cx
:= cx
and (not (monsGrid
.tileSize
-1));
1123 cy
:= cy
and (not (monsGrid
.tileSize
-1));
1124 fillRect(cx
, cy
, monsGrid
.tileSize
, monsGrid
.tileSize
, 255, 255, 0, 92);
1127 function hilightWallTrc (pan
: TPanel
; tag
: Integer; x
, y
, prevx
, prevy
: Integer): Boolean;
1129 result
:= false; // don't stop
1130 if (pan
= nil) then exit
; // cell completion, ignore
1131 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
1132 fillRect(pan
.X
, pan
.Y
, pan
.Width
, pan
.Height
, 0, 128, 128, 64);
1135 function monsCollector (mon
: TMonster
; tag
: Integer): Boolean;
1138 mx
, my
, mw
, mh
: Integer;
1141 mon
.getMapBox(mx
, my
, mw
, mh
);
1142 e_DrawQuad(mx
, my
, mx
+mw
-1, my
+mh
-1, 255, 255, 0, 96);
1143 if lineAABBIntersects(laserX0
, laserY0
, laserX1
, laserY1
, mx
, my
, mw
, mh
, ex
, ey
) then
1145 e_DrawPoint(8, ex
, ey
, 0, 255, 0);
1149 procedure drawMonsterInfo (mon
: TMonster
);
1151 mx
, my
, mw
, mh
: Integer;
1153 procedure drawMonsterTargetLine ();
1155 emx
, emy
, emw
, emh
: Integer;
1160 if (g_GetUIDType(mon
.MonsterTargetUID
) = UID_PLAYER
) then
1162 eplr
:= g_Player_Get(mon
.MonsterTargetUID
);
1163 if (eplr
<> nil) then eplr
.getMapBox(emx
, emy
, emw
, emh
) else exit
;
1165 else if (g_GetUIDType(mon
.MonsterTargetUID
) = UID_MONSTER
) then
1167 enemy
:= g_Monsters_ByUID(mon
.MonsterTargetUID
);
1168 if (enemy
<> nil) then enemy
.getMapBox(emx
, emy
, emw
, emh
) else exit
;
1174 mon
.getMapBox(mx
, my
, mw
, mh
);
1175 drawLine(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, 255, 0, 0, 255);
1176 if (g_Map_traceToNearestWall(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, @ex
, @ey
) <> nil) then
1178 drawLine(mx
+mw
div 2, my
+mh
div 2, ex
, ey
, 0, 255, 0, 255);
1182 procedure drawLOS2Plr ();
1184 emx
, emy
, emw
, emh
: Integer;
1188 eplr
:= gPlayers
[0];
1189 if (eplr
= nil) then exit
;
1190 eplr
.getMapBox(emx
, emy
, emw
, emh
);
1191 mon
.getMapBox(mx
, my
, mw
, mh
);
1192 drawLine(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, 255, 0, 0, 255);
1193 {$IF DEFINED(D2F_DEBUG)}
1194 mapGrid
.dbgRayTraceTileHitCB
:= hilightCell1
;
1196 if (g_Map_traceToNearestWall(mx
+mw
div 2, my
+mh
div 2, emx
+emw
div 2, emy
+emh
div 2, @ex
, @ey
) <> nil) then
1197 //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
1199 drawLine(mx
+mw
div 2, my
+mh
div 2, ex
, ey
, 0, 255, 0, 255);
1201 {$IF DEFINED(D2F_DEBUG)}
1202 mapGrid
.dbgRayTraceTileHitCB
:= nil;
1207 if (mon
= nil) then exit
;
1208 mon
.getMapBox(mx
, my
, mw
, mh
);
1211 monsGrid
.forEachBodyCell(mon
.proxyId
, hilightCell
);
1213 if showMonsInfo
then
1215 //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
1216 darkenRect(mx
-4, my
-7*8-6, 110, 7*8+6, 128);
1221 drawText6(mx
, my
, Format('%s(U:%u)', [monsTypeToString(mon
.MonsterType
), mon
.UID
]), 255, 127, 0); my
-= 8;
1223 drawText6(mx
, my
, Format('Beh: %s', [monsBehToString(mon
.MonsterBehaviour
)]), 255, 127, 0); my
-= 8;
1225 drawText6(mx
, my
, Format('State:%s (%d)', [monsStateToString(mon
.MonsterState
), mon
.MonsterSleep
]), 255, 127, 0); my
-= 8;
1227 drawText6(mx
, my
, Format('Health:%d', [mon
.MonsterHealth
]), 255, 127, 0); my
-= 8;
1229 drawText6(mx
, my
, Format('Ammo:%d', [mon
.MonsterAmmo
]), 255, 127, 0); my
-= 8;
1231 drawText6(mx
, my
, Format('TgtUID:%u', [mon
.MonsterTargetUID
]), 255, 127, 0); my
-= 8;
1232 drawText6(mx
, my
, Format('TgtTime:%d', [mon
.MonsterTargetTime
]), 255, 127, 0); my
-= 8;
1235 drawMonsterTargetLine();
1236 if showMonsLOS2Plr
then drawLOS2Plr();
1238 property MonsterRemoved: Boolean read FRemoved write FRemoved;
1239 property MonsterPain: Integer read FPain write FPain;
1240 property MonsterAnim: Byte read FCurAnim write FCurAnim;
1244 function highlightAllMonsterCells (mon
: TMonster
): Boolean;
1246 result
:= false; // don't stop
1247 monsGrid
.forEachBodyCell(mon
.proxyId
, hilightCell
);
1250 procedure drawSelectedPlatformCells ();
1254 if not showGrid
then exit
;
1255 pan
:= g_Map_PanelByGUID(platMarkedGUID
);
1256 if (pan
= nil) then exit
;
1257 mapGrid
.forEachBodyCell(pan
.proxyId
, hilightCell
);
1258 drawRect(pan
.x
, pan
.y
, pan
.width
, pan
.height
, 0, 200, 0, 200);
1261 procedure drawTrigger (var trig
: TTrigger
);
1263 procedure drawPanelDest (pguid
: Integer);
1267 pan
:= g_Map_PanelByGUID(pguid
);
1268 if (pan
= nil) then exit
;
1270 trig
.trigCenter
.x
, trig
.trigCenter
.y
,
1271 pan
.x
+pan
.width
div 2, pan
.y
+pan
.height
div 2,
1279 fillRect(trig
.x
, trig
.y
, trig
.width
, trig
.height
, 255, 0, 255, 96);
1280 tts
:= trigType2Str(trig
.TriggerType
);
1281 tx
:= trig
.x
+(trig
.width
-Length(tts
)*6) div 2;
1282 darkenRect(tx
-2, trig
.y
-10, Length(tts
)*6+4, 10, 64);
1283 drawText6(tx
, trig
.y
-9, tts
, 255, 127, 0);
1284 tx
:= trig
.x
+(trig
.width
-Length(trig
.mapId
)*6) div 2;
1285 darkenRect(tx
-2, trig
.y
-20, Length(trig
.mapId
)*6+4, 10, 64);
1286 drawText6(tx
, trig
.y
-19, trig
.mapId
, 255, 255, 0);
1287 drawPanelDest(trig
.trigPanelGUID
);
1288 case trig
.TriggerType
of
1289 TRIGGER_NONE
: begin end;
1290 TRIGGER_EXIT
: begin end;
1291 TRIGGER_TELEPORT
: begin end;
1292 TRIGGER_OPENDOOR
: begin end;
1293 TRIGGER_CLOSEDOOR
: begin end;
1294 TRIGGER_DOOR
: begin end;
1295 TRIGGER_DOOR5
: begin end;
1296 TRIGGER_CLOSETRAP
: begin end;
1297 TRIGGER_TRAP
: begin end;
1298 TRIGGER_SECRET
: begin end;
1299 TRIGGER_LIFTUP
: begin end;
1300 TRIGGER_LIFTDOWN
: begin end;
1301 TRIGGER_LIFT
: begin end;
1302 TRIGGER_TEXTURE
: begin end;
1303 TRIGGER_ON
, TRIGGER_OFF
, TRIGGER_ONOFF
, TRIGGER_PRESS
:
1305 if (trig
.trigDataRec
.trigTWidth
> 0) and (trig
.trigDataRec
.trigTHeight
> 0) then
1308 trig
.trigDataRec
.trigTX
, trig
.trigDataRec
.trigTY
,
1309 trig
.trigDataRec
.trigTWidth
, trig
.trigDataRec
.trigTHeight
,
1312 trig
.trigCenter
.x
, trig
.trigCenter
.y
,
1313 trig
.trigDataRec
.trigTX
+trig
.trigDataRec
.trigTWidth
div 2,
1314 trig
.trigDataRec
.trigTY
+trig
.trigDataRec
.trigTHeight
div 2,
1318 TRIGGER_SOUND
: begin end;
1319 TRIGGER_SPAWNMONSTER
: begin end;
1320 TRIGGER_SPAWNITEM
: begin end;
1321 TRIGGER_MUSIC
: begin end;
1322 TRIGGER_PUSH
: begin end;
1323 TRIGGER_SCORE
: begin end;
1324 TRIGGER_MESSAGE
: begin end;
1325 TRIGGER_DAMAGE
: begin end;
1326 TRIGGER_HEALTH
: begin end;
1327 TRIGGER_SHOT
: begin end;
1328 TRIGGER_EFFECT
: begin end;
1329 TRIGGER_SCRIPT
: begin end;
1332 //trigPanelId: Integer;
1335 procedure drawTriggers ();
1339 for f
:= 0 to High(gTriggers
) do drawTrigger(gTriggers
[f
]);
1342 procedure drawGibsBoxes ();
1345 px
, py
, pw
, ph
: Integer;
1348 for f
:= 0 to High(gGibs
) do
1353 gib
.getMapBox(px
, py
, pw
, ph
);
1354 drawRect(px
, py
, pw
, ph
, 255, 0, 255);
1361 mx
, my
, mw
, mh
: Integer;
1365 if (gPlayer1
= nil) then exit
;
1367 glEnable(GL_SCISSOR_TEST
);
1368 glScissor(0, gWinSizeY
-gPlayerScreenSize
.Y
-1, vpw
, vph
);
1371 glScalef(g_dbg_scale
, g_dbg_scale
, 1.0);
1372 glTranslatef(-vpx
, -vpy
, 0);
1374 if (showGrid
) then drawTileGrid();
1377 if (laserSet
) then g_Mons_AlongLine(laserX0
, laserY0
, laserX1
, laserY1
, monsCollector
, true);
1379 if (monMarkedUID
<> -1) then
1381 mon
:= g_Monsters_ByUID(monMarkedUID
);
1382 if (mon
<> nil) then
1384 mon
.getMapBox(mx
, my
, mw
, mh
);
1385 e_DrawQuad(mx
, my
, mx
+mw
-1, my
+mh
-1, 255, 0, 0, 30);
1386 drawMonsterInfo(mon
);
1390 if showAllMonsCells
and showGrid
then g_Mons_ForEach(highlightAllMonsterCells
);
1391 if showTriggers
then drawTriggers();
1392 if showGrid
then drawSelectedPlatformCells();
1396 if showTraceBox
then drawTraceBox();
1401 //pan := g_Map_traceToNearest(16, 608, 16, 8, (GridTagObstacle or GridTagLiquid), @ex, @ey);
1403 {$IF DEFINED(D2F_DEBUG)}
1404 mapGrid.dbgRayTraceTileHitCB := hilightCell1;
1406 pan := mapGrid.traceRay(ex, ey, 16, 608, 16, 8, nil, (GridTagObstacle or GridTagLiquid));
1407 if (pan <> nil) then writeln('end=(', ex, ',', ey, ')');
1408 {$IF DEFINED(D2F_DEBUG)}
1409 mapGrid.dbgRayTraceTileHitCB := nil;
1412 pan := g_Map_PanelAtPoint(16, 608, (GridTagObstacle or GridTagLiquid));
1413 if (pan <> nil) then writeln('hit!');
1418 glDisable(GL_SCISSOR_TEST
);
1420 if showMapCurPos
then drawText8(4, gWinSizeY
-10, Format('mappos:(%d,%d)', [pmsCurMapX
, pmsCurMapY
]), 255, 255, 0);
1424 // ////////////////////////////////////////////////////////////////////////// //
1425 function g_Holmes_MouseEvent (var ev
: THMouseEvent
): Boolean;
1429 if g_Game_IsNet
then begin result
:= false; exit
; end;
1430 holmesInitCommands();
1433 msX
:= trunc(ev
.x
/g_holmes_ui_scale
);
1434 msY
:= trunc(ev
.y
/g_holmes_ui_scale
);
1439 he
.x
:= trunc(he
.x
/g_holmes_ui_scale
);
1440 he
.y
:= trunc(he
.y
/g_holmes_ui_scale
);
1441 if not uiMouseEvent(he
) then plrDebugMouse(he
);
1445 // ////////////////////////////////////////////////////////////////////////// //
1446 function g_Holmes_KeyEvent (var ev
: THKeyEvent
): Boolean;
1447 {$IF DEFINED(D2F_DEBUG)}
1454 procedure dummyWallTrc (cx
, cy
: Integer);
1459 if g_Game_IsNet
then begin result
:= false; exit
; end;
1460 holmesInitCommands();
1466 SDL_SCANCODE_LCTRL
, SDL_SCANCODE_RCTRL
,
1467 SDL_SCANCODE_LALT
, SDL_SCANCODE_RALT
,
1468 SDL_SCANCODE_LSHIFT
, SDL_SCANCODE_RSHIFT
:
1471 if uiKeyEvent(ev
) then begin result
:= true; exit
; end;
1472 if keybindExecute(ev
) then begin result
:= true; exit
; end;
1474 if (ev
.kind
= THKeyEvent
.Press
) then
1476 {$IF DEFINED(D2F_DEBUG)}
1477 // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction
1478 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
1479 ((ev
.kstate
and THKeyEvent
.ModCtrl
) <> 0) then
1485 SDL_SCANCODE_UP
: dy
-= 120;
1486 SDL_SCANCODE_DOWN
: dy
+= 120;
1487 SDL_SCANCODE_LEFT
: dx
-= 120;
1488 SDL_SCANCODE_RIGHT
: dx
+= 120;
1490 {$IF DEFINED(D2F_DEBUG)}
1491 //mapGrid.dbgRayTraceTileHitCB := dummyWallTrc;
1492 mapGrid
.dbgShowTraceLog
:= true;
1494 pan
:= g_Map_traceToNearest(pmsCurMapX
, pmsCurMapY
, dx
, dy
, (GridTagWall
or GridTagDoor
or GridTagStep
or GridTagAcid1
or GridTagAcid2
or GridTagWater
), @ex
, @ey
);
1495 {$IF DEFINED(D2F_DEBUG)}
1496 //mapGrid.dbgRayTraceTileHitCB := nil;
1497 mapGrid
.dbgShowTraceLog
:= false;
1499 e_LogWritefln('v-trace: (%d,%d)-(%d,%d); end=(%d,%d); hit=%d', [pmsCurMapX
, pmsCurMapY
, dx
, dy
, ex
, ey
, (pan
<> nil)]);
1507 // ////////////////////////////////////////////////////////////////////////// //
1508 procedure g_Holmes_Draw ();
1510 if g_Game_IsNet
then exit
;
1511 {$IF not DEFINED(HEADLESS)}
1512 holmesInitCommands();
1515 glColorMask(GL_TRUE
, GL_TRUE
, GL_TRUE
, GL_TRUE
); // modify color buffer
1516 glDisable(GL_STENCIL_TEST
);
1517 glDisable(GL_BLEND
);
1518 glDisable(GL_SCISSOR_TEST
);
1519 glDisable(GL_TEXTURE_2D
);
1521 if gGameOn
then plrDebugDraw();
1528 procedure g_Holmes_DrawUI ();
1530 if g_Game_IsNet
then exit
;
1531 {$IF not DEFINED(HEADLESS)}
1533 glScalef(g_holmes_ui_scale
, g_holmes_ui_scale
, 1.0);
1541 // ////////////////////////////////////////////////////////////////////////// //
1542 procedure bcOneMonsterThinkStep (); begin gmon_debug_think
:= false; gmon_debug_one_think_step
:= true; end;
1543 procedure bcOneMPlatThinkStep (); begin g_dbgpan_mplat_active
:= false; g_dbgpan_mplat_step
:= true; end;
1544 procedure bcMPlatToggle (); begin g_dbgpan_mplat_active
:= not g_dbgpan_mplat_active
; end;
1546 procedure bcToggleMonsterInfo (arg
: Integer=-1); begin if (arg
< 0) then showMonsInfo
:= not showMonsInfo
else showMonsInfo
:= (arg
> 0); end;
1547 procedure bcToggleMonsterLOSPlr (arg
: Integer=-1); begin if (arg
< 0) then showMonsLOS2Plr
:= not showMonsLOS2Plr
else showMonsLOS2Plr
:= (arg
> 0); end;
1548 procedure bcToggleMonsterCells (arg
: Integer=-1); begin if (arg
< 0) then showAllMonsCells
:= not showAllMonsCells
else showAllMonsCells
:= (arg
> 0); end;
1549 procedure bcToggleDrawTriggers (arg
: Integer=-1); begin if (arg
< 0) then showTriggers
:= not showTriggers
else showTriggers
:= (arg
> 0); end;
1551 procedure bcToggleCurPos (arg
: Integer=-1); begin if (arg
< 0) then showMapCurPos
:= not showMapCurPos
else showMapCurPos
:= (arg
> 0); end;
1552 procedure bcToggleGrid (arg
: Integer=-1); begin if (arg
< 0) then showGrid
:= not showGrid
else showGrid
:= (arg
> 0); end;
1554 procedure bcMonsterSpawn (s
: AnsiString);
1558 if not gGameOn
or g_Game_IsClient
then
1560 conwriteln('cannot spawn monster in this mode');
1563 mon
:= g_Mons_SpawnAt(s
, pmsCurMapX
, pmsCurMapY
);
1564 if (mon
= nil) then begin conwritefln('unknown monster id: ''%s''', [s
]); exit
; end;
1565 monMarkedUID
:= mon
.UID
;
1568 procedure bcMonsterWakeup ();
1572 if (monMarkedUID
<> -1) then
1574 mon
:= g_Monsters_ByUID(monMarkedUID
);
1575 if (mon
<> nil) then mon
.WakeUp();
1579 procedure bcPlayerTeleport ();
1581 x
, y
, w
, h
: Integer;
1583 //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY);
1584 if (gPlayers
[0] <> nil) then
1586 gPlayers
[0].getMapBox(x
, y
, w
, h
);
1587 gPlayers
[0].TeleportTo(pmsCurMapX
-w
div 2, pmsCurMapY
-h
div 2, true, 69); // 69: don't change dir
1591 procedure dbgToggleTraceBox (arg
: Integer=-1); begin if (arg
< 0) then showTraceBox
:= not showTraceBox
else showTraceBox
:= (arg
> 0); end;
1593 procedure dbgToggleHolmesPause (arg
: Integer=-1); begin if (arg
< 0) then g_Game_HolmesPause(not gPauseHolmes
) else g_Game_HolmesPause(arg
> 0); end;
1595 procedure cbAtcurSelectMonster ();
1596 function monsAtDump (mon
: TMonster
; tag
: Integer): Boolean;
1598 result
:= true; // stop
1599 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon
.arrIdx
, mon
.UID
, mon
.proxyId
]), TMsgType
.Notify
);
1600 monMarkedUID
:= mon
.UID
;
1601 dumpPublishedProperties(mon
);
1605 x
, y
, w
, h
: Integer;
1608 if (Length(gPlayers
) > 0) then
1611 if (plr
<> nil) then
1613 plr
.getMapBox(x
, y
, w
, h
);
1614 if (pmsCurMapX
>= x
) and (pmsCurMapY
>= y
) and (pmsCurMapX
< x
+w
) and (pmsCurMapY
< y
+h
) then
1616 dumpPublishedProperties(plr
);
1620 //e_WriteLog('===========================', MSG_NOTIFY);
1621 monsGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, monsAtDump
);
1622 //e_WriteLog('---------------------------', MSG_NOTIFY);
1625 procedure cbAtcurDumpMonsters ();
1626 function monsAtDump (mon
: TMonster
; tag
: Integer): Boolean;
1628 result
:= false; // don't stop
1629 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon
.arrIdx
, mon
.UID
, mon
.proxyId
]), TMsgType
.Notify
);
1632 e_WriteLog('===========================', TMsgType
.Notify
);
1633 monsGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, monsAtDump
);
1634 e_WriteLog('---------------------------', TMsgType
.Notify
);
1637 procedure cbAtcurDumpWalls ();
1638 function wallToggle (pan
: TPanel
; tag
: Integer): Boolean;
1640 result
:= false; // don't stop
1641 if (platMarkedGUID
= -1) then platMarkedGUID
:= pan
.guid
;
1642 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
]);
1643 dumpPublishedProperties(pan
);
1646 hasTrigs
: Boolean = false;
1650 platMarkedGUID
:= -1;
1651 e_WriteLog('=== TOGGLE WALL ===', TMsgType
.Notify
);
1652 mapGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, wallToggle
, (GridTagWall
or GridTagDoor
));
1653 e_WriteLog('--- toggle wall ---', TMsgType
.Notify
);
1654 if showTriggers
then
1656 for f
:= 0 to High(gTriggers
) do
1658 trig
:= @gTriggers
[f
];
1659 if (pmsCurMapX
>= trig
.x
) and (pmsCurMapY
>= trig
.y
) and (pmsCurMapX
< trig
.x
+trig
.width
) and (pmsCurMapY
< trig
.y
+trig
.height
) then
1661 if not hasTrigs
then begin writeln('=== TRIGGERS ==='); hasTrigs
:= true; end;
1662 writeln('trigger ''', trig
.mapId
, ''' of type ''', trigType2Str(trig
.TriggerType
), '''');
1665 if hasTrigs
then writeln('--- triggers ---');
1669 procedure cbAtcurToggleWalls ();
1670 function wallToggle (pan
: TPanel
; tag
: Integer): Boolean;
1672 result
:= false; // don't stop
1673 //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);
1674 if pan
.Enabled
then g_Map_DisableWallGUID(pan
.guid
) else g_Map_EnableWallGUID(pan
.guid
);
1677 //e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
1678 mapGrid
.forEachAtPoint(pmsCurMapX
, pmsCurMapY
, wallToggle
, (GridTagWall
or GridTagDoor
));
1679 //e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
1683 // ////////////////////////////////////////////////////////////////////////// //
1684 procedure holmesInitCommands ();
1686 if (cmdlist
<> nil) then exit
;
1687 cmdAdd('win_layers', toggleLayersWindow
, 'toggle layers window', 'window control');
1688 cmdAdd('win_outline', toggleOutlineWindow
, 'toggle outline window', 'window control');
1689 cmdAdd('win_help', toggleHelpWindow
, 'toggle help window', 'window control');
1690 cmdAdd('win_options', toggleOptionsWindow
, 'toggle options window', 'window control');
1692 cmdAdd('mon_think_step', bcOneMonsterThinkStep
, 'one monster think step', 'monster control');
1693 cmdAdd('mon_info', bcToggleMonsterInfo
, 'toggle monster info', 'monster control');
1694 cmdAdd('mon_los_plr', bcToggleMonsterLOSPlr
, 'toggle monster LOS to player', 'monster control');
1695 cmdAdd('mon_cells', bcToggleMonsterCells
, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control');
1696 cmdAdd('mon_wakeup', bcMonsterWakeup
, 'wake up selected monster', 'monster control');
1698 cmdAdd('mon_spawn', bcMonsterSpawn
, 'spawn monster', 'monster control');
1700 cmdAdd('mplat_step', bcOneMPlatThinkStep
, 'one mplat think step', 'mplat control');
1701 cmdAdd('mplat_toggle', bcMPlatToggle
, 'activate/deactivate moving platforms', 'mplat control');
1703 cmdAdd('plr_teleport', bcPlayerTeleport
, 'teleport player', 'player control');
1705 cmdAdd('dbg_curpos', bcToggleCurPos
, 'toggle "show cursor position on the map"', 'various');
1706 cmdAdd('dbg_grid', bcToggleGrid
, 'toggle grid', 'various');
1707 cmdAdd('dbg_triggers', bcToggleDrawTriggers
, 'show/hide triggers (SLOW!)', 'various');
1709 cmdAdd('atcur_select_monster', cbAtcurSelectMonster
, 'select monster to operate', 'monster control');
1710 cmdAdd('atcur_dump_monsters', cbAtcurDumpMonsters
, 'dump monsters in cell', 'monster control');
1711 cmdAdd('atcur_dump_walls', cbAtcurDumpWalls
, 'dump walls in cell', 'wall control');
1712 cmdAdd('atcur_disable_walls', cbAtcurToggleWalls
, 'disable walls', 'wall control');
1714 cmdAdd('dbg_tracebox', dbgToggleTraceBox
, 'test traceBox()', 'player control');
1716 cmdAdd('hlm_pause', dbgToggleHolmesPause
, '"Holmes" pause mode', 'game control');
1720 procedure holmesInitBinds ();
1723 pr
: TTextParser
= nil;
1724 s
, kn
, v
: AnsiString;
1729 if not keybindsInited
then
1732 keybindAdd('F1', 'win_help');
1733 keybindAdd('M-F1', 'win_options');
1734 keybindAdd('C-O', 'win_outline');
1735 keybindAdd('C-L', 'win_layers');
1737 keybindAdd('M-M', 'mon_think_step');
1738 keybindAdd('M-I', 'mon_info');
1739 keybindAdd('M-L', 'mon_los_plr');
1740 keybindAdd('M-G', 'mon_cells');
1741 keybindAdd('M-A', 'mon_wakeup');
1743 keybindAdd('M-P', 'mplat_step');
1744 keybindAdd('M-O', 'mplat_toggle');
1746 keybindAdd('C-T', 'plr_teleport');
1747 keybindAdd('M-T', 'dbg_tracebox');
1749 keybindAdd('C-P', 'dbg_curpos');
1750 keybindAdd('C-G', 'dbg_grid');
1751 keybindAdd('C-X', 'dbg_triggers');
1753 keybindAdd('C-1', 'mon_spawn zombie');
1755 keybindAdd('C-S-P', 'hlm_pause');
1758 msbindAdd('LMB', 'atcur_select_monster');
1759 msbindAdd('M-LMB', 'atcur_dump_monsters');
1760 msbindAdd('RMB', 'atcur_dump_walls');
1761 msbindAdd('M-RMB', 'atcur_disable_walls');
1763 // load bindings from file
1765 st
:= openDiskFileRO(GameDir
+'holmes.rc');
1766 pr
:= TFileTextParser
.Create(st
);
1767 conwriteln('parsing "holmes.rc"...');
1768 while (pr
.tokType
<> pr
.TTEOF
) do
1771 if (s
= 'stop') then break
1772 else if (s
= 'unbind_keys') then keybinds
:= nil
1773 else if (s
= 'unbind_mouse') then msbinds
:= nil
1774 else if (s
= 'bind') then
1776 if (pr
.tokType
= pr
.TTStr
) then s
:= pr
.expectStr(false)
1777 else if (pr
.tokType
= pr
.TTInt
) then s
:= Format('%d', [pr
.expectInt()])
1778 else s
:= pr
.expectId();
1780 if (pr
.tokType
= pr
.TTStr
) then v
:= pr
.expectStr(false)
1781 else if (pr
.tokType
= pr
.TTInt
) then v
:= Format('%d', [pr
.expectInt()])
1782 else v
:= pr
.expectId();
1784 kn
:= parseModKeys(s
, kmods
, mbuts
);
1785 if (CompareText(kn
, 'lmb') = 0) or (CompareText(kn
, 'rmb') = 0) or (CompareText(kn
, 'mmb') = 0) or (CompareText(kn
, 'None') = 0) then
1795 except on e
: Exception
do // sorry
1796 if (pr
<> nil) then conwritefln('Holmes config parse error at (%s,%s): %s', [pr
.tokLine
, pr
.tokCol
, e
.message]);
1798 if (pr
<> nil) then pr
.Free() else st
.Free(); // ownership
1804 conRegVar('hlm_ui_scale', @g_holmes_ui_scale
, 0.01, 5.0, 'Holmes UI scale', '', false);