DEADSOFTWARE

optimized horizontal grid traces
[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 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;
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;
39 // event types
40 Release = 0;
41 Press = 1;
42 Motion = 2;
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;
53 THKeyEvent = record
54 public
55 const
56 // modifiers
57 ModCtrl = $0001;
58 ModAlt = $0002;
59 ModShift = $0004;
61 // event types
62 Release = 0;
63 Press = 1;
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;
74 procedure g_Holmes_VidModeChanged ();
75 procedure g_Holmes_WindowFocused ();
76 procedure g_Holmes_WindowBlured ();
78 procedure g_Holmes_Draw ();
80 function g_Holmes_mouseEvent (var ev: THMouseEvent): Boolean; // returns `true` if event was eaten
81 function g_Holmes_KeyEvent (var ev: THKeyEvent): Boolean; // returns `true` if event was eaten
83 // hooks for player
84 procedure g_Holmes_plrView (viewPortX, viewPortY, viewPortW, viewPortH: Integer);
85 procedure g_Holmes_plrLaser (ax0, ay0, ax1, ay1: Integer);
88 var
89 g_holmes_enabled: Boolean = {$IF DEFINED(D2F_DEBUG)}true{$ELSE}false{$ENDIF};
92 implementation
94 uses
95 SysUtils, GL, SDL2,
96 MAPDEF, g_options;
99 var
100 //globalInited: Boolean = false;
101 msX: Integer = -666;
102 msY: Integer = -666;
103 msB: Word = 0; // button state
104 kbS: Word = 0; // keyboard modifiers state
105 showGrid: Boolean = true;
106 showMonsInfo: Boolean = false;
107 showMonsLOS2Plr: Boolean = false;
108 showAllMonsCells: Boolean = false;
109 showMapCurPos: Boolean = false;
112 // ////////////////////////////////////////////////////////////////////////// //
113 {$INCLUDE g_holmes.inc}
116 // ////////////////////////////////////////////////////////////////////////// //
117 procedure g_Holmes_VidModeChanged ();
118 begin
119 e_WriteLog(Format('Inspector: videomode changed: %dx%d', [gScreenWidth, gScreenHeight]), MSG_NOTIFY);
120 // texture space is possibly lost here, idc
121 curtexid := 0;
122 font6texid := 0;
123 font8texid := 0;
124 prfont6texid := 0;
125 prfont8texid := 0;
126 //createCursorTexture();
127 end;
129 procedure g_Holmes_WindowFocused ();
130 begin
131 msB := 0;
132 kbS := 0;
133 end;
135 procedure g_Holmes_WindowBlured ();
136 begin
137 end;
140 // ////////////////////////////////////////////////////////////////////////// //
141 var
142 vpSet: Boolean = false;
143 vpx, vpy: Integer;
144 vpw, vph: Integer;
145 laserSet: Boolean = false;
146 laserX0, laserY0, laserX1, laserY1: Integer;
147 monMarkedUID: Integer = -1;
150 procedure g_Holmes_plrView (viewPortX, viewPortY, viewPortW, viewPortH: Integer);
151 begin
152 vpSet := true;
153 vpx := viewPortX;
154 vpy := viewPortY;
155 vpw := viewPortW;
156 vph := viewPortH;
157 end;
159 procedure g_Holmes_plrLaser (ax0, ay0, ax1, ay1: Integer);
160 begin
161 laserSet := true;
162 laserX0 := ax0;
163 laserY0 := ay0;
164 laserX1 := ax1;
165 laserY1 := ay1;
166 laserSet := laserSet; // shut up, fpc!
167 end;
170 function pmsCurMapX (): Integer; inline; begin result := msX+vpx; end;
171 function pmsCurMapY (): Integer; inline; begin result := msY+vpy; end;
174 procedure plrDebugMouse (var ev: THMouseEvent);
176 function wallToggle (pan: TPanel; tag: Integer): Boolean;
177 begin
178 result := false; // don't stop
179 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);
180 if ((kbS and THKeyEvent.ModAlt) <> 0) then
181 begin
182 if pan.Enabled then g_Map_DisableWall(pan.arrIdx) else g_Map_EnableWall(pan.arrIdx);
183 end;
184 end;
186 function monsAtDump (mon: TMonster; tag: Integer): Boolean;
187 begin
188 result := false; // don't stop
189 e_WriteLog(Format('monster #%d; UID=%d', [mon.arrIdx, mon.UID]), MSG_NOTIFY);
190 monMarkedUID := mon.UID;
191 //if pan.Enabled then g_Map_DisableWall(pan.arrIdx) else g_Map_EnableWall(pan.arrIdx);
192 end;
194 function monsInCell (mon: TMonster; tag: Integer): Boolean;
195 begin
196 result := false; // don't stop
197 e_WriteLog(Format('monster #%d (UID:%u) (proxyid:%d)', [mon.arrIdx, mon.UID, mon.proxyId]), MSG_NOTIFY);
198 end;
200 begin
201 //e_WriteLog(Format('mouse: x=%d; y=%d; but=%d; bstate=%d', [msx, msy, but, bstate]), MSG_NOTIFY);
202 if (gPlayer1 = nil) or not vpSet then exit;
203 if (ev.kind <> THMouseEvent.Press) then exit;
205 e_WriteLog(Format('mev: %d', [Integer(ev.kind)]), MSG_NOTIFY);
207 if (ev.but = THMouseEvent.Left) then
208 begin
209 if ((kbS and THKeyEvent.ModShift) <> 0) then
210 begin
211 // dump monsters in cell
212 e_WriteLog('===========================', MSG_NOTIFY);
213 monsGrid.forEachInCell(pmsCurMapX, pmsCurMapY, monsInCell);
214 e_WriteLog('---------------------------', MSG_NOTIFY);
215 end
216 else
217 begin
218 // toggle wall
219 e_WriteLog('=== TOGGLE WALL ===', MSG_NOTIFY);
220 mapGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, wallToggle, (GridTagWall or GridTagDoor));
221 e_WriteLog('--- toggle wall ---', MSG_NOTIFY);
222 end;
223 exit;
224 end;
226 if (ev.but = THMouseEvent.Right) then
227 begin
228 monMarkedUID := -1;
229 e_WriteLog('===========================', MSG_NOTIFY);
230 monsGrid.forEachAtPoint(pmsCurMapX, pmsCurMapY, monsAtDump);
231 e_WriteLog('---------------------------', MSG_NOTIFY);
232 exit;
233 end;
234 end;
237 procedure plrDebugDraw ();
239 procedure drawTileGrid ();
240 var
241 x, y: Integer;
242 begin
243 y := mapGrid.gridY0;
244 while (y < mapGrid.gridY0+mapGrid.gridHeight) do
245 begin
246 x := mapGrid.gridX0;
247 while (x < mapGrid.gridX0+mapGrid.gridWidth) do
248 begin
249 if (x+mapGrid.tileSize > vpx) and (y+mapGrid.tileSize > vpy) and
250 (x < vpx+vpw) and (y < vpy+vph) then
251 begin
252 //e_DrawQuad(x, y, x+mapGrid.tileSize-1, y+mapGrid.tileSize-1, 96, 96, 96, 96);
253 drawRect(x, y, mapGrid.tileSize, mapGrid.tileSize, 96, 96, 96, 255);
254 end;
255 Inc(x, mapGrid.tileSize);
256 end;
257 Inc(y, mapGrid.tileSize);
258 end;
259 end;
261 procedure hilightCell (cx, cy: Integer);
262 begin
263 fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize, 0, 128, 0, 64);
264 end;
266 procedure hilightCell1 (cx, cy: Integer);
267 begin
268 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
269 fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize, 255, 255, 0, 92);
270 end;
272 function hilightWallTrc (pan: TPanel; tag: Integer; x, y, prevx, prevy: Integer): Boolean;
273 begin
274 result := false; // don't stop
275 if (pan = nil) then exit; // cell completion, ignore
276 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
277 fillRect(pan.X, pan.Y, pan.Width, pan.Height, 0, 128, 128, 64);
278 end;
280 function monsCollector (mon: TMonster; tag: Integer): Boolean;
281 var
282 ex, ey: Integer;
283 mx, my, mw, mh: Integer;
284 begin
285 result := false;
286 mon.getMapBox(mx, my, mw, mh);
287 e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 255, 0, 96);
288 if lineAABBIntersects(laserX0, laserY0, laserX1, laserY1, mx, my, mw, mh, ex, ey) then
289 begin
290 e_DrawPoint(8, ex, ey, 0, 255, 0);
291 end;
292 end;
294 procedure drawMonsterInfo (mon: TMonster);
295 var
296 mx, my, mw, mh: Integer;
298 procedure drawMonsterTargetLine ();
299 var
300 emx, emy, emw, emh: Integer;
301 enemy: TMonster;
302 eplr: TPlayer;
303 ex, ey: Integer;
304 begin
305 if (g_GetUIDType(mon.MonsterTargetUID) = UID_PLAYER) then
306 begin
307 eplr := g_Player_Get(mon.MonsterTargetUID);
308 if (eplr <> nil) then eplr.getMapBox(emx, emy, emw, emh) else exit;
309 end
310 else if (g_GetUIDType(mon.MonsterTargetUID) = UID_MONSTER) then
311 begin
312 enemy := g_Monsters_ByUID(mon.MonsterTargetUID);
313 if (enemy <> nil) then enemy.getMapBox(emx, emy, emw, emh) else exit;
314 end
315 else
316 begin
317 exit;
318 end;
319 mon.getMapBox(mx, my, mw, mh);
320 drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, 255, 0, 0, 255);
321 if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
322 begin
323 drawLine(mx+mw div 2, my+mh div 2, ex, ey, 0, 255, 0, 255);
324 end;
325 end;
327 procedure drawLOS2Plr ();
328 var
329 emx, emy, emw, emh: Integer;
330 eplr: TPlayer;
331 ex, ey: Integer;
332 begin
333 eplr := gPlayers[0];
334 if (eplr = nil) then exit;
335 eplr.getMapBox(emx, emy, emw, emh);
336 mon.getMapBox(mx, my, mw, mh);
337 drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, 255, 0, 0, 255);
338 {$IF DEFINED(D2F_DEBUG)}
339 //mapGrid.dbgRayTraceTileHitCB := hilightCell1;
340 {$ENDIF}
341 if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
342 //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
343 begin
344 drawLine(mx+mw div 2, my+mh div 2, ex, ey, 0, 255, 0, 255);
345 end;
346 {$IF DEFINED(D2F_DEBUG)}
347 //mapGrid.dbgRayTraceTileHitCB := nil;
348 {$ENDIF}
349 end;
351 begin
352 if (mon = nil) then exit;
353 mon.getMapBox(mx, my, mw, mh);
354 //mx += mw div 2;
356 monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
358 if showMonsInfo then
359 begin
360 //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
361 shadeRect(mx-4, my-7*8-6, 110, 7*8+6, 128);
362 my -= 8;
363 my -= 2;
365 // type
366 drawText6(mx, my, Format('%s(U:%u)', [monsTypeToString(mon.MonsterType), mon.UID]), 255, 127, 0); my -= 8;
367 // beh
368 drawText6(mx, my, Format('Beh: %s', [monsBehToString(mon.MonsterBehaviour)]), 255, 127, 0); my -= 8;
369 // state
370 drawText6(mx, my, Format('State:%s (%d)', [monsStateToString(mon.MonsterState), mon.MonsterSleep]), 255, 127, 0); my -= 8;
371 // health
372 drawText6(mx, my, Format('Health:%d', [mon.MonsterHealth]), 255, 127, 0); my -= 8;
373 // ammo
374 drawText6(mx, my, Format('Ammo:%d', [mon.MonsterAmmo]), 255, 127, 0); my -= 8;
375 // target
376 drawText6(mx, my, Format('TgtUID:%u', [mon.MonsterTargetUID]), 255, 127, 0); my -= 8;
377 drawText6(mx, my, Format('TgtTime:%d', [mon.MonsterTargetTime]), 255, 127, 0); my -= 8;
378 end;
380 drawMonsterTargetLine();
381 if showMonsLOS2Plr then drawLOS2Plr();
383 property MonsterRemoved: Boolean read FRemoved write FRemoved;
384 property MonsterPain: Integer read FPain write FPain;
385 property MonsterAnim: Byte read FCurAnim write FCurAnim;
387 end;
389 function highlightAllMonsterCells (mon: TMonster): Boolean;
390 begin
391 result := false; // don't stop
392 monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
393 end;
395 var
396 mon: TMonster;
397 mx, my, mw, mh: Integer;
398 begin
399 //e_DrawPoint(4, plrMouseX, plrMouseY, 255, 0, 255);
400 if (gPlayer1 = nil) then exit;
402 //e_WriteLog(Format('(%d,%d)-(%d,%d)', [laserX0, laserY0, laserX1, laserY1]), MSG_NOTIFY);
404 glPushMatrix();
405 glTranslatef(-vpx, -vpy, 0);
407 if (showGrid) then drawTileGrid();
409 if (laserSet) then g_Mons_AlongLine(laserX0, laserY0, laserX1, laserY1, monsCollector, true);
411 if (monMarkedUID <> -1) then
412 begin
413 mon := g_Monsters_ByUID(monMarkedUID);
414 if (mon <> nil) then
415 begin
416 mon.getMapBox(mx, my, mw, mh);
417 e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 0, 0, 30);
418 drawMonsterInfo(mon);
419 end;
420 end;
422 if showAllMonsCells then g_Mons_ForEach(highlightAllMonsterCells);
424 glPopMatrix();
426 if showMapCurPos then drawText8(4, gWinSizeY-10, Format('mappos:(%d,%d)', [pmsCurMapX, pmsCurMapY]), 255, 255, 0);
427 end;
430 // ////////////////////////////////////////////////////////////////////////// //
431 function g_Holmes_mouseEvent (var ev: THMouseEvent): Boolean;
432 begin
433 result := true;
434 msX := ev.x;
435 msY := ev.y;
436 msB := ev.bstate;
437 kbS := ev.kstate;
438 msB := msB;
439 plrDebugMouse(ev);
440 end;
443 function g_Holmes_KeyEvent (var ev: THKeyEvent): Boolean;
444 var
445 mon: TMonster;
446 pan: TPanel;
447 x, y, w, h: Integer;
448 ex, ey: Integer;
449 dx, dy: Integer;
451 procedure dummyWallTrc (cx, cy: Integer);
452 begin
453 end;
455 begin
456 result := false;
457 msB := ev.bstate;
458 kbS := ev.kstate;
459 case ev.scan of
460 SDL_SCANCODE_LCTRL, SDL_SCANCODE_RCTRL,
461 SDL_SCANCODE_LALT, SDL_SCANCODE_RALT,
462 SDL_SCANCODE_LSHIFT, SDL_SCANCODE_RSHIFT:
463 result := true;
464 end;
465 // press
466 if (ev.kind = THKeyEvent.Press) then
467 begin
468 // M-M: one monster think step
469 if (ev.scan = SDL_SCANCODE_M) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
470 begin
471 result := true;
472 gmon_debug_think := false;
473 gmon_debug_one_think_step := true; // do one step
474 exit;
475 end;
476 // M-I: toggle monster info
477 if (ev.scan = SDL_SCANCODE_I) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
478 begin
479 result := true;
480 showMonsInfo := not showMonsInfo;
481 exit;
482 end;
483 // M-L: toggle monster LOS to player
484 if (ev.scan = SDL_SCANCODE_L) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
485 begin
486 result := true;
487 showMonsLOS2Plr := not showMonsLOS2Plr;
488 exit;
489 end;
490 // M-G: toggle "show all cells occupied by monsters"
491 if (ev.scan = SDL_SCANCODE_G) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
492 begin
493 result := true;
494 showAllMonsCells := not showAllMonsCells;
495 exit;
496 end;
497 // M-A: wake up monster
498 if (ev.scan = SDL_SCANCODE_A) and ((ev.kstate and THKeyEvent.ModAlt) <> 0) then
499 begin
500 result := true;
501 if (monMarkedUID <> -1) then
502 begin
503 mon := g_Monsters_ByUID(monMarkedUID);
504 if (mon <> nil) then mon.WakeUp();
505 end;
506 exit;
507 end;
508 // C-T: teleport player
509 if (ev.scan = SDL_SCANCODE_T) and ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
510 begin
511 result := true;
512 //e_WriteLog(Format('TELEPORT: (%d,%d)', [pmsCurMapX, pmsCurMapY]), MSG_NOTIFY);
513 if (gPlayers[0] <> nil) then
514 begin
515 gPlayers[0].getMapBox(x, y, w, h);
516 gPlayers[0].TeleportTo(pmsCurMapX-w div 2, pmsCurMapY-h div 2, true, 69); // 69: don't change dir
517 end;
518 exit;
519 end;
520 // C-P: show cursor position on the map
521 if (ev.scan = SDL_SCANCODE_P) and ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
522 begin
523 result := true;
524 showMapCurPos := not showMapCurPos;
525 exit;
526 end;
527 // C-G: toggle grid
528 if (ev.scan = SDL_SCANCODE_G) and ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
529 begin
530 result := true;
531 showGrid := not showGrid;
532 exit;
533 end;
534 // C-UP, C-DOWN, C-LEFT, C-RIGHT: trace 10 pixels from cursor in the respective direction
535 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
536 ((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
537 begin
538 result := true;
539 dx := pmsCurMapX;
540 dy := pmsCurMapY;
541 case ev.scan of
542 SDL_SCANCODE_UP: dy -= 120;
543 SDL_SCANCODE_DOWN: dy += 120;
544 SDL_SCANCODE_LEFT: dx -= 120;
545 SDL_SCANCODE_RIGHT: dx += 120;
546 end;
547 {$IF DEFINED(D2F_DEBUG)}
548 //mapGrid.dbgRayTraceTileHitCB := dummyWallTrc;
549 mapGrid.dbgShowTraceLog := true;
550 {$ENDIF}
551 pan := g_Map_traceToNearest(pmsCurMapX, pmsCurMapY, dx, dy, (GridTagWall or GridTagDoor or GridTagStep or GridTagAcid1 or GridTagAcid2 or GridTagWater), @ex, @ey);
552 {$IF DEFINED(D2F_DEBUG)}
553 //mapGrid.dbgRayTraceTileHitCB := nil;
554 mapGrid.dbgShowTraceLog := false;
555 {$ENDIF}
556 e_LogWritefln('v-trace: (%d,%d)-(%d,%d); end=(%d,%d); hit=%d', [pmsCurMapX, pmsCurMapY, dx, dy, ex, ey, (pan <> nil)]);
557 exit;
558 end;
559 end;
560 end;
563 // ////////////////////////////////////////////////////////////////////////// //
564 procedure g_Holmes_Draw ();
565 begin
566 glColorMask(GL_TRUE, GL_TRUE, GL_TRUE, GL_TRUE); // modify color buffer
567 glDisable(GL_STENCIL_TEST);
568 glDisable(GL_BLEND);
569 glDisable(GL_SCISSOR_TEST);
570 glDisable(GL_TEXTURE_2D);
572 if gGameOn then
573 begin
574 plrDebugDraw();
575 end;
577 //drawText6Prop(10, 10, 'Hi there, I''m Holmes!', 255, 255, 0);
578 //drawText8Prop(10, 20, 'Hi there, I''m Holmes!', 255, 255, 0);
580 drawCursor();
582 laserSet := false;
583 end;
586 end.