DEADSOFTWARE

FlexUI: switched to universal event struct; changed event dispatching to sink/mine...
[d2df-sdl.git] / src / game / g_holmes.pas
1 (* Copyright (C) DooM 2D:Forever Developers
2 *
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.
7 *
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.
12 *
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/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
17 unit g_holmes;
19 interface
21 uses
22 {$IFDEF USE_MEMPOOL}mempool,{$ENDIF} geom,
23 e_log, e_input,
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,
26 xprofiler,
27 sdlcarcass,
28 fui_common, fui_events, fui_ctls,
29 fui_gfx_gl;
32 procedure g_Holmes_Draw ();
33 procedure g_Holmes_DrawUI ();
35 procedure g_Holmes_OnEvent (var ev: TFUIEvent);
37 // hooks for player
38 procedure g_Holmes_plrViewPos (viewPortX, viewPortY: Integer);
39 procedure g_Holmes_plrViewSize (viewPortW, viewPortH: Integer);
40 procedure g_Holmes_plrLaser (ax0, ay0, ax1, ay1: Integer);
43 var
44 g_holmes_imfunctional: Boolean = false;
45 g_holmes_enabled: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}false{$ENDIF};
48 implementation
50 uses
51 {rttiobj,} typinfo, e_texture,
52 SysUtils, Classes, GL, SDL2,
53 MAPDEF, g_main, g_options,
54 utils, hashtable, xparser;
57 var
58 hlmContext: TGxContext = nil;
59 //globalInited: Boolean = false;
60 msX: Integer = -666;
61 msY: Integer = -666;
62 msB: Word = 0; // button state
63 kbS: Word = 0; // keyboard modifiers state
64 showGrid: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
65 showMonsInfo: Boolean = false;
66 showMonsLOS2Plr: Boolean = false;
67 showAllMonsCells: Boolean = false;
68 showMapCurPos: Boolean = false;
69 showLayersWindow: Boolean = false;
70 showOutlineWindow: Boolean = false;
71 showTriggers: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
72 showTraceBox: Boolean = {$IF DEFINED(D2F_DEBUG)}false{$ELSE}false{$ENDIF};
75 // ////////////////////////////////////////////////////////////////////////// //
76 {$INCLUDE g_holmes.inc}
77 {$INCLUDE g_holmes_ol.inc} // outliner
80 // ////////////////////////////////////////////////////////////////////////// //
81 {$INCLUDE g_holmes_cmd.inc}
82 procedure holmesInitCommands (); forward;
83 procedure holmesInitBinds (); forward;
86 // ////////////////////////////////////////////////////////////////////////// //
87 var
88 g_ol_nice: Boolean = false;
89 g_ol_fill_walls: Boolean = false;
90 g_ol_rlayer_back: Boolean = false;
91 g_ol_rlayer_step: Boolean = false;
92 g_ol_rlayer_wall: Boolean = false;
93 g_ol_rlayer_door: Boolean = false;
94 g_ol_rlayer_acid1: Boolean = false;
95 g_ol_rlayer_acid2: Boolean = false;
96 g_ol_rlayer_water: Boolean = false;
97 g_ol_rlayer_fore: Boolean = false;
100 // ////////////////////////////////////////////////////////////////////////// //
101 var
102 winHelp: TUITopWindow = nil;
103 winOptions: TUITopWindow = nil;
104 winLayers: TUITopWindow = nil;
105 winOutlines: TUITopWindow = nil;
108 procedure createHelpWindow (); forward;
109 procedure createOptionsWindow (); forward;
110 procedure createLayersWindow (); forward;
111 procedure createOutlinesWindow (); forward;
114 procedure toggleLayersWindowCB (me: TUIControl);
115 begin
116 showLayersWindow := not showLayersWindow;
117 if showLayersWindow then
118 begin
119 if (winLayers = nil) then createLayersWindow();
120 uiAddWindow(winLayers);
121 end
122 else
123 begin
124 uiRemoveWindow(winLayers);
125 end;
126 end;
128 procedure toggleOutlineWindowCB (me: TUIControl);
129 begin
130 showOutlineWindow := not showOutlineWindow;
131 if showOutlineWindow then
132 begin
133 if (winOutlines = nil) then createOutlinesWindow();
134 uiAddWindow(winOutlines);
135 end
136 else
137 begin
138 uiRemoveWindow(winOutlines);
139 end;
140 end;
143 procedure createHelpWindow ();
144 procedure addHelpEmptyLine ();
145 var
146 stx: TUIStaticText;
147 begin
148 stx := TUIStaticText.Create();
149 stx.flExpand := true;
150 stx.halign := 0; // center
151 stx.text := '';
152 stx.header := false;
153 stx.line := false;
154 winHelp.appendChild(stx);
155 end;
157 procedure addHelpCaptionLine (const txt: AnsiString);
158 var
159 stx: TUIStaticText;
160 begin
161 stx := TUIStaticText.Create();
162 stx.flExpand := true;
163 stx.halign := 0; // center
164 stx.text := txt;
165 stx.header := true;
166 stx.line := true;
167 winHelp.appendChild(stx);
168 end;
170 procedure addHelpCaption (const txt: AnsiString);
171 var
172 stx: TUIStaticText;
173 begin
174 stx := TUIStaticText.Create();
175 stx.flExpand := true;
176 stx.halign := 0; // center
177 stx.text := txt;
178 stx.header := true;
179 stx.line := false;
180 winHelp.appendChild(stx);
181 end;
183 procedure addHelpKeyMouse (const key, txt, grp: AnsiString);
184 var
185 box: TUIHBox;
186 span: TUISpan;
187 stx: TUIStaticText;
188 begin
189 box := TUIHBox.Create();
190 box.flExpand := true;
191 // key
192 stx := TUIStaticText.Create();
193 stx.flExpand := true;
194 stx.halign := 1; // right
195 stx.valign := 0; // center
196 stx.text := key;
197 stx.header := true;
198 stx.line := false;
199 stx.flHGroup := grp;
200 box.appendChild(stx);
201 // span
202 span := TUISpan.Create();
203 span.flDefaultSize := TLaySize.Create(4, 1);
204 span.flExpand := true;
205 box.appendChild(span);
206 // text
207 stx := TUIStaticText.Create();
208 stx.flExpand := true;
209 stx.halign := -1; // left
210 stx.valign := 0; // center
211 stx.text := txt;
212 stx.header := false;
213 stx.line := false;
214 box.appendChild(stx);
215 winHelp.appendChild(box);
216 end;
218 procedure addHelpKey (const key, txt: AnsiString); begin addHelpKeyMouse(key, txt, 'help-keys'); end;
219 procedure addHelpMouse (const key, txt: AnsiString); begin addHelpKeyMouse(key, txt, 'help-mouse'); end;
221 var
222 slist: array of AnsiString = nil;
223 cmd: PHolmesCommand;
224 bind: THolmesBinding;
225 f: Integer;
227 llb: TUISimpleText;
228 maxkeylen: Integer;
229 s: AnsiString;
231 begin
232 winHelp := TUITopWindow.Create('Holmes Help');
233 winHelp.escClose := true;
234 winHelp.flHoriz := false;
236 // keyboard
237 for cmd in cmdlist do cmd.helpmark := false;
239 //maxkeylen := 0;
240 for bind in keybinds do
241 begin
242 if (Length(bind.key) = 0) then continue;
243 if cmdlist.get(bind.cmdName, cmd) then
244 begin
245 if (Length(cmd.help) > 0) then
246 begin
247 cmd.helpmark := true;
248 //if (maxkeylen < Length(bind.key)) then maxkeylen := Length(bind.key);
249 end;
250 end;
251 end;
253 for cmd in cmdlist do
254 begin
255 if not cmd.helpmark then continue;
256 if (Length(cmd.help) = 0) then begin cmd.helpmark := false; continue; end;
257 f := 0;
258 while (f < Length(slist)) and (CompareText(slist[f], cmd.section) <> 0) do Inc(f);
259 if (f = Length(slist)) then
260 begin
261 SetLength(slist, Length(slist)+1);
262 slist[High(slist)] := cmd.section;
263 end;
264 end;
266 addHelpCaptionLine('KEYBOARD');
267 //llb := TUISimpleText.Create(0, 0);
268 for f := 0 to High(slist) do
269 begin
270 //if (f > 0) then llb.appendItem('');
271 if (f > 0) then addHelpEmptyLine();
272 //llb.appendItem(slist[f], true, true);
273 addHelpCaption(slist[f]);
274 for cmd in cmdlist do
275 begin
276 if not cmd.helpmark then continue;
277 if (CompareText(cmd.section, slist[f]) <> 0) then continue;
278 for bind in keybinds do
279 begin
280 if (Length(bind.key) = 0) then continue;
281 if (cmd.name = bind.cmdName) then
282 begin
283 //s := bind.key;
284 //while (Length(s) < maxkeylen) do s += ' ';
285 //s := ' '+s+' -- '+cmd.help;
286 //llb.appendItem(s);
287 addHelpMouse(bind.key, cmd.help);
288 end;
289 end;
290 end;
291 end;
293 // mouse
294 for cmd in cmdlist do cmd.helpmark := false;
296 //maxkeylen := 0;
297 for bind in msbinds do
298 begin
299 if (Length(bind.key) = 0) then continue;
300 if cmdlist.get(bind.cmdName, cmd) then
301 begin
302 if (Length(cmd.help) > 0) then
303 begin
304 cmd.helpmark := true;
305 //if (maxkeylen < Length(bind.key)) then maxkeylen := Length(bind.key);
306 end;
307 end;
308 end;
310 //llb.appendItem('');
311 //llb.appendItem('mouse', true, true);
312 if (f > 0) then addHelpEmptyLine();
313 addHelpCaptionLine('MOUSE');
314 for bind in msbinds do
315 begin
316 if (Length(bind.key) = 0) then continue;
317 if cmdlist.get(bind.cmdName, cmd) then
318 begin
319 if (Length(cmd.help) > 0) then
320 begin
321 //s := bind.key;
322 //while (Length(s) < maxkeylen) do s += ' ';
323 //s := ' '+s+' -- '+cmd.help;
324 //llb.appendItem(s);
325 addHelpKey(bind.key, cmd.help);
326 end;
327 end;
328 end;
330 //winHelp.appendChild(llb);
332 uiLayoutCtl(winHelp);
333 winHelp.escClose := true;
334 winHelp.centerInScreen();
335 end;
338 procedure winLayersClosed (me: TUIControl); begin showLayersWindow := false; end;
339 procedure winOutlinesClosed (me: TUIControl); begin showOutlineWindow := false; end;
341 procedure addCheckBox (parent: TUIControl; const text: AnsiString; pvar: PBoolean; const aid: AnsiString='');
342 var
343 cb: TUICheckBox;
344 begin
345 cb := TUICheckBox.Create();
346 cb.flExpand := true;
347 cb.setVar(pvar);
348 cb.text := text;
349 cb.id := aid;
350 parent.appendChild(cb);
351 end;
353 procedure addButton (parent: TUIControl; const text: AnsiString; cb: TUIControl.TActionCB);
354 var
355 but: TUIButton;
356 begin
357 but := TUIButton.Create();
358 //but.flExpand := true;
359 but.actionCB := cb;
360 but.text := text;
361 parent.appendChild(but);
362 end;
365 procedure actionFillWalls (cb: TUIControl);
366 begin
367 TUICheckBox(cb).checked := not TUICheckBox(cb).checked;
368 TUICheckBox(cb.topLevel['cbcontour']).enabled := not TUICheckBox(cb).checked;
369 end;
371 procedure createLayersWindow ();
372 var
373 box: TUIVBox;
374 begin
375 winLayers := TUITopWindow.Create('layers');
376 winLayers.flHoriz := false;
377 winLayers.x0 := 10;
378 winLayers.y0 := 10;
379 winLayers.flHoriz := false;
380 winLayers.escClose := true;
381 winLayers.closeCB := winLayersClosed;
383 box := TUIVBox.Create();
384 addCheckBox(box, '~background', @g_rlayer_back);
385 addCheckBox(box, '~steps', @g_rlayer_step);
386 addCheckBox(box, '~walls', @g_rlayer_wall);
387 addCheckBox(box, '~doors', @g_rlayer_door);
388 addCheckBox(box, 'acid~1', @g_rlayer_acid1);
389 addCheckBox(box, 'acid~2', @g_rlayer_acid2);
390 addCheckBox(box, 'wate~r', @g_rlayer_water);
391 addCheckBox(box, '~foreground', @g_rlayer_fore);
392 winLayers.appendChild(box);
394 uiLayoutCtl(winLayers);
395 end;
398 procedure createOutlinesWindow ();
399 var
400 box: TUIVBox;
401 begin
402 winOutlines := TUITopWindow.Create('outlines');
403 winOutlines.flHoriz := false;
404 winOutlines.x0 := 100;
405 winOutlines.y0 := 30;
406 winOutlines.flHoriz := false;
407 winOutlines.escClose := true;
408 winOutlines.closeCB := winOutlinesClosed;
410 box := TUIVBox.Create();
411 box.hasFrame := true;
412 box.caption := 'layers';
413 addCheckBox(box, '~background', @g_ol_rlayer_back);
414 addCheckBox(box, '~steps', @g_ol_rlayer_step);
415 addCheckBox(box, '~walls', @g_ol_rlayer_wall);
416 addCheckBox(box, '~doors', @g_ol_rlayer_door);
417 addCheckBox(box, 'acid~1', @g_ol_rlayer_acid1);
418 addCheckBox(box, 'acid~2', @g_ol_rlayer_acid2);
419 addCheckBox(box, 'wate~r', @g_ol_rlayer_water);
420 addCheckBox(box, '~foreground', @g_ol_rlayer_fore);
421 winOutlines.appendChild(box);
423 box := TUIVBox.Create();
424 box.hasFrame := true;
425 box.caption := 'options';
426 addCheckBox(box, 'fi~ll walls', @g_ol_fill_walls, 'cbfill');
427 addCheckBox(box, 'con~tours', @g_ol_nice, 'cbcontour');
428 winOutlines.appendChild(box);
430 winOutlines.setActionCBFor('cbfill', actionFillWalls);
432 uiLayoutCtl(winOutlines);
433 end;
436 procedure createOptionsWindow ();
437 var
438 box: TUIBox;
439 span: TUISpan;
440 begin
441 winOptions := TUITopWindow.Create('Holmes Options');
442 winOptions.flHoriz := false;
443 winOptions.flHoriz := false;
444 winOptions.escClose := true;
446 box := TUIVBox.Create();
447 box.hasFrame := true;
448 box.caption := 'visual';
449 addCheckBox(box, 'map ~grid', @showGrid);
450 addCheckBox(box, 'cursor ~position on map', @showMapCurPos);
451 addCheckBox(box, '~monster info', @showMonsInfo);
452 addCheckBox(box, 'monster LO~S to player', @showMonsLOS2Plr);
453 addCheckBox(box, 'monster ~cells (SLOW!)', @showAllMonsCells);
454 addCheckBox(box, 'draw ~triggers (SLOW!)', @showTriggers);
455 winOptions.appendChild(box);
457 box := TUIHBox.Create();
458 box.hasFrame := true;
459 box.caption := 'windows';
460 box.captionAlign := 0;
461 box.flAlign := 0;
462 addButton(box, '~layers', toggleLayersWindowCB);
463 span := TUISpan.Create();
464 span.flExpand := true;
465 span.flDefaultSize := TLaySize.Create(4, 1);
466 box.appendChild(span);
467 addButton(box, '~outline', toggleOutlineWindowCB);
468 winOptions.appendChild(box);
470 uiLayoutCtl(winOptions);
471 winOptions.centerInScreen();
472 end;
475 procedure toggleLayersWindow (arg: Integer=-1);
476 begin
477 if (arg < 0) then showLayersWindow := not showLayersWindow else showLayersWindow := (arg > 0);
478 showLayersWindow := not showLayersWindow; // hack for callback
479 toggleLayersWindowCB(nil);
480 end;
482 procedure toggleOutlineWindow (arg: Integer=-1);
483 begin
484 if (arg < 0) then showOutlineWindow := not showOutlineWindow else showOutlineWindow := (arg > 0);
485 showOutlineWindow := not showOutlineWindow; // hack for callback
486 toggleOutlineWindowCB(nil);
487 end;
489 procedure toggleHelpWindow (arg: Integer=-1);
490 begin
491 if (winHelp = nil) then createHelpWindow();
492 if (arg < 0) then begin if not uiVisibleWindow(winHelp) then uiAddWindow(winHelp) else uiRemoveWindow(winHelp); end
493 else if (arg = 0) then begin if uiVisibleWindow(winHelp) then uiRemoveWindow(winHelp); end
494 else begin if not uiVisibleWindow(winHelp) then uiAddWindow(winHelp); end
495 end;
497 procedure toggleOptionsWindow (arg: Integer=-1);
498 begin
499 if (winOptions = nil) then createOptionsWindow();
500 if (arg < 0) then begin if not uiVisibleWindow(winOptions) then uiAddWindow(winOptions) else uiRemoveWindow(winOptions); end
501 else if (arg = 0) then begin if uiVisibleWindow(winOptions) then uiRemoveWindow(winOptions); end
502 else begin if not uiVisibleWindow(winOptions) then uiAddWindow(winOptions); end
503 end;
506 // ////////////////////////////////////////////////////////////////////////// //
507 var
508 vpSet: Boolean = false;
509 vpx, vpy: Integer;
510 vpw, vph: Integer;
511 laserSet: Boolean = false;
512 laserX0, laserY0, laserX1, laserY1: Integer;
513 monMarkedUID: Integer = -1;
514 platMarkedGUID: Integer = -1;
517 procedure g_Holmes_plrViewPos (viewPortX, viewPortY: Integer);
518 begin
519 vpSet := true;
520 vpx := viewPortX;
521 vpy := viewPortY;
522 end;
524 procedure g_Holmes_plrViewSize (viewPortW, viewPortH: Integer);
525 begin
526 vpSet := true;
527 vpw := viewPortW;
528 vph := viewPortH;
529 end;
531 procedure g_Holmes_plrLaser (ax0, ay0, ax1, ay1: Integer);
532 begin
533 laserSet := true;
534 laserX0 := ax0;
535 laserY0 := ay0;
536 laserX1 := ax1;
537 laserY1 := ay1;
538 laserSet := laserSet; // shut up, fpc!
539 end;
542 function pmsCurMapX (): Integer; inline; begin result := round(msX/g_dbg_scale)+vpx; end;
543 function pmsCurMapY (): Integer; inline; begin result := round(msY/g_dbg_scale)+vpy; end;
546 {$IFDEF HOLMES_OLD_OUTLINES}
547 var
548 edgeBmp: array of Byte = nil;
551 procedure drawOutlines ();
552 var
553 r, g, b: Integer;
555 procedure clearEdgeBmp ();
556 begin
557 SetLength(edgeBmp, (gWinSizeX+4)*(gWinSizeY+4));
558 FillChar(edgeBmp[0], Length(edgeBmp)*sizeof(edgeBmp[0]), 0);
559 end;
561 procedure drawPanel (pan: TPanel);
562 var
563 sx, len, y0, y1: Integer;
564 begin
565 if (pan = nil) or (pan.Width < 1) or (pan.Height < 1) then exit;
566 if (pan.X+pan.Width <= vpx-1) or (pan.Y+pan.Height <= vpy-1) then exit;
567 if (pan.X >= vpx+vpw+1) or (pan.Y >= vpy+vph+1) then exit;
568 if g_ol_nice or g_ol_fill_walls then
569 begin
570 sx := pan.X-(vpx-1);
571 len := pan.Width;
572 if (len > gWinSizeX+4) then len := gWinSizeX+4;
573 if (sx < 0) then begin len += sx; sx := 0; end;
574 if (sx+len > gWinSizeX+4) then len := gWinSizeX+4-sx;
575 if (len < 1) then exit;
576 assert(sx >= 0);
577 assert(sx+len <= gWinSizeX+4);
578 y0 := pan.Y-(vpy-1);
579 y1 := y0+pan.Height;
580 if (y0 < 0) then y0 := 0;
581 if (y1 > gWinSizeY+4) then y1 := gWinSizeY+4;
582 while (y0 < y1) do
583 begin
584 FillChar(edgeBmp[y0*(gWinSizeX+4)+sx], len*sizeof(edgeBmp[0]), 1);
585 Inc(y0);
586 end;
587 end
588 else
589 begin
590 drawRect(pan.X, pan.Y, pan.Width, pan.Height, r, g, b);
591 end;
592 end;
594 var
595 lsx: Integer = -1;
596 lex: Integer = -1;
597 lsy: Integer = -1;
599 procedure flushLine ();
600 begin
601 if (lsy > 0) and (lsx > 0) then
602 begin
603 if (lex = lsx) then
604 begin
605 glBegin(GL_POINTS);
606 glVertex2f(lsx-1+vpx+0.37, lsy-1+vpy+0.37);
607 glEnd();
608 end
609 else
610 begin
611 glBegin(GL_LINES);
612 glVertex2f(lsx-1+vpx+0.37, lsy-1+vpy+0.37);
613 glVertex2f(lex-0+vpx+0.37, lsy-1+vpy+0.37);
614 glEnd();
615 end;
616 end;
617 lsx := -1;
618 lex := -1;
619 end;
621 procedure startLine (y: Integer);
622 begin
623 flushLine();
624 lsy := y;
625 end;
627 procedure putPixel (x: Integer);
628 begin
629 if (x < 1) then exit;
630 if (lex+1 <> x) then flushLine();
631 if (lsx < 0) then lsx := x;
632 lex := x;
633 end;
635 procedure drawEdges ();
636 var
637 x, y: Integer;
638 a: PByte;
639 begin
640 glDisable(GL_BLEND);
641 glDisable(GL_TEXTURE_2D);
642 glLineWidth(1);
643 glPointSize(1);
644 glDisable(GL_LINE_SMOOTH);
645 glDisable(GL_POLYGON_SMOOTH);
646 glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
647 for y := 1 to vph do
648 begin
649 a := @edgeBmp[y*(gWinSizeX+4)+1];
650 startLine(y);
651 for x := 1 to vpw do
652 begin
653 if (a[0] <> 0) then
654 begin
655 if (a[-1] = 0) or (a[1] = 0) or (a[-(gWinSizeX+4)] = 0) or (a[gWinSizeX+4] = 0) or
656 (a[-(gWinSizeX+4)-1] = 0) or (a[-(gWinSizeX+4)+1] = 0) or
657 (a[gWinSizeX+4-1] = 0) or (a[gWinSizeX+4+1] = 0) then
658 begin
659 putPixel(x);
660 end;
661 end;
662 Inc(a);
663 end;
664 flushLine();
665 end;
666 end;
668 procedure drawFilledWalls ();
669 var
670 x, y: Integer;
671 a: PByte;
672 begin
673 glDisable(GL_BLEND);
674 glDisable(GL_TEXTURE_2D);
675 glLineWidth(1);
676 glPointSize(1);
677 glDisable(GL_LINE_SMOOTH);
678 glDisable(GL_POLYGON_SMOOTH);
679 glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
680 for y := 1 to vph do
681 begin
682 a := @edgeBmp[y*(gWinSizeX+4)+1];
683 startLine(y);
684 for x := 1 to vpw do
685 begin
686 if (a[0] <> 0) then putPixel(x);
687 Inc(a);
688 end;
689 flushLine();
690 end;
691 end;
693 procedure doWallsOld (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
694 var
695 f: Integer;
696 pan: TPanel;
697 begin
698 r := ar;
699 g := ag;
700 b := ab;
701 if g_ol_nice or g_ol_fill_walls then clearEdgeBmp();
702 for f := 0 to High(parr) do
703 begin
704 pan := parr[f];
705 if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then continue;
706 if ((pan.PanelType and ptype) = 0) then continue;
707 drawPanel(pan);
708 end;
709 if g_ol_nice then drawEdges();
710 if g_ol_fill_walls then drawFilledWalls();
711 end;
713 var
714 xptag: Word;
716 function doWallCB (pan: TPanel; tag: Integer): Boolean;
717 begin
718 result := false; // don't stop
719 //if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then exit;
720 if ((pan.PanelType and xptag) = 0) then exit;
721 drawPanel(pan);
722 end;
724 procedure doWalls (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
725 begin
726 r := ar;
727 g := ag;
728 b := ab;
729 xptag := ptype;
730 if ((ptype and (PANEL_WALL or PANEL_OPENDOOR or PANEL_CLOSEDOOR)) <> 0) then ptype := GridTagWall or GridTagDoor
731 else panelTypeToTag(ptype);
732 if g_ol_nice or g_ol_fill_walls then clearEdgeBmp();
733 mapGrid.forEachInAABB(vpx-1, vpy-1, vpw+2, vph+2, doWallCB, ptype);
734 if g_ol_nice then drawEdges();
735 if g_ol_fill_walls then drawFilledWalls();
736 end;
738 begin
739 if g_ol_rlayer_back then doWallsOld(gRenderBackgrounds, PANEL_BACK, 255, 127, 0);
740 if g_ol_rlayer_step then doWallsOld(gSteps, PANEL_STEP, 192, 192, 192);
741 if g_ol_rlayer_wall then doWallsOld(gWalls, PANEL_WALL, 255, 255, 255);
742 if g_ol_rlayer_door then doWallsOld(gWalls, PANEL_OPENDOOR or PANEL_CLOSEDOOR, 0, 255, 0);
743 if g_ol_rlayer_acid1 then doWallsOld(gAcid1, PANEL_ACID1, 255, 0, 0);
744 if g_ol_rlayer_acid2 then doWallsOld(gAcid2, PANEL_ACID2, 198, 198, 0);
745 if g_ol_rlayer_water then doWallsOld(gWater, PANEL_WATER, 0, 255, 255);
746 if g_ol_rlayer_fore then doWallsOld(gRenderForegrounds, PANEL_FORE, 210, 210, 210);
747 end;
749 {$ELSE}
750 var
751 oliner: TOutliner = nil;
753 procedure drawOutlines ();
754 var
755 r, g, b: Integer;
757 procedure clearOliner ();
758 begin
759 //if (oliner <> nil) and ((oliner.height <> vph+2) or (oliner.width <> vpw+2)) then begin oliner.Free(); oliner := nil; end;
760 if (oliner = nil) then oliner := TOutliner.Create(vpw+2, vph+2) else oliner.setup(vpw+2, vph+2);
761 end;
763 procedure drawOutline (ol: TOutliner; sx, sy: Integer);
764 procedure xline (x0, x1, y: Integer);
765 var
766 x: Integer;
767 begin
768 if (g_dbg_scale < 1.0) then
769 begin
770 glBegin(GL_POINTS);
771 for x := x0 to x1 do glVertex2f(sx+x+0.375, sy+y+0.375);
772 glEnd();
773 end
774 else
775 begin
776 glBegin(GL_QUADS);
777 glVertex2f(sx+x0+0, sy+y+0);
778 glVertex2f(sx+x1+1, sy+y+0);
779 glVertex2f(sx+x1+1, sy+y+1);
780 glVertex2f(sx+x0+0, sy+y+1);
781 glEnd();
782 end;
783 end;
784 var
785 y: Integer;
786 sp: TOutliner.TSpanX;
787 begin
788 if (ol = nil) then exit;
789 glPointSize(1);
790 glDisable(GL_POINT_SMOOTH);
791 for y := 0 to ol.height-1 do
792 begin
793 for sp in ol.eachSpanAtY(y) do
794 begin
795 if (g_dbg_scale <= 1.0) then
796 begin
797 glBegin(GL_POINTS);
798 glVertex2f(sx+sp.x0+0.375, sy+y+0.375);
799 glVertex2f(sx+sp.x1+0.375, sy+y+0.375);
800 glEnd();
801 end
802 else
803 begin
804 glBegin(GL_QUADS);
805 glVertex2f(sx+sp.x0+0, sy+y+0);
806 glVertex2f(sx+sp.x0+1, sy+y+0);
807 glVertex2f(sx+sp.x0+1, sy+y+1);
808 glVertex2f(sx+sp.x0+0, sy+y+1);
810 glVertex2f(sx+sp.x1+0, sy+y+0);
811 glVertex2f(sx+sp.x1+1, sy+y+0);
812 glVertex2f(sx+sp.x1+1, sy+y+1);
813 glVertex2f(sx+sp.x1+0, sy+y+1);
814 glEnd();
815 end;
816 end;
817 for sp in ol.eachSpanEdgeAtY(y, -1) do
818 begin
819 xline(sp.x0, sp.x1, y);
821 glBegin(GL_QUADS);
822 glVertex2f(sx+sp.x0+0, sy+y+0);
823 glVertex2f(sx+sp.x1+1, sy+y+0);
824 glVertex2f(sx+sp.x1+1, sy+y+1);
825 glVertex2f(sx+sp.x0+0, sy+y+1);
826 glEnd();
828 end;
829 for sp in ol.eachSpanEdgeAtY(y, +1) do
830 begin
831 xline(sp.x0, sp.x1, y);
833 glBegin(GL_QUADS);
834 glVertex2f(sx+sp.x0+0, sy+y+0);
835 glVertex2f(sx+sp.x1+1, sy+y+0);
836 glVertex2f(sx+sp.x1+1, sy+y+1);
837 glVertex2f(sx+sp.x0+0, sy+y+1);
838 glEnd();
840 end;
841 end;
842 end;
844 procedure doWallsOld (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
845 var
846 f: Integer;
847 pan: TPanel;
848 begin
849 r := ar;
850 g := ag;
851 b := ab;
852 if g_ol_nice then clearOliner();
853 hlmContext.color := TGxRGBA.Create(r, g, b);
854 for f := 0 to High(parr) do
855 begin
856 pan := parr[f];
857 if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then continue;
858 if ((pan.PanelType and ptype) = 0) then continue;
859 if (pan.X > vpx+vpw+41) or (pan.Y > vpy+vph+41) then continue;
860 if (pan.X+pan.Width < vpx-41) then continue;
861 if (pan.Y+pan.Height < vpy-41) then continue;
862 if g_ol_nice then
863 begin
864 oliner.addRect(pan.X-(vpx+1), pan.Y-(vpy+1), pan.Width, pan.Height);
865 end;
866 if g_ol_fill_walls then
867 begin
868 hlmContext.fillRect(pan.X, pan.Y, pan.Width, pan.Height);
869 end
870 else if not g_ol_nice then
871 begin
872 hlmContext.rect(pan.X, pan.Y, pan.Width, pan.Height);
873 end;
874 end;
875 if g_ol_nice then
876 begin
877 glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
878 drawOutline(oliner, vpx+1, vpy+1);
879 end;
880 end;
882 begin
883 if (vpw < 2) or (vph < 2) then exit;
884 if g_ol_rlayer_back then doWallsOld(gRenderBackgrounds, PANEL_BACK, 255, 127, 0);
885 if g_ol_rlayer_step then doWallsOld(gSteps, PANEL_STEP, 192, 192, 192);
886 if g_ol_rlayer_wall then doWallsOld(gWalls, PANEL_WALL, 255, 255, 255);
887 if g_ol_rlayer_door then doWallsOld(gWalls, PANEL_OPENDOOR or PANEL_CLOSEDOOR, 0, 255, 0);
888 if g_ol_rlayer_acid1 then doWallsOld(gAcid1, PANEL_ACID1, 255, 0, 0);
889 if g_ol_rlayer_acid2 then doWallsOld(gAcid2, PANEL_ACID2, 198, 198, 0);
890 if g_ol_rlayer_water then doWallsOld(gWater, PANEL_WATER, 0, 255, 255);
891 if g_ol_rlayer_fore then doWallsOld(gRenderForegrounds, PANEL_FORE, 210, 210, 210);
892 end;
893 {$ENDIF}
896 procedure plrDebugDraw ();
897 procedure drawTileGrid ();
898 var
899 x, y: Integer;
900 begin
901 hlmContext.color := TGxRGBA.Create(96, 96, 96);
902 for y := 0 to (mapGrid.gridHeight div mapGrid.tileSize) do
903 begin
904 hlmContext.line(mapGrid.gridX0, mapGrid.gridY0+y*mapGrid.tileSize, mapGrid.gridX0+mapGrid.gridWidth, mapGrid.gridY0+y*mapGrid.tileSize);
905 end;
907 hlmContext.color := TGxRGBA.Create(96, 96, 96);
908 for x := 0 to (mapGrid.gridWidth div mapGrid.tileSize) do
909 begin
910 hlmContext.line(mapGrid.gridX0+x*mapGrid.tileSize, mapGrid.gridY0, mapGrid.gridX0+x*mapGrid.tileSize, mapGrid.gridY0+y*mapGrid.gridHeight);
911 end;
912 end;
914 procedure drawAwakeCells ();
915 var
916 x, y: Integer;
917 begin
918 hlmContext.color := TGxRGBA.Create(128, 0, 128, 64);
919 for y := 0 to (mapGrid.gridHeight div mapGrid.tileSize) do
920 begin
921 for x := 0 to (mapGrid.gridWidth div mapGrid.tileSize) do
922 begin
923 if awmIsSetHolmes(x*mapGrid.tileSize+mapGrid.gridX0+1, y*mapGrid.tileSize++mapGrid.gridY0+1) then
924 begin
925 hlmContext.fillRect(x*mapGrid.tileSize++mapGrid.gridX0, y*mapGrid.tileSize++mapGrid.gridY0, monsGrid.tileSize, monsGrid.tileSize);
926 end;
927 end;
928 end;
929 end;
931 procedure drawTraceBox ();
932 var
933 plr: TPlayer;
934 px, py, pw, ph: Integer;
935 pdx, pdy: Integer;
936 ex, ey: Integer;
937 pan: TPanel;
938 begin
939 if (Length(gPlayers) < 1) then exit;
940 plr := gPlayers[0];
941 if (plr = nil) then exit;
942 plr.getMapBox(px, py, pw, ph);
943 hlmContext.color := TGxRGBA.Create(255, 0, 255, 200);
944 hlmContext.rect(px, py, pw, ph);
945 pdx := pmsCurMapX-(px+pw div 2);
946 pdy := pmsCurMapY-(py+ph div 2);
947 hlmContext.color := TGxRGBA.Create(255, 0, 255, 200);
948 hlmContext.line(px+pw div 2, py+ph div 2, px+pw div 2+pdx, py+ph div 2+pdy);
949 pan := mapGrid.traceBox(ex, ey, px, py, pw, ph, pdx, pdy, nil, GridTagObstacle);
950 if (pan = nil) then
951 begin
952 hlmContext.color := TGxRGBA.Create(255, 255, 255, 180);
953 hlmContext.rect(px+pdx, py+pdy, pw, ph);
954 end
955 else
956 begin
957 hlmContext.color := TGxRGBA.Create(255, 255, 0, 180);
958 hlmContext.rect(px+pdx, py+pdy, pw, ph);
959 end;
960 hlmContext.color := TGxRGBA.Create(255, 127, 0, 180);
961 hlmContext.rect(ex, ey, pw, ph);
962 end;
964 procedure hilightCell (cx, cy: Integer);
965 begin
966 hlmContext.color := TGxRGBA.Create(0, 128, 0, 64);
967 hlmContext.fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize);
968 end;
970 procedure hilightCell1 (cx, cy: Integer);
971 begin
972 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
973 cx := cx and (not (monsGrid.tileSize-1));
974 cy := cy and (not (monsGrid.tileSize-1));
975 hlmContext.color := TGxRGBA.Create(255, 255, 0, 92);
976 hlmContext.fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize);
977 end;
979 function hilightWallTrc (pan: TPanel; tag: Integer; x, y, prevx, prevy: Integer): Boolean;
980 begin
981 result := false; // don't stop
982 if (pan = nil) then exit; // cell completion, ignore
983 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
984 hlmContext.color := TGxRGBA.Create(0, 128, 128, 64);
985 hlmContext.fillRect(pan.X, pan.Y, pan.Width, pan.Height);
986 end;
988 function monsCollector (mon: TMonster; tag: Integer): Boolean;
989 var
990 ex, ey: Integer;
991 mx, my, mw, mh: Integer;
992 begin
993 result := false;
994 mon.getMapBox(mx, my, mw, mh);
995 hlmContext.color := TGxRGBA.Create(255, 255, 0, 160);
996 hlmContext.rect(mx, my, mw, mh);
997 //e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 255, 0, 96);
998 if lineAABBIntersects(laserX0, laserY0, laserX1, laserY1, mx, my, mw, mh, ex, ey) then
999 begin
1000 //e_DrawPoint(8, ex, ey, 0, 255, 0);
1001 hlmContext.color := TGxRGBA.Create(0, 255, 0, 220);
1002 hlmContext.fillRect(ex-2, ey-2, 7, 7);
1003 end;
1004 end;
1006 procedure drawMonsterInfo (mon: TMonster);
1007 var
1008 mx, my, mw, mh: Integer;
1010 procedure drawMonsterTargetLine ();
1011 var
1012 emx, emy, emw, emh: Integer;
1013 enemy: TMonster;
1014 eplr: TPlayer;
1015 ex, ey: Integer;
1016 begin
1017 if (g_GetUIDType(mon.MonsterTargetUID) = UID_PLAYER) then
1018 begin
1019 eplr := g_Player_Get(mon.MonsterTargetUID);
1020 if (eplr <> nil) then eplr.getMapBox(emx, emy, emw, emh) else exit;
1021 end
1022 else if (g_GetUIDType(mon.MonsterTargetUID) = UID_MONSTER) then
1023 begin
1024 enemy := g_Monsters_ByUID(mon.MonsterTargetUID);
1025 if (enemy <> nil) then enemy.getMapBox(emx, emy, emw, emh) else exit;
1026 end
1027 else
1028 begin
1029 exit;
1030 end;
1031 mon.getMapBox(mx, my, mw, mh);
1032 hlmContext.color := TGxRGBA.Create(255, 0, 0);
1033 hlmContext.line(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2);
1034 if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
1035 begin
1036 hlmContext.color := TGxRGBA.Create(0, 255, 0);
1037 hlmContext.line(mx+mw div 2, my+mh div 2, ex, ey);
1038 end;
1039 end;
1041 procedure drawLOS2Plr ();
1042 var
1043 emx, emy, emw, emh: Integer;
1044 eplr: TPlayer;
1045 ex, ey: Integer;
1046 begin
1047 eplr := gPlayers[0];
1048 if (eplr = nil) then exit;
1049 eplr.getMapBox(emx, emy, emw, emh);
1050 mon.getMapBox(mx, my, mw, mh);
1051 hlmContext.color := TGxRGBA.Create(255, 0, 0);
1052 hlmContext.line(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2);
1053 {$IF DEFINED(D2F_DEBUG)}
1054 mapGrid.dbgRayTraceTileHitCB := hilightCell1;
1055 {$ENDIF}
1056 if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
1057 //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
1058 begin
1059 hlmContext.color := TGxRGBA.Create(0, 255, 0);
1060 hlmContext.line(mx+mw div 2, my+mh div 2, ex, ey);
1061 end;
1062 {$IF DEFINED(D2F_DEBUG)}
1063 mapGrid.dbgRayTraceTileHitCB := nil;
1064 {$ENDIF}
1065 end;
1067 begin
1068 if (mon = nil) then exit;
1069 mon.getMapBox(mx, my, mw, mh);
1070 //mx += mw div 2;
1072 monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
1074 if showMonsInfo then
1075 begin
1076 //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
1077 hlmContext.font := 'msx6';
1078 hlmContext.color := TGxRGBA.Create(255, 127, 0);
1080 hlmContext.darkenRect(mx-4, my-7*hlmContext.charWidth(' ')-6, 110, 7*hlmContext.charWidth(' ')+6, 128);
1081 my -= 8;
1082 my -= 2;
1084 // type
1085 hlmContext.drawText(mx, my, Format('%s(U:%u)', [monsTypeToString(mon.MonsterType), mon.UID])); my -= hlmContext.charWidth(' ');
1086 // beh
1087 hlmContext.drawText(mx, my, Format('Beh: %s', [monsBehToString(mon.MonsterBehaviour)])); my -= hlmContext.charWidth(' ');
1088 // state
1089 hlmContext.drawText(mx, my, Format('State:%s (%d)', [monsStateToString(mon.MonsterState), mon.MonsterSleep])); my -= hlmContext.charWidth(' ');
1090 // health
1091 hlmContext.drawText(mx, my, Format('Health:%d', [mon.MonsterHealth])); my -= hlmContext.charWidth(' ');
1092 // ammo
1093 hlmContext.drawText(mx, my, Format('Ammo:%d', [mon.MonsterAmmo])); my -= hlmContext.charWidth(' ');
1094 // target
1095 hlmContext.drawText(mx, my, Format('TgtUID:%u', [mon.MonsterTargetUID])); my -= hlmContext.charWidth(' ');
1096 hlmContext.drawText(mx, my, Format('TgtTime:%d', [mon.MonsterTargetTime])); my -= hlmContext.charWidth(' ');
1097 end;
1099 drawMonsterTargetLine();
1100 if showMonsLOS2Plr then drawLOS2Plr();
1102 property MonsterRemoved: Boolean read FRemoved write FRemoved;
1103 property MonsterPain: Integer read FPain write FPain;
1104 property MonsterAnim: Byte read FCurAnim write FCurAnim;
1106 end;
1108 function highlightAllMonsterCells (mon: TMonster): Boolean;
1109 begin
1110 result := false; // don't stop
1111 monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
1112 end;
1114 procedure drawSelectedPlatformCells ();
1115 var
1116 pan: TPanel;
1117 begin
1118 if not showGrid then exit;
1119 pan := g_Map_PanelByGUID(platMarkedGUID);
1120 if (pan = nil) then exit;
1121 mapGrid.forEachBodyCell(pan.proxyId, hilightCell);
1122 hlmContext.color := TGxRGBA.Create(0, 200, 0, 200);
1123 hlmContext.rect(pan.x, pan.y, pan.width, pan.height);
1124 end;
1126 procedure drawTrigger (var trig: TTrigger);
1128 procedure drawPanelDest (pguid: Integer);
1129 var
1130 pan: TPanel;
1131 begin
1132 pan := g_Map_PanelByGUID(pguid);
1133 if (pan = nil) then exit;
1134 hlmContext.color := TGxRGBA.Create(255, 0, 255, 220);
1135 hlmContext.line(trig.trigCenter.x, trig.trigCenter.y, pan.x+pan.width div 2, pan.y+pan.height div 2);
1136 end;
1138 var
1139 tts: AnsiString;
1140 tx: Integer;
1141 begin
1142 hlmContext.font := 'msx6';
1143 hlmContext.color := TGxRGBA.Create(255, 0, 255, 96);
1144 hlmContext.fillRect(trig.x, trig.y, trig.width, trig.height);
1145 tts := trigType2Str(trig.TriggerType);
1146 tx := trig.x+(trig.width-Length(tts)*6) div 2;
1147 hlmContext.darkenRect(tx-2, trig.y-10, Length(tts)*6+4, 10, 64);
1148 hlmContext.color := TGxRGBA.Create(255, 127, 0);
1149 hlmContext.drawText(tx, trig.y-9, tts);
1150 tx := trig.x+(trig.width-Length(trig.mapId)*6) div 2;
1151 hlmContext.darkenRect(tx-2, trig.y-20, Length(trig.mapId)*6+4, 10, 64);
1152 hlmContext.color := TGxRGBA.Create(255, 255, 0);
1153 hlmContext.drawText(tx, trig.y-19, trig.mapId);
1154 drawPanelDest(trig.trigPanelGUID);
1155 case trig.TriggerType of
1156 TRIGGER_NONE: begin end;
1157 TRIGGER_EXIT: begin end;
1158 TRIGGER_TELEPORT: begin end;
1159 TRIGGER_OPENDOOR: begin end;
1160 TRIGGER_CLOSEDOOR: begin end;
1161 TRIGGER_DOOR: begin end;
1162 TRIGGER_DOOR5: begin end;
1163 TRIGGER_CLOSETRAP: begin end;
1164 TRIGGER_TRAP: begin end;
1165 TRIGGER_SECRET: begin end;
1166 TRIGGER_LIFTUP: begin end;
1167 TRIGGER_LIFTDOWN: begin end;
1168 TRIGGER_LIFT: begin end;
1169 TRIGGER_TEXTURE: begin end;
1170 TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF, TRIGGER_PRESS:
1171 begin
1172 if (trig.trigDataRec.trigTWidth > 0) and (trig.trigDataRec.trigTHeight > 0) then
1173 begin
1174 hlmContext.color := TGxRGBA.Create(0, 255, 255, 42);
1175 hlmContext.fillRect(
1176 trig.trigDataRec.trigTX, trig.trigDataRec.trigTY,
1177 trig.trigDataRec.trigTWidth, trig.trigDataRec.trigTHeight);
1178 hlmContext.color := TGxRGBA.Create(255, 0, 255, 220);
1179 hlmContext.line(
1180 trig.trigCenter.x, trig.trigCenter.y,
1181 trig.trigDataRec.trigTX+trig.trigDataRec.trigTWidth div 2,
1182 trig.trigDataRec.trigTY+trig.trigDataRec.trigTHeight div 2);
1183 end;
1184 end;
1185 TRIGGER_SOUND: begin end;
1186 TRIGGER_SPAWNMONSTER: begin end;
1187 TRIGGER_SPAWNITEM: begin end;
1188 TRIGGER_MUSIC: begin end;
1189 TRIGGER_PUSH: begin end;
1190 TRIGGER_SCORE: begin end;
1191 TRIGGER_MESSAGE: begin end;
1192 TRIGGER_DAMAGE: begin end;
1193 TRIGGER_HEALTH: begin end;
1194 TRIGGER_SHOT: begin end;
1195 TRIGGER_EFFECT: begin end;
1196 TRIGGER_SCRIPT: begin end;
1197 end;
1198 //trigType2Str
1199 //trigPanelId: Integer;
1200 end;
1202 procedure drawTriggers ();
1203 var
1204 f: Integer;
1205 begin
1206 for f := 0 to High(gTriggers) do drawTrigger(gTriggers[f]);
1207 end;
1209 procedure drawGibsBoxes ();
1210 var
1211 f: Integer;
1212 px, py, pw, ph: Integer;
1213 gib: PGib;
1214 begin
1215 for f := 0 to High(gGibs) do
1216 begin
1217 gib := @gGibs[f];
1218 if gib.alive then
1219 begin
1220 gib.getMapBox(px, py, pw, ph);
1221 hlmContext.color := TGxRGBA.Create(255, 0, 255);
1222 hlmContext.rect(px, py, pw, ph);
1223 end;
1224 end;
1225 end;
1227 var
1228 mon: TMonster;
1229 mx, my, mw, mh: Integer;
1230 //pan: TPanel;
1231 //ex, ey: Integer;
1232 begin
1233 if (gPlayer1 = nil) then exit;
1235 if (hlmContext = nil) then hlmContext := TGxContext.Create();
1237 gxSetContext(hlmContext);
1238 try
1239 //glScissor(0, gWinSizeY-gPlayerScreenSize.Y-1, vpw, vph);
1240 //hlmContext.clip := TGxRect.Create(0, gScreenHeight-gPlayerScreenSize.Y-1, gPlayerScreenSize.X, gPlayerScreenSize.Y);
1243 glScalef(g_dbg_scale, g_dbg_scale, 1.0);
1244 glTranslatef(-vpx, -vpy, 0);
1246 hlmContext.glSetScaleTrans(g_dbg_scale, -vpx, -vpy);
1247 glEnable(GL_SCISSOR_TEST);
1248 glScissor(0, gScreenHeight-gPlayerScreenSize.Y-1, gPlayerScreenSize.X, gPlayerScreenSize.Y);
1250 if (showGrid) then drawTileGrid();
1251 drawOutlines();
1253 if (laserSet) then g_Mons_AlongLine(laserX0, laserY0, laserX1, laserY1, monsCollector, true);
1255 if (monMarkedUID <> -1) then
1256 begin
1257 mon := g_Monsters_ByUID(monMarkedUID);
1258 if (mon <> nil) then
1259 begin
1260 mon.getMapBox(mx, my, mw, mh);
1261 //e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 0, 0, 30);
1262 hlmContext.color := TGxRGBA.Create(255, 0, 0, 220);
1263 hlmContext.rect(mx, my, mw, mh);
1264 drawMonsterInfo(mon);
1265 end;
1266 end;
1268 if showAllMonsCells and showGrid then g_Mons_ForEach(highlightAllMonsterCells);
1269 if showTriggers then drawTriggers();
1270 if showGrid then drawSelectedPlatformCells();
1272 //drawAwakeCells();
1274 if showTraceBox then drawTraceBox();
1276 //drawGibsBoxes();
1279 //pan := g_Map_traceToNearest(16, 608, 16, 8, (GridTagObstacle or GridTagLiquid), @ex, @ey);
1280 (*
1281 {$IF DEFINED(D2F_DEBUG)}
1282 mapGrid.dbgRayTraceTileHitCB := hilightCell1;
1283 {$ENDIF}
1284 pan := mapGrid.traceRay(ex, ey, 16, 608, 16, 8, nil, (GridTagObstacle or GridTagLiquid));
1285 if (pan <> nil) then writeln('end=(', ex, ',', ey, ')');
1286 {$IF DEFINED(D2F_DEBUG)}
1287 mapGrid.dbgRayTraceTileHitCB := nil;
1288 {$ENDIF}
1290 pan := g_Map_PanelAtPoint(16, 608, (GridTagObstacle or GridTagLiquid));
1291 if (pan <> nil) then writeln('hit!');
1292 *)
1294 finally
1295 gxSetContext(nil);
1296 end;
1298 if showMapCurPos then
1299 begin
1300 gxSetContext(hlmContext);
1301 hlmContext.font := 'win8';
1302 hlmContext.color := TGxRGBA.Create(255, 255, 0);
1303 hlmContext.drawText(4, gWinSizeY-10, Format('mappos:(%d,%d)', [pmsCurMapX, pmsCurMapY]));
1304 gxSetContext(nil);
1305 end;
1306 end;
1309 // ////////////////////////////////////////////////////////////////////////// //
1310 procedure onKeyEvent (var ev: TFUIEvent);
1311 {$IF DEFINED(D2F_DEBUG)}
1312 var
1313 pan: TPanel;
1314 ex, ey: Integer;
1315 dx, dy: Integer;
1316 {$ENDIF}
1318 procedure dummyWallTrc (cx, cy: Integer);
1319 begin
1320 end;
1322 begin
1323 // press
1324 if (ev.press) then
1325 begin
1326 {$IF DEFINED(D2F_DEBUG)}
1327 // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction
1328 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
1329 ((ev.kstate and TFUIEvent.ModCtrl) <> 0) then
1330 begin
1331 ev.eat();
1332 dx := pmsCurMapX;
1333 dy := pmsCurMapY;
1334 case ev.scan of
1335 SDL_SCANCODE_UP: dy -= 120;
1336 SDL_SCANCODE_DOWN: dy += 120;
1337 SDL_SCANCODE_LEFT: dx -= 120;
1338 SDL_SCANCODE_RIGHT: dx += 120;
1339 end;
1340 {$IF DEFINED(D2F_DEBUG)}
1341 //mapGrid.dbgRayTraceTileHitCB := dummyWallTrc;
1342 mapGrid.dbgShowTraceLog := true;
1343 {$ENDIF}
1344 pan := g_Map_traceToNearest(pmsCurMapX, pmsCurMapY, dx, dy, (GridTagWall or GridTagDoor or GridTagStep or GridTagAcid1 or GridTagAcid2 or GridTagWater), @ex, @ey);
1345 {$IF DEFINED(D2F_DEBUG)}
1346 //mapGrid.dbgRayTraceTileHitCB := nil;
1347 mapGrid.dbgShowTraceLog := false;
1348 {$ENDIF}
1349 e_LogWritefln('v-trace: (%d,%d)-(%d,%d); end=(%d,%d); hit=%d', [pmsCurMapX, pmsCurMapY, dx, dy, ex, ey, (pan <> nil)]);
1350 exit;
1351 end;
1352 {$ENDIF}
1353 end;
1354 end;
1357 // ////////////////////////////////////////////////////////////////////////// //
1358 procedure g_Holmes_OnEvent (var ev: TFUIEvent);
1359 {$IF not DEFINED(HEADLESS)}
1360 var
1361 doeat: Boolean = false;
1362 {$ENDIF}
1363 begin
1364 {$IF not DEFINED(HEADLESS)}
1365 if g_Game_IsNet then exit;
1366 if not g_holmes_enabled then exit;
1367 if g_holmes_imfunctional then exit;
1369 holmesInitCommands();
1370 holmesInitBinds();
1372 msB := ev.bstate;
1373 kbS := ev.kstate;
1375 if (ev.key) then
1376 begin
1377 case ev.scan of
1378 SDL_SCANCODE_LCTRL, SDL_SCANCODE_RCTRL,
1379 SDL_SCANCODE_LALT, SDL_SCANCODE_RALT,
1380 SDL_SCANCODE_LSHIFT, SDL_SCANCODE_RSHIFT:
1381 doeat := true;
1382 end;
1383 end
1384 else if (ev.mouse) then
1385 begin
1386 msX := ev.x;
1387 msY := ev.y;
1388 msB := ev.bstate;
1389 kbS := ev.kstate;
1390 msB := msB;
1391 end;
1393 uiDispatchEvent(ev);
1394 if (not ev.alive) then exit;
1396 if (ev.mouse) then
1397 begin
1398 if (gPlayer1 <> nil) and (vpSet) then msbindExecute(ev);
1399 ev.eat();
1400 end
1401 else
1402 begin
1403 if keybindExecute(ev) then ev.eat();
1404 if (ev.alive) then onKeyEvent(ev);
1405 end;
1407 if (doeat) then ev.eat();
1408 {$ENDIF}
1409 end;
1412 // ////////////////////////////////////////////////////////////////////////// //
1413 procedure g_Holmes_Draw ();
1414 begin
1415 if g_Game_IsNet then exit;
1416 if not g_holmes_enabled then exit;
1417 if g_holmes_imfunctional then exit;
1419 {$IF not DEFINED(HEADLESS)}
1420 holmesInitCommands();
1421 holmesInitBinds();
1423 glColorMask(GL_TRUE, GL_TRUE, GL_TRUE, GL_TRUE); // modify color buffer
1424 glDisable(GL_STENCIL_TEST);
1425 glDisable(GL_BLEND);
1426 glDisable(GL_SCISSOR_TEST);
1427 glDisable(GL_TEXTURE_2D);
1429 if gGameOn then plrDebugDraw();
1430 {$ENDIF}
1432 laserSet := false;
1433 end;
1436 procedure g_Holmes_DrawUI ();
1437 begin
1438 if g_Game_IsNet then exit;
1439 if not g_holmes_enabled then exit;
1440 if g_holmes_imfunctional then exit;
1442 {$IF not DEFINED(HEADLESS)}
1443 gGfxDoClear := false;
1444 //if assigned(prerenderFrameCB) then prerenderFrameCB();
1445 uiDraw();
1446 glMatrixMode(GL_MODELVIEW);
1447 glPushMatrix();
1448 try
1449 //glLoadIdentity();
1450 if assigned(postrenderFrameCB) then postrenderFrameCB();
1451 finally
1452 glPopMatrix();
1453 end;
1454 {$ENDIF}
1455 end;
1458 // ////////////////////////////////////////////////////////////////////////// //
1459 procedure bcOneMonsterThinkStep (); begin gmon_debug_think := false; gmon_debug_one_think_step := true; end;
1460 procedure bcOneMPlatThinkStep (); begin g_dbgpan_mplat_active := false; g_dbgpan_mplat_step := true; end;
1461 procedure bcMPlatToggle (); begin g_dbgpan_mplat_active := not g_dbgpan_mplat_active; end;
1463 procedure bcToggleMonsterInfo (arg: Integer=-1); begin if (arg < 0) then showMonsInfo := not showMonsInfo else showMonsInfo := (arg > 0); end;
1464 procedure bcToggleMonsterLOSPlr (arg: Integer=-1); begin if (arg < 0) then showMonsLOS2Plr := not showMonsLOS2Plr else showMonsLOS2Plr := (arg > 0); end;
1465 procedure bcToggleMonsterCells (arg: Integer=-1); begin if (arg < 0) then showAllMonsCells := not showAllMonsCells else showAllMonsCells := (arg > 0); end;
1466 procedure bcToggleDrawTriggers (arg: Integer=-1); begin if (arg < 0) then showTriggers := not showTriggers else showTriggers := (arg > 0); end;
1468 procedure bcToggleCurPos (arg: Integer=-1); begin if (arg < 0) then showMapCurPos := not showMapCurPos else showMapCurPos := (arg > 0); end;
1469 procedure bcToggleGrid (arg: Integer=-1); begin if (arg < 0) then showGrid := not showGrid else showGrid := (arg > 0); end;
1471 procedure bcMonsterSpawn (s: AnsiString);
1472 var
1473 mon: TMonster;
1474 begin
1475 if not gGameOn or g_Game_IsClient then
1476 begin
1477 conwriteln('cannot spawn monster in this mode');
1478 exit;
1479 end;
1480 mon := g_Mons_SpawnAt(s, pmsCurMapX, pmsCurMapY);
1481 if (mon = nil) then begin conwritefln('unknown monster id: ''%s''', [s]); exit; end;
1482 monMarkedUID := mon.UID;
1483 end;
1485 procedure bcMonsterWakeup ();
1486 var
1487 mon: TMonster;
1488 begin
1489 if (monMarkedUID <> -1) then
1490 begin
1491 mon := g_Monsters_ByUID(monMarkedUID);
1492 if (mon <> nil) then mon.WakeUp();
1493 end;
1494 end;
1496 procedure bcPlayerTeleport ();
1497 var
1498 x, y, w, h: Integer;
1499 begin
1500 //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY);
1501 if (gPlayers[0] <> nil) then
1502 begin
1503 gPlayers[0].getMapBox(x, y, w, h);
1504 gPlayers[0].TeleportTo(pmsCurMapX-w div 2, pmsCurMapY-h div 2, true, 69); // 69: don't change dir
1505 end;
1506 end;
1508 procedure dbgToggleTraceBox (arg: Integer=-1); begin if (arg < 0) then showTraceBox := not showTraceBox else showTraceBox := (arg > 0); end;
1510 procedure dbgToggleHolmesPause (arg: Integer=-1); begin if (arg < 0) then g_Game_HolmesPause(not gPauseHolmes) else g_Game_HolmesPause(arg > 0); end;
1512 procedure cbAtcurSelectMonster ();
1513 function monsAtDump (mon: TMonster; tag: Integer): Boolean;
1514 begin
1515 result := true; // stop
1516 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), TMsgType.Notify);
1517 monMarkedUID := mon.UID;
1518 dumpPublishedProperties(mon);
1519 end;
1520 var
1521 plr: TPlayer;
1522 x, y, w, h: Integer;
1523 begin
1524 monMarkedUID := -1;
1525 if (Length(gPlayers) > 0) then
1526 begin
1527 plr := gPlayers[0];
1528 if (plr <> nil) then
1529 begin
1530 plr.getMapBox(x, y, w, h);
1531 if (pmsCurMapX >= x) and (pmsCurMapY >= y) and (pmsCurMapX < x+w) and (pmsCurMapY < y+h) then
1532 begin
1533 dumpPublishedProperties(plr);
1534 end;
1535 end;
1536 end;
1537 //e_WriteLog('===========================', MSG_NOTIFY);
1538 monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump);
1539 //e_WriteLog('---------------------------', MSG_NOTIFY);
1540 end;
1542 procedure cbAtcurDumpMonsters ();
1543 function monsAtDump (mon: TMonster; tag: Integer): Boolean;
1544 begin
1545 result := false; // don't stop
1546 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), TMsgType.Notify);
1547 end;
1548 begin
1549 e_WriteLog('===========================', TMsgType.Notify);
1550 monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump);
1551 e_WriteLog('---------------------------', TMsgType.Notify);
1552 end;
1554 procedure cbAtcurDumpWalls ();
1555 function wallToggle (pan: TPanel; tag: Integer): Boolean;
1556 begin
1557 result := false; // don't stop
1558 if (platMarkedGUID = -1) then platMarkedGUID := pan.guid;
1559 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]);
1560 dumpPublishedProperties(pan);
1561 end;
1562 var
1563 hasTrigs: Boolean = false;
1564 f: Integer;
1565 trig: PTrigger;
1566 begin
1567 platMarkedGUID := -1;
1568 e_WriteLog('=== TOGGLE WALL ===', TMsgType.Notify);
1569 mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor));
1570 e_WriteLog('--- toggle wall ---', TMsgType.Notify);
1571 if showTriggers then
1572 begin
1573 for f := 0 to High(gTriggers) do
1574 begin
1575 trig := @gTriggers[f];
1576 if (pmsCurMapX >= trig.x) and (pmsCurMapY >= trig.y) and (pmsCurMapX < trig.x+trig.width) and (pmsCurMapY < trig.y+trig.height) then
1577 begin
1578 if not hasTrigs then begin writeln('=== TRIGGERS ==='); hasTrigs := true; end;
1579 writeln('trigger ''', trig.mapId, ''' of type ''', trigType2Str(trig.TriggerType), '''');
1580 end;
1581 end;
1582 if hasTrigs then writeln('--- triggers ---');
1583 end;
1584 end;
1586 procedure cbAtcurToggleWalls ();
1587 function wallToggle (pan: TPanel; tag: Integer): Boolean;
1588 begin
1589 result := false; // don't stop
1590 //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);
1591 if pan.Enabled then g_Map_DisableWallGUID(pan.guid) else g_Map_EnableWallGUID(pan.guid);
1592 end;
1593 begin
1594 //e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
1595 mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor));
1596 //e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
1597 end;
1600 // ////////////////////////////////////////////////////////////////////////// //
1601 procedure holmesInitCommands ();
1602 begin
1603 if (cmdlist <> nil) then exit;
1604 cmdAdd('win_layers', toggleLayersWindow, 'toggle layers window', 'window control');
1605 cmdAdd('win_outline', toggleOutlineWindow, 'toggle outline window', 'window control');
1606 cmdAdd('win_help', toggleHelpWindow, 'toggle help window', 'window control');
1607 cmdAdd('win_options', toggleOptionsWindow, 'toggle options window', 'window control');
1609 cmdAdd('mon_think_step', bcOneMonsterThinkStep, 'one monster think step', 'monster control');
1610 cmdAdd('mon_info', bcToggleMonsterInfo, 'toggle monster info', 'monster control');
1611 cmdAdd('mon_los_plr', bcToggleMonsterLOSPlr, 'toggle monster LOS to player', 'monster control');
1612 cmdAdd('mon_cells', bcToggleMonsterCells, 'toggle "show all cells occupied by monsters" (SLOW!)', 'monster control');
1613 cmdAdd('mon_wakeup', bcMonsterWakeup, 'wake up selected monster', 'monster control');
1615 cmdAdd('mon_spawn', bcMonsterSpawn, 'spawn monster', 'monster control');
1617 cmdAdd('mplat_step', bcOneMPlatThinkStep, 'one mplat think step', 'mplat control');
1618 cmdAdd('mplat_toggle', bcMPlatToggle, 'activate/deactivate moving platforms', 'mplat control');
1620 cmdAdd('plr_teleport', bcPlayerTeleport, 'teleport player', 'player control');
1622 cmdAdd('dbg_curpos', bcToggleCurPos, 'toggle "show cursor position on the map"', 'various');
1623 cmdAdd('dbg_grid', bcToggleGrid, 'toggle grid', 'various');
1624 cmdAdd('dbg_triggers', bcToggleDrawTriggers, 'show/hide triggers (SLOW!)', 'various');
1626 cmdAdd('atcur_select_monster', cbAtcurSelectMonster, 'select monster to operate', 'monster control');
1627 cmdAdd('atcur_dump_monsters', cbAtcurDumpMonsters, 'dump monsters in cell', 'monster control');
1628 cmdAdd('atcur_dump_walls', cbAtcurDumpWalls, 'dump walls in cell', 'wall control');
1629 cmdAdd('atcur_disable_walls', cbAtcurToggleWalls, 'disable walls', 'wall control');
1631 cmdAdd('dbg_tracebox', dbgToggleTraceBox, 'test traceBox()', 'player control');
1633 cmdAdd('hlm_pause', dbgToggleHolmesPause, '"Holmes" pause mode', 'game control');
1634 end;
1637 procedure holmesInitBinds ();
1638 var
1639 st: TStream = nil;
1640 pr: TTextParser = nil;
1641 s, kn, v: AnsiString;
1642 kmods: Byte;
1643 mbuts: Byte;
1644 begin
1645 kbS := kbS;
1646 if not keybindsInited then
1647 begin
1648 // keyboard
1649 keybindAdd('F1', 'win_help');
1650 keybindAdd('M-F1', 'win_options');
1651 keybindAdd('C-O', 'win_outline');
1652 keybindAdd('C-L', 'win_layers');
1654 keybindAdd('M-M', 'mon_think_step');
1655 keybindAdd('M-I', 'mon_info');
1656 keybindAdd('M-L', 'mon_los_plr');
1657 keybindAdd('M-G', 'mon_cells');
1658 keybindAdd('M-A', 'mon_wakeup');
1660 keybindAdd('M-P', 'mplat_step');
1661 keybindAdd('M-O', 'mplat_toggle');
1663 keybindAdd('C-T', 'plr_teleport');
1664 keybindAdd('M-T', 'dbg_tracebox');
1666 keybindAdd('C-P', 'dbg_curpos');
1667 keybindAdd('C-G', 'dbg_grid');
1668 keybindAdd('C-X', 'dbg_triggers');
1670 keybindAdd('C-1', 'mon_spawn zombie');
1672 keybindAdd('C-S-P', 'hlm_pause');
1674 // mouse
1675 msbindAdd('LMB', 'atcur_select_monster');
1676 msbindAdd('M-LMB', 'atcur_dump_monsters');
1677 msbindAdd('RMB', 'atcur_dump_walls');
1678 msbindAdd('M-RMB', 'atcur_disable_walls');
1680 // load bindings from file
1681 try
1682 st := openDiskFileRO(GameDir+'holmes.rc');
1683 pr := TFileTextParser.Create(st);
1684 conwriteln('parsing "holmes.rc"...');
1685 while (pr.tokType <> pr.TTEOF) do
1686 begin
1687 s := pr.expectId();
1688 if (s = 'stop') then break
1689 else if (s = 'unbind_keys') then keybinds := nil
1690 else if (s = 'unbind_mouse') then msbinds := nil
1691 else if (s = 'bind') then
1692 begin
1693 if (pr.tokType = pr.TTStr) then s := pr.expectStr(false)
1694 else if (pr.tokType = pr.TTInt) then s := Format('%d', [pr.expectInt()])
1695 else s := pr.expectId();
1697 if (pr.tokType = pr.TTStr) then v := pr.expectStr(false)
1698 else if (pr.tokType = pr.TTInt) then v := Format('%d', [pr.expectInt()])
1699 else v := pr.expectId();
1701 kn := parseModKeys(s, kmods, mbuts);
1702 if (CompareText(kn, 'lmb') = 0) or (CompareText(kn, 'rmb') = 0) or (CompareText(kn, 'mmb') = 0) or (CompareText(kn, 'None') = 0) then
1703 begin
1704 msbindAdd(s, v);
1705 end
1706 else
1707 begin
1708 keybindAdd(s, v);
1709 end;
1710 end;
1711 end;
1712 except on e: Exception do // sorry
1713 if (pr <> nil) then conwritefln('Holmes config parse error at (%s,%s): %s', [pr.tokLine, pr.tokCol, e.message]);
1714 end;
1715 if (pr <> nil) then pr.Free() else st.Free(); // ownership
1716 end;
1717 end;
1720 begin
1721 // shut up, fpc!
1722 msB := msB;
1723 vpSet := vpSet;
1725 fuiEventCB := g_Holmes_OnEvent;
1726 //uiContext.font := 'win14';
1728 conRegVar('hlm_ui_scale', @fuiRenderScale, 0.01, 5.0, 'Holmes UI scale', '', false);
1729 end.