DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
F1 in Holmes now shows simple help
[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;
18
19 interface
20
21 uses
22 e_log,
23 g_textures, g_basic, e_graphics, g_phys, g_grid, g_player, g_monsters,
24 g_window, g_map, g_triggers, g_items, g_game, g_panel, g_console,
25 xprofiler;
26
27
28 type
29 THMouseEvent = record
30 public
31 const
32 // both for but and for bstate
33 Left = $0001;
34 Right = $0002;
35 Middle = $0004;
36 WheelUp = $0008;
37 WheelDown = $0010;
38
39 // event types
40 Release = 0;
41 Press = 1;
42 Motion = 2;
43
44 public
45 kind: Byte; // motion, press, release
46 x, y: Integer;
47 dx, dy: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion
48 but: Word; // current pressed/released button, or 0 for motion
49 bstate: Word; // button state
50 kstate: Word; // keyboard state (see THKeyEvent);
51 end;
52
53 THKeyEvent = record
54 public
55 const
56 // modifiers
57 ModCtrl = $0001;
58 ModAlt = $0002;
59 ModShift = $0004;
60
61 // event types
62 Release = 0;
63 Press = 1;
64
65 public
66 kind: Byte;
67 scan: Word; // SDL_SCANCODE_XXX
68 sym: Word; // SDLK_XXX
69 bstate: Word; // button state
70 kstate: Word; // keyboard state
71 end;
72
73
74 procedure g_Holmes_VidModeChanged ();
75 procedure g_Holmes_WindowFocused ();
76 procedure g_Holmes_WindowBlured ();
77
78 procedure g_Holmes_Draw ();
79 procedure g_Holmes_DrawUI ();
80
81 function g_Holmes_MouseEvent (var ev: THMouseEvent): Boolean; // returns `true` if event was eaten
82 function g_Holmes_KeyEvent (var ev: THKeyEvent): Boolean; // returns `true` if event was eaten
83
84 // hooks for player
85 procedure g_Holmes_plrView (viewPortX, viewPortY, viewPortW, viewPortH: Integer);
86 procedure g_Holmes_plrLaser (ax0, ay0, ax1, ay1: Integer);
87
88
89 var
90 g_holmes_enabled: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}false{$ENDIF};
91
92
93 implementation
94
95 uses
96 SysUtils, GL, SDL2,
97 MAPDEF, g_options;
98
99
100 var
101 //globalInited: Boolean = false;
102 msX: Integer = -666;
103 msY: Integer = -666;
104 msB: Word = 0; // button state
105 kbS: Word = 0; // keyboard modifiers state
106 showGrid: Boolean = true;
107 showMonsInfo: Boolean = false;
108 showMonsLOS2Plr: Boolean = false;
109 showAllMonsCells: Boolean = false;
110 showMapCurPos: Boolean = false;
111 showLayersWindow: Boolean = false;
112 showOutlineWindow: Boolean = false;
113
114 // ////////////////////////////////////////////////////////////////////////// //
115 {$INCLUDE g_holmes.inc}
116 {$INCLUDE g_holmes_ui.inc}
117
118
119 // ////////////////////////////////////////////////////////////////////////// //
120 var
121 g_ol_nice: Boolean = false;
122 g_ol_fill_walls: Boolean = false;
123 g_ol_rlayer_back: Boolean = false;
124 g_ol_rlayer_step: Boolean = false;
125 g_ol_rlayer_wall: Boolean = false;
126 g_ol_rlayer_door: Boolean = false;
127 g_ol_rlayer_acid1: Boolean = false;
128 g_ol_rlayer_acid2: Boolean = false;
129 g_ol_rlayer_water: Boolean = false;
130 g_ol_rlayer_fore: Boolean = false;
131
132
133 // ////////////////////////////////////////////////////////////////////////// //
134 var
135 winHelp: THTopWindow = nil;
136 winOptions: THTopWindow = nil;
137 winLayers: THTopWindow = nil;
138 winOutlines: THTopWindow = nil;
139
140
141 procedure createHelpWindow ();
142 var
143 llb: THCtlSimpleText;
144 begin
145 llb := THCtlSimpleText.Create(0, 0);
146 llb.appendItem('common keys', true, true);
147 llb.appendItem(' F1 -- toggle this window');
148 llb.appendItem(' M-F1 -- toggle options window');
149 llb.appendItem('');
150 llb.appendItem('control keys', true, true);
151 llb.appendItem(' M-M -- one monster think step');
152 llb.appendItem(' M-I -- toggle monster info');
153 llb.appendItem(' M-K -- toggle monster LOS to player');
154 llb.appendItem(' M-G -- toggle "show all cells occupied by monsters" (SLOW!)');
155 llb.appendItem(' M-A -- wake up monster');
156 llb.appendItem(' C-T -- teleport player');
157 llb.appendItem(' C-P -- show cursor position on the map');
158 llb.appendItem(' C-G -- toggle grid');
159 llb.appendItem(' C-L -- toggle layers window');
160 llb.appendItem(' C-O -- toggle outlines window');
161 llb.appendItem('');
162 llb.appendItem('mouse', true, true);
163 llb.appendItem(' LMB -- select monster');
164 llb.appendItem(' M-LMB -- dump monsters in cell (to log)');
165 llb.appendItem(' RMB -- dump wall info to log');
166 llb.appendItem(' M-LMB -- disable wall');
167 winHelp := THTopWindow.Create('Holmes Help', 10, 10);
168 winHelp.escClose := true;
169 winHelp.appendChild(llb);
170 winHelp.centerInScreen();
171 end;
172
173
174 procedure winLayersClosed (me: THControl; dummy: Integer); begin showLayersWindow := false; end;
175 procedure winOutlinesClosed (me: THControl; dummy: Integer); begin showOutlineWindow := false; end;
176
177 procedure createLayersWindow ();
178 var
179 llb: THCtlCBListBox;
180 begin
181 llb := THCtlCBListBox.Create(0, 0);
182 llb.appendItem('background', @g_rlayer_back);
183 llb.appendItem('steps', @g_rlayer_step);
184 llb.appendItem('walls', @g_rlayer_wall);
185 llb.appendItem('doors', @g_rlayer_door);
186 llb.appendItem('acid1', @g_rlayer_acid1);
187 llb.appendItem('acid2', @g_rlayer_acid2);
188 llb.appendItem('water', @g_rlayer_water);
189 llb.appendItem('foreground', @g_rlayer_fore);
190 winLayers := THTopWindow.Create('visible', 10, 10);
191 winLayers.escClose := true;
192 winLayers.appendChild(llb);
193 winLayers.closeCB := winLayersClosed;
194 end;
195
196
197 procedure createOutlinesWindow ();
198 var
199 llb: THCtlCBListBox;
200 begin
201 llb := THCtlCBListBox.Create(0, 0);
202 llb.appendItem('background', @g_ol_rlayer_back);
203 llb.appendItem('steps', @g_ol_rlayer_step);
204 llb.appendItem('walls', @g_ol_rlayer_wall);
205 llb.appendItem('doors', @g_ol_rlayer_door);
206 llb.appendItem('acid1', @g_ol_rlayer_acid1);
207 llb.appendItem('acid2', @g_ol_rlayer_acid2);
208 llb.appendItem('water', @g_ol_rlayer_water);
209 llb.appendItem('foreground', @g_ol_rlayer_fore);
210 llb.appendItem('OPTIONS', nil);
211 llb.appendItem('fill walls', @g_ol_fill_walls);
212 llb.appendItem('contours', @g_ol_nice);
213 winOutlines := THTopWindow.Create('outlines', 100, 10);
214 winOutlines.escClose := true;
215 winOutlines.appendChild(llb);
216 winOutlines.closeCB := winOutlinesClosed;
217 end;
218
219
220 procedure toggleLayersWindow (me: THControl; checked: Integer);
221 begin
222 if showLayersWindow then
223 begin
224 if (winLayers = nil) then createLayersWindow();
225 uiAddWindow(winLayers);
226 end
227 else
228 begin
229 uiRemoveWindow(winLayers);
230 end;
231 end;
232
233
234 procedure toggleOutlineWindow (me: THControl; checked: Integer);
235 begin
236 if showOutlineWindow then
237 begin
238 if (winOutlines = nil) then createOutlinesWindow();
239 uiAddWindow(winOutlines);
240 end
241 else
242 begin
243 uiRemoveWindow(winOutlines);
244 end;
245 end;
246
247
248 procedure createOptionsWindow ();
249 var
250 llb: THCtlCBListBox;
251 begin
252 llb := THCtlCBListBox.Create(0, 0);
253 llb.appendItem('map grid', @showGrid);
254 llb.appendItem('cursor position on map', @showMapCurPos);
255 llb.appendItem('monster info', @showMonsInfo);
256 llb.appendItem('monster LOS to player', @showMonsLOS2Plr);
257 llb.appendItem('monster cells (SLOW!)', @showAllMonsCells);
258 llb.appendItem('WINDOWS', nil);
259 llb.appendItem('layers window', @showLayersWindow, toggleLayersWindow);
260 llb.appendItem('outline window', @showOutlineWindow, toggleOutlineWindow);
261 winOptions := THTopWindow.Create('Holmes Options', 100, 100);
262 winOptions.escClose := true;
263 winOptions.appendChild(llb);
264 winOptions.centerInScreen();
265 end;
266
267
268 // ////////////////////////////////////////////////////////////////////////// //
269 procedure g_Holmes_VidModeChanged ();
270 begin
271 e_WriteLog(Format('Holmes: videomode changed: %dx%d', [gScreenWidth, gScreenHeight]), MSG_NOTIFY);
272 // texture space is possibly lost here, idc
273 curtexid := 0;
274 font6texid := 0;
275 font8texid := 0;
276 prfont6texid := 0;
277 prfont8texid := 0;
278 //createCursorTexture();
279 end;
280
281 procedure g_Holmes_WindowFocused ();
282 begin
283 msB := 0;
284 kbS := 0;
285 end;
286
287 procedure g_Holmes_WindowBlured ();
288 begin
289 end;
290
291
292 // ////////////////////////////////////////////////////////////////////////// //
293 var
294 vpSet: Boolean = false;
295 vpx, vpy: Integer;
296 vpw, vph: Integer;
297 laserSet: Boolean = false;
298 laserX0, laserY0, laserX1, laserY1: Integer;
299 monMarkedUID: Integer = -1;
300
301
302 procedure g_Holmes_plrView (viewPortX, viewPortY, viewPortW, viewPortH: Integer);
303 begin
304 vpSet := true;
305 vpx := viewPortX;
306 vpy := viewPortY;
307 vpw := viewPortW;
308 vph := viewPortH;
309 end;
310
311 procedure g_Holmes_plrLaser (ax0, ay0, ax1, ay1: Integer);
312 begin
313 laserSet := true;
314 laserX0 := ax0;
315 laserY0 := ay0;
316 laserX1 := ax1;
317 laserY1 := ay1;
318 laserSet := laserSet; // shut up, fpc!
319 end;
320
321
322 function pmsCurMapX (): Integer; inline; begin result := msX+vpx; end;
323 function pmsCurMapY (): Integer; inline; begin result := msY+vpy; end;
324
325
326 procedure plrDebugMouse (var ev: THMouseEvent);
327
328 function wallToggle (pan: TPanel; tag: Integer): Boolean;
329 begin
330 result := false; // don't stop
331 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);
332 if (kbS = THKeyEvent.ModAlt) then
333 begin
334 if pan.Enabled then g_Map_DisableWall(pan.arrIdx) else g_Map_EnableWall(pan.arrIdx);
335 end;
336 end;
337
338 function monsAtDump (mon: TMonster; tag: Integer): Boolean;
339 begin
340 result := false; // don't stop
341 e_WriteLog(Format('monster #%d; UID=%d', [mon.arrIdx, mon.UID]), MSG_NOTIFY);
342 monMarkedUID := mon.UID;
343 //if pan.Enabled then g_Map_DisableWall(pan.arrIdx) else g_Map_EnableWall(pan.arrIdx);
344 end;
345
346 function monsInCell (mon: TMonster; tag: Integer): Boolean;
347 begin
348 result := false; // don't stop
349 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), MSG_NOTIFY);
350 end;
351
352 begin
353 //e_WriteLog(Format('mouse: x=%d; y=%d; but=%d; bstate=%d', [msx, msy, but, bstate]), MSG_NOTIFY);
354 if (gPlayer1 = nil) or not vpSet then exit;
355 if (ev.kind <> THMouseEvent.Press) then exit;
356
357 e_WriteLog(Format('mev: %d', [Integer(ev.kind)]), MSG_NOTIFY);
358
359 if (ev.but = THMouseEvent.Right) then
360 begin
361 // dump/toggle wall
362 e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
363 mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor));
364 e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
365 exit;
366 end;
367
368 if (ev.but = THMouseEvent.Left) then
369 begin
370 if (kbS = THKeyEvent.ModAlt) then
371 begin
372 // dump monsters in cell
373 e_WriteLog('===========================', MSG_NOTIFY);
374 monsGrid.forEachInCell(pmsCurMapX, pmsCurMapY, monsInCell);
375 e_WriteLog('---------------------------', MSG_NOTIFY);
376 end
377 else if (kbS = 0) then
378 begin
379 monMarkedUID := -1;
380 e_WriteLog('===========================', MSG_NOTIFY);
381 monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump);
382 e_WriteLog('---------------------------', MSG_NOTIFY);
383 end;
384 exit;
385 end;
386 end;
387
388
389 var
390 edgeBmp: array of Byte = nil;
391
392
393 procedure drawOutlines ();
394 var
395 r, g, b: Integer;
396
397 procedure clearEdgeBmp ();
398 begin
399 SetLength(edgeBmp, (gWinSizeX+4)*(gWinSizeY+4));
400 FillChar(edgeBmp[0], Length(edgeBmp)*sizeof(edgeBmp[0]), 0);
401 end;
402
403 procedure drawPanel (pan: TPanel);
404 var
405 sx, len, y0, y1: Integer;
406 begin
407 if (pan = nil) or (pan.Width < 1) or (pan.Height < 1) then exit;
408 if (pan.X+pan.Width <= vpx-1) or (pan.Y+pan.Height <= vpy-1) then exit;
409 if (pan.X >= vpx+vpw+1) or (pan.Y >= vpy+vph+1) then exit;
410 if g_ol_nice or g_ol_fill_walls then
411 begin
412 sx := pan.X-(vpx-1);
413 len := pan.Width;
414 if (len > gWinSizeX+4) then len := gWinSizeX+4;
415 if (sx < 0) then begin len += sx; sx := 0; end;
416 if (sx+len > gWinSizeX+4) then len := gWinSizeX+4-sx;
417 if (len < 1) then exit;
418 assert(sx >= 0);
419 assert(sx+len <= gWinSizeX+4);
420 y0 := pan.Y-(vpy-1);
421 y1 := y0+pan.Height;
422 if (y0 < 0) then y0 := 0;
423 if (y1 > gWinSizeY+4) then y1 := gWinSizeY+4;
424 while (y0 < y1) do
425 begin
426 FillChar(edgeBmp[y0*(gWinSizeX+4)+sx], len*sizeof(edgeBmp[0]), 1);
427 Inc(y0);
428 end;
429 end
430 else
431 begin
432 drawRect(pan.X, pan.Y, pan.Width, pan.Height, r, g, b);
433 end;
434 end;
435
436 var
437 lsx: Integer = -1;
438 lex: Integer = -1;
439 lsy: Integer = -1;
440
441 procedure flushLine ();
442 begin
443 if (lsy > 0) and (lsx > 0) then
444 begin
445 if (lex = lsx) then
446 begin
447 glBegin(GL_POINTS);
448 glVertex2f(lsx-1+vpx+0.37, lsy-1+vpy+0.37);
449 glEnd();
450 end
451 else
452 begin
453 glBegin(GL_LINES);
454 glVertex2f(lsx-1+vpx+0.37, lsy-1+vpy+0.37);
455 glVertex2f(lex-0+vpx+0.37, lsy-1+vpy+0.37);
456 glEnd();
457 end;
458 end;
459 lsx := -1;
460 lex := -1;
461 end;
462
463 procedure startLine (y: Integer);
464 begin
465 flushLine();
466 lsy := y;
467 end;
468
469 procedure putPixel (x: Integer);
470 begin
471 if (x < 1) then exit;
472 if (lex+1 <> x) then flushLine();
473 if (lsx < 0) then lsx := x;
474 lex := x;
475 end;
476
477 procedure drawEdges ();
478 var
479 x, y: Integer;
480 a: PByte;
481 begin
482 glDisable(GL_BLEND);
483 glDisable(GL_TEXTURE_2D);
484 glLineWidth(1);
485 glPointSize(1);
486 glDisable(GL_LINE_SMOOTH);
487 glDisable(GL_POLYGON_SMOOTH);
488 glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
489 for y := 1 to vph do
490 begin
491 a := @edgeBmp[y*(gWinSizeX+4)+1];
492 startLine(y);
493 for x := 1 to vpw do
494 begin
495 if (a[0] <> 0) then
496 begin
497 if (a[-1] = 0) or (a[1] = 0) or (a[-(gWinSizeX+4)] = 0) or (a[gWinSizeX+4] = 0) or
498 (a[-(gWinSizeX+4)-1] = 0) or (a[-(gWinSizeX+4)+1] = 0) or
499 (a[gWinSizeX+4-1] = 0) or (a[gWinSizeX+4+1] = 0) then
500 begin
501 putPixel(x);
502 end;
503 end;
504 Inc(a);
505 end;
506 flushLine();
507 end;
508 end;
509
510 procedure drawFilledWalls ();
511 var
512 x, y: Integer;
513 a: PByte;
514 begin
515 glDisable(GL_BLEND);
516 glDisable(GL_TEXTURE_2D);
517 glLineWidth(1);
518 glPointSize(1);
519 glDisable(GL_LINE_SMOOTH);
520 glDisable(GL_POLYGON_SMOOTH);
521 glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
522 for y := 1 to vph do
523 begin
524 a := @edgeBmp[y*(gWinSizeX+4)+1];
525 startLine(y);
526 for x := 1 to vpw do
527 begin
528 if (a[0] <> 0) then putPixel(x);
529 Inc(a);
530 end;
531 flushLine();
532 end;
533 end;
534
535 procedure doWallsOld (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
536 var
537 f: Integer;
538 pan: TPanel;
539 begin
540 r := ar;
541 g := ag;
542 b := ab;
543 if g_ol_nice or g_ol_fill_walls then clearEdgeBmp();
544 for f := 0 to High(parr) do
545 begin
546 pan := parr[f];
547 if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then continue;
548 if ((pan.PanelType and ptype) = 0) then continue;
549 drawPanel(pan);
550 end;
551 if g_ol_nice then drawEdges();
552 if g_ol_fill_walls then drawFilledWalls();
553 end;
554
555 var
556 xptag: Word;
557
558 function doWallCB (pan: TPanel; tag: Integer): Boolean;
559 begin
560 result := false; // don't stop
561 //if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then exit;
562 if ((pan.PanelType and xptag) = 0) then exit;
563 drawPanel(pan);
564 end;
565
566 procedure doWalls (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
567 begin
568 r := ar;
569 g := ag;
570 b := ab;
571 xptag := ptype;
572 if ((ptype and (PANEL_WALL or PANEL_OPENDOOR or PANEL_CLOSEDOOR)) <> 0) then ptype := GridTagWall or GridTagDoor
573 else panelTypeToTag(ptype);
574 if g_ol_nice or g_ol_fill_walls then clearEdgeBmp();
575 mapGrid.forEachInAABB(vpx-1, vpy-1, vpw+2, vph+2, doWallCB, ptype);
576 if g_ol_nice then drawEdges();
577 if g_ol_fill_walls then drawFilledWalls();
578 end;
579
580 begin
581 if g_ol_rlayer_back then doWallsOld(gRenderBackgrounds, PANEL_BACK, 255, 127, 0);
582 if g_ol_rlayer_step then doWallsOld(gSteps, PANEL_STEP, 192, 192, 192);
583 if g_ol_rlayer_wall then doWallsOld(gWalls, PANEL_WALL, 255, 255, 255);
584 if g_ol_rlayer_door then doWallsOld(gWalls, PANEL_OPENDOOR or PANEL_CLOSEDOOR, 0, 255, 0);
585 if g_ol_rlayer_acid1 then doWallsOld(gAcid1, PANEL_ACID1, 255, 0, 0);
586 if g_ol_rlayer_acid2 then doWallsOld(gAcid2, PANEL_ACID2, 198, 198, 0);
587 if g_ol_rlayer_water then doWallsOld(gWater, PANEL_WATER, 0, 255, 255);
588 if g_ol_rlayer_fore then doWallsOld(gRenderForegrounds, PANEL_FORE, 210, 210, 210);
589 end;
590
591
592 procedure plrDebugDraw ();
593
594 procedure drawTileGrid ();
595 var
596 x, y: Integer;
597 begin
598 for y := 0 to (mapGrid.gridHeight div mapGrid.tileSize) do
599 begin
600 drawLine(mapGrid.gridX0, mapGrid.gridY0+y*mapGrid.tileSize, mapGrid.gridX0+mapGrid.gridWidth, mapGrid.gridY0+y*mapGrid.tileSize, 96, 96, 96, 255);
601 end;
602
603 for x := 0 to (mapGrid.gridWidth div mapGrid.tileSize) do
604 begin
605 drawLine(mapGrid.gridX0+x*mapGrid.tileSize, mapGrid.gridY0, mapGrid.gridX0+x*mapGrid.tileSize, mapGrid.gridY0+y*mapGrid.gridHeight, 96, 96, 96, 255);
606 end;
607 end;
608
609 procedure hilightCell (cx, cy: Integer);
610 begin
611 fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize, 0, 128, 0, 64);
612 end;
613
614 procedure hilightCell1 (cx, cy: Integer);
615 begin
616 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
617 fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize, 255, 255, 0, 92);
618 end;
619
620 function hilightWallTrc (pan: TPanel; tag: Integer; x, y, prevx, prevy: Integer): Boolean;
621 begin
622 result := false; // don't stop
623 if (pan = nil) then exit; // cell completion, ignore
624 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
625 fillRect(pan.X, pan.Y, pan.Width, pan.Height, 0, 128, 128, 64);
626 end;
627
628 function monsCollector (mon: TMonster; tag: Integer): Boolean;
629 var
630 ex, ey: Integer;
631 mx, my, mw, mh: Integer;
632 begin
633 result := false;
634 mon.getMapBox(mx, my, mw, mh);
635 e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 255, 0, 96);
636 if lineAABBIntersects(laserX0, laserY0, laserX1, laserY1, mx, my, mw, mh, ex, ey) then
637 begin
638 e_DrawPoint(8, ex, ey, 0, 255, 0);
639 end;
640 end;
641
642 procedure drawMonsterInfo (mon: TMonster);
643 var
644 mx, my, mw, mh: Integer;
645
646 procedure drawMonsterTargetLine ();
647 var
648 emx, emy, emw, emh: Integer;
649 enemy: TMonster;
650 eplr: TPlayer;
651 ex, ey: Integer;
652 begin
653 if (g_GetUIDType(mon.MonsterTargetUID) = UID_PLAYER) then
654 begin
655 eplr := g_Player_Get(mon.MonsterTargetUID);
656 if (eplr <> nil) then eplr.getMapBox(emx, emy, emw, emh) else exit;
657 end
658 else if (g_GetUIDType(mon.MonsterTargetUID) = UID_MONSTER) then
659 begin
660 enemy := g_Monsters_ByUID(mon.MonsterTargetUID);
661 if (enemy <> nil) then enemy.getMapBox(emx, emy, emw, emh) else exit;
662 end
663 else
664 begin
665 exit;
666 end;
667 mon.getMapBox(mx, my, mw, mh);
668 drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, 255, 0, 0, 255);
669 if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
670 begin
671 drawLine(mx+mw div 2, my+mh div 2, ex, ey, 0, 255, 0, 255);
672 end;
673 end;
674
675 procedure drawLOS2Plr ();
676 var
677 emx, emy, emw, emh: Integer;
678 eplr: TPlayer;
679 ex, ey: Integer;
680 begin
681 eplr := gPlayers[0];
682 if (eplr = nil) then exit;
683 eplr.getMapBox(emx, emy, emw, emh);
684 mon.getMapBox(mx, my, mw, mh);
685 drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, 255, 0, 0, 255);
686 {$IF DEFINED(D2F_DEBUG)}
687 //mapGrid.dbgRayTraceTileHitCB := hilightCell1;
688 {$ENDIF}
689 if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
690 //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
691 begin
692 drawLine(mx+mw div 2, my+mh div 2, ex, ey, 0, 255, 0, 255);
693 end;
694 {$IF DEFINED(D2F_DEBUG)}
695 //mapGrid.dbgRayTraceTileHitCB := nil;
696 {$ENDIF}
697 end;
698
699 begin
700 if (mon = nil) then exit;
701 mon.getMapBox(mx, my, mw, mh);
702 //mx += mw div 2;
703
704 monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
705
706 if showMonsInfo then
707 begin
708 //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
709 darkenRect(mx-4, my-7*8-6, 110, 7*8+6, 128);
710 my -= 8;
711 my -= 2;
712
713 // type
714 drawText6(mx, my, Format('%s(U:%u)', [monsTypeToString(mon.MonsterType), mon.UID]), 255, 127, 0); my -= 8;
715 // beh
716 drawText6(mx, my, Format('Beh: %s', [monsBehToString(mon.MonsterBehaviour)]), 255, 127, 0); my -= 8;
717 // state
718 drawText6(mx, my, Format('State:%s (%d)', [monsStateToString(mon.MonsterState), mon.MonsterSleep]), 255, 127, 0); my -= 8;
719 // health
720 drawText6(mx, my, Format('Health:%d', [mon.MonsterHealth]), 255, 127, 0); my -= 8;
721 // ammo
722 drawText6(mx, my, Format('Ammo:%d', [mon.MonsterAmmo]), 255, 127, 0); my -= 8;
723 // target
724 drawText6(mx, my, Format('TgtUID:%u', [mon.MonsterTargetUID]), 255, 127, 0); my -= 8;
725 drawText6(mx, my, Format('TgtTime:%d', [mon.MonsterTargetTime]), 255, 127, 0); my -= 8;
726 end;
727
728 drawMonsterTargetLine();
729 if showMonsLOS2Plr then drawLOS2Plr();
730 {
731 property MonsterRemoved: Boolean read FRemoved write FRemoved;
732 property MonsterPain: Integer read FPain write FPain;
733 property MonsterAnim: Byte read FCurAnim write FCurAnim;
734 }
735 end;
736
737 function highlightAllMonsterCells (mon: TMonster): Boolean;
738 begin
739 result := false; // don't stop
740 monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
741 end;
742
743 var
744 mon: TMonster;
745 mx, my, mw, mh: Integer;
746 begin
747 if (gPlayer1 = nil) then exit;
748
749 glEnable(GL_SCISSOR_TEST);
750 glScissor(0, gWinSizeY-gPlayerScreenSize.Y-1, vpw, vph);
751
752 glPushMatrix();
753 glTranslatef(-vpx, -vpy, 0);
754
755 if (showGrid) then drawTileGrid();
756 drawOutlines();
757
758 if (laserSet) then g_Mons_AlongLine(laserX0, laserY0, laserX1, laserY1, monsCollector, true);
759
760 if (monMarkedUID <> -1) then
761 begin
762 mon := g_Monsters_ByUID(monMarkedUID);
763 if (mon <> nil) then
764 begin
765 mon.getMapBox(mx, my, mw, mh);
766 e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 0, 0, 30);
767 drawMonsterInfo(mon);
768 end;
769 end;
770
771 if showAllMonsCells then g_Mons_ForEach(highlightAllMonsterCells);
772
773 glPopMatrix();
774
775 glDisable(GL_SCISSOR_TEST);
776
777 if showMapCurPos then drawText8(4, gWinSizeY-10, Format('mappos:(%d,%d)', [pmsCurMapX, pmsCurMapY]), 255, 255, 0);
778 end;
779
780
781 // ////////////////////////////////////////////////////////////////////////// //
782 function g_Holmes_MouseEvent (var ev: THMouseEvent): Boolean;
783 begin
784 result := true;
785 msX := ev.x;
786 msY := ev.y;
787 msB := ev.bstate;
788 kbS := ev.kstate;
789 msB := msB;
790 if not uiMouseEvent(ev) then plrDebugMouse(ev);
791 end;
792
793
794 function g_Holmes_KeyEvent (var ev: THKeyEvent): Boolean;
795 var
796 mon: TMonster;
797 pan: TPanel;
798 x, y, w, h: Integer;
799 ex, ey: Integer;
800 dx, dy: Integer;
801
802 procedure dummyWallTrc (cx, cy: Integer);
803 begin
804 end;
805
806 begin
807 result := false;
808 msB := ev.bstate;
809 kbS := ev.kstate;
810 case ev.scan of
811 SDL_SCANCODE_LCTRL, SDL_SCANCODE_RCTRL,
812 SDL_SCANCODE_LALT, SDL_SCANCODE_RALT,
813 SDL_SCANCODE_LSHIFT, SDL_SCANCODE_RSHIFT:
814 result := true;
815 end;
816 if uiKeyEvent(ev) then begin result := true; exit; end;
817 // press
818 if (ev.kind = THKeyEvent.Press) then
819 begin
820 // M-M: one monster think step
821 if (ev.scan = SDL_SCANCODE_M) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
822 begin
823 result := true;
824 gmon_debug_think := false;
825 gmon_debug_one_think_step := true; // do one step
826 exit;
827 end;
828 // M-I: toggle monster info
829 if (ev.scan = SDL_SCANCODE_I) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
830 begin
831 result := true;
832 showMonsInfo := not showMonsInfo;
833 exit;
834 end;
835 // M-L: toggle monster LOS to player
836 if (ev.scan = SDL_SCANCODE_L) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
837 begin
838 result := true;
839 showMonsLOS2Plr := not showMonsLOS2Plr;
840 exit;
841 end;
842 // M-G: toggle "show all cells occupied by monsters"
843 if (ev.scan = SDL_SCANCODE_G) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
844 begin
845 result := true;
846 showAllMonsCells := not showAllMonsCells;
847 exit;
848 end;
849 // M-A: wake up monster
850 if (ev.scan = SDL_SCANCODE_A) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
851 begin
852 result := true;
853 if (monMarkedUID <> -1) then
854 begin
855 mon := g_Monsters_ByUID(monMarkedUID);
856 if (mon <> nil) then mon.WakeUp();
857 end;
858 exit;
859 end;
860 // C-T: teleport player
861 if (ev.scan = SDL_SCANCODE_T) and ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
862 begin
863 result := true;
864 //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY);
865 if (gPlayers[0] <> nil) then
866 begin
867 gPlayers[0].getMapBox(x, y, w, h);
868 gPlayers[0].TeleportTo(pmsCurMapX-w div 2, pmsCurMapY-h div 2, true, 69); // 69: don't change dir
869 end;
870 exit;
871 end;
872 // C-P: show cursor position on the map
873 if (ev.scan = SDL_SCANCODE_P) and ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
874 begin
875 result := true;
876 showMapCurPos := not showMapCurPos;
877 exit;
878 end;
879 // C-G: toggle grid
880 if (ev.scan = SDL_SCANCODE_G) and ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
881 begin
882 result := true;
883 showGrid := not showGrid;
884 exit;
885 end;
886 // C-L: toggle layers window
887 if (ev.scan = SDL_SCANCODE_L) and ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
888 begin
889 result := true;
890 showLayersWindow := not showLayersWindow;
891 toggleLayersWindow(nil, 0);
892 exit;
893 end;
894 // C-O: toggle outlines window
895 if (ev.scan = SDL_SCANCODE_O) and ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
896 begin
897 result := true;
898 showOutlineWindow := not showOutlineWindow;
899 toggleOutlineWindow(nil, 0);
900 exit;
901 end;
902 // F1: toggle options window
903 if (ev.scan = SDL_SCANCODE_F1) and (ev.kstate = 0) then
904 begin
905 result := true;
906 if (winHelp = nil) then createHelpWindow();
907 if not uiVisibleWindow(winHelp) then uiAddWindow(winHelp) else uiRemoveWindow(winHelp);
908 exit;
909 end;
910 // M-F1: toggle options window
911 if (ev.scan = SDL_SCANCODE_F1) and (ev.kstate = THKeyEvent.ModAlt) then
912 begin
913 result := true;
914 if (winOptions = nil) then createOptionsWindow();
915 if not uiVisibleWindow(winOptions) then uiAddWindow(winOptions) else uiRemoveWindow(winOptions);
916 exit;
917 end;
918 {$IF DEFINED(D2F_DEBUG)}
919 // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction
920 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
921 ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
922 begin
923 result := true;
924 dx := pmsCurMapX;
925 dy := pmsCurMapY;
926 case ev.scan of
927 SDL_SCANCODE_UP: dy -= 120;
928 SDL_SCANCODE_DOWN: dy += 120;
929 SDL_SCANCODE_LEFT: dx -= 120;
930 SDL_SCANCODE_RIGHT: dx += 120;
931 end;
932 {$IF DEFINED(D2F_DEBUG)}
933 //mapGrid.dbgRayTraceTileHitCB := dummyWallTrc;
934 mapGrid.dbgShowTraceLog := true;
935 {$ENDIF}
936 pan := g_Map_traceToNearest(pmsCurMapX, pmsCurMapY, dx, dy, (GridTagWall or GridTagDoor or GridTagStep or GridTagAcid1 or GridTagAcid2 or GridTagWater), @ex, @ey);
937 {$IF DEFINED(D2F_DEBUG)}
938 //mapGrid.dbgRayTraceTileHitCB := nil;
939 mapGrid.dbgShowTraceLog := false;
940 {$ENDIF}
941 e_LogWritefln('v-trace: (%d,%d)-(%d,%d); end=(%d,%d); hit=%d', [pmsCurMapX, pmsCurMapY, dx, dy, ex, ey, (pan <> nil)]);
942 exit;
943 end;
944 {$ENDIF}
945 end;
946 end;
947
948
949 // ////////////////////////////////////////////////////////////////////////// //
950 procedure g_Holmes_Draw ();
951 begin
952 glColorMask(GL_TRUE, GL_TRUE, GL_TRUE, GL_TRUE); // modify color buffer
953 glDisable(GL_STENCIL_TEST);
954 glDisable(GL_BLEND);
955 glDisable(GL_SCISSOR_TEST);
956 glDisable(GL_TEXTURE_2D);
957
958 if gGameOn then
959 begin
960 plrDebugDraw();
961 end;
962
963 laserSet := false;
964 end;
965
966
967 procedure g_Holmes_DrawUI ();
968 begin
969 uiDraw();
970 drawCursor();
971 end;
972
973
974 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024