DEADSOFTWARE

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