DEADSOFTWARE

flexui: remove direct dependency on opengl
[d2df-sdl.git] / src / game / renders / opengl / r_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 r_holmes;
18 interface
20 procedure r_Holmes_Draw ();
21 procedure r_Holmes_DrawUI ();
23 // hooks for player
24 procedure r_Holmes_plrViewPos (viewPortX, viewPortY: Integer);
25 procedure r_Holmes_plrViewSize (viewPortW, viewPortH: Integer);
26 procedure r_Holmes_plrLaser (ax0, ay0, ax1, ay1: Integer);
28 function pmsCurMapX (): Integer;
29 function pmsCurMapY (): Integer;
31 var
32 vpSet: Boolean = false;
34 implementation
36 uses
37 {$INCLUDE ../nogl/noGLuses.inc}
38 geom,
39 e_log,
40 g_basic, g_grid, g_player, g_monsters,
41 g_map, g_triggers, g_items, g_game, g_panel, g_console,
42 xprofiler,
43 sdlcarcass,
44 fui_common, fui_ctls,
45 fui_gfx,
46 r_fui_gfx_gl,
47 {$IFDEF ENABLE_GFX}
48 g_gfx,
49 {$ENDIF}
50 {$IFDEF ENABLE_GIBS}
51 g_gibs,
52 {$ENDIF}
53 g_holmes,
54 typinfo, SysUtils, Classes,
55 MAPDEF, g_options;
57 var
58 hlmContext: r_fui_gfx_gl.TGxContext = nil;
59 vpx, vpy: Integer;
60 vpw, vph: Integer;
61 laserSet: Boolean = false;
62 laserX0, laserY0, laserX1, laserY1: Integer;
64 // ////////////////////////////////////////////////////////////////////////// //
66 {$INCLUDE r_holmes_ol.inc}
68 // ////////////////////////////////////////////////////////////////////////// //
70 procedure r_Holmes_plrViewPos (viewPortX, viewPortY: Integer);
71 begin
72 vpSet := true;
73 vpx := viewPortX;
74 vpy := viewPortY;
75 end;
77 procedure r_Holmes_plrViewSize (viewPortW, viewPortH: Integer);
78 begin
79 vpSet := true;
80 vpw := viewPortW;
81 vph := viewPortH;
82 end;
84 procedure r_Holmes_plrLaser (ax0, ay0, ax1, ay1: Integer);
85 begin
86 laserSet := true;
87 laserX0 := ax0;
88 laserY0 := ay0;
89 laserX1 := ax1;
90 laserY1 := ay1;
91 laserSet := laserSet; // shut up, fpc!
92 end;
94 function pmsCurMapX (): Integer; inline; begin result := round(msX/g_dbg_scale)+vpx; end;
95 function pmsCurMapY (): Integer; inline; begin result := round(msY/g_dbg_scale)+vpy; end;
97 {$IFDEF HOLMES_OLD_OUTLINES}
98 var
99 edgeBmp: array of Byte = nil;
102 procedure drawOutlines ();
103 var
104 r, g, b: Integer;
106 procedure clearEdgeBmp ();
107 begin
108 SetLength(edgeBmp, (gScreenWidth+4)*(gScreenHeight+4));
109 FillChar(edgeBmp[0], Length(edgeBmp)*sizeof(edgeBmp[0]), 0);
110 end;
112 procedure drawPanel (pan: TPanel);
113 var
114 sx, len, y0, y1: Integer;
115 begin
116 if (pan = nil) or (pan.Width < 1) or (pan.Height < 1) then exit;
117 if (pan.X+pan.Width <= vpx-1) or (pan.Y+pan.Height <= vpy-1) then exit;
118 if (pan.X >= vpx+vpw+1) or (pan.Y >= vpy+vph+1) then exit;
119 if g_ol_nice or g_ol_fill_walls then
120 begin
121 sx := pan.X-(vpx-1);
122 len := pan.Width;
123 if (len > gScreenWidth+4) then len := gScreenWidth+4;
124 if (sx < 0) then begin len += sx; sx := 0; end;
125 if (sx+len > gScreenWidth+4) then len := gScreenWidth+4-sx;
126 if (len < 1) then exit;
127 assert(sx >= 0);
128 assert(sx+len <= gScreenWidth+4);
129 y0 := pan.Y-(vpy-1);
130 y1 := y0+pan.Height;
131 if (y0 < 0) then y0 := 0;
132 if (y1 > gScreenHeight+4) then y1 := gScreenHeight+4;
133 while (y0 < y1) do
134 begin
135 FillChar(edgeBmp[y0*(gScreenWidth+4)+sx], len*sizeof(edgeBmp[0]), 1);
136 Inc(y0);
137 end;
138 end
139 else
140 begin
141 drawRect(pan.X, pan.Y, pan.Width, pan.Height, r, g, b);
142 end;
143 end;
145 var
146 lsx: Integer = -1;
147 lex: Integer = -1;
148 lsy: Integer = -1;
150 procedure flushLine ();
151 begin
152 if (lsy > 0) and (lsx > 0) then
153 begin
154 if (lex = lsx) then
155 begin
156 glBegin(GL_POINTS);
157 glVertex2f(lsx-1+vpx+0.37, lsy-1+vpy+0.37);
158 glEnd();
159 end
160 else
161 begin
162 glBegin(GL_LINES);
163 glVertex2f(lsx-1+vpx+0.37, lsy-1+vpy+0.37);
164 glVertex2f(lex-0+vpx+0.37, lsy-1+vpy+0.37);
165 glEnd();
166 end;
167 end;
168 lsx := -1;
169 lex := -1;
170 end;
172 procedure startLine (y: Integer);
173 begin
174 flushLine();
175 lsy := y;
176 end;
178 procedure putPixel (x: Integer);
179 begin
180 if (x < 1) then exit;
181 if (lex+1 <> x) then flushLine();
182 if (lsx < 0) then lsx := x;
183 lex := x;
184 end;
186 procedure drawEdges ();
187 var
188 x, y: Integer;
189 a: PByte;
190 begin
191 glDisable(GL_BLEND);
192 glDisable(GL_TEXTURE_2D);
193 glLineWidth(1);
194 glPointSize(1);
195 glDisable(GL_LINE_SMOOTH);
196 glDisable(GL_POLYGON_SMOOTH);
197 glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
198 for y := 1 to vph do
199 begin
200 a := @edgeBmp[y*(gScreenWidth+4)+1];
201 startLine(y);
202 for x := 1 to vpw do
203 begin
204 if (a[0] <> 0) then
205 begin
206 if (a[-1] = 0) or (a[1] = 0) or (a[-(gScreenWidth+4)] = 0) or (a[gScreenWidth+4] = 0) or
207 (a[-(gScreenWidth+4)-1] = 0) or (a[-(gScreenWidth+4)+1] = 0) or
208 (a[gScreenWidth+4-1] = 0) or (a[gScreenWidth+4+1] = 0) then
209 begin
210 putPixel(x);
211 end;
212 end;
213 Inc(a);
214 end;
215 flushLine();
216 end;
217 end;
219 procedure drawFilledWalls ();
220 var
221 x, y: Integer;
222 a: PByte;
223 begin
224 glDisable(GL_BLEND);
225 glDisable(GL_TEXTURE_2D);
226 glLineWidth(1);
227 glPointSize(1);
228 glDisable(GL_LINE_SMOOTH);
229 glDisable(GL_POLYGON_SMOOTH);
230 glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
231 for y := 1 to vph do
232 begin
233 a := @edgeBmp[y*(gScreenWidth+4)+1];
234 startLine(y);
235 for x := 1 to vpw do
236 begin
237 if (a[0] <> 0) then putPixel(x);
238 Inc(a);
239 end;
240 flushLine();
241 end;
242 end;
244 procedure doWallsOld (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
245 var
246 f: Integer;
247 pan: TPanel;
248 begin
249 r := ar;
250 g := ag;
251 b := ab;
252 if g_ol_nice or g_ol_fill_walls then clearEdgeBmp();
253 for f := 0 to High(parr) do
254 begin
255 pan := parr[f];
256 if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then continue;
257 if ((pan.PanelType and ptype) = 0) then continue;
258 drawPanel(pan);
259 end;
260 if g_ol_nice then drawEdges();
261 if g_ol_fill_walls then drawFilledWalls();
262 end;
264 var
265 xptag: Word;
267 function doWallCB (pan: TPanel; tag: Integer): Boolean;
268 begin
269 result := false; // don't stop
270 //if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then exit;
271 if ((pan.PanelType and xptag) = 0) then exit;
272 drawPanel(pan);
273 end;
275 procedure doWalls (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
276 begin
277 r := ar;
278 g := ag;
279 b := ab;
280 xptag := ptype;
281 if ((ptype and (PANEL_WALL or PANEL_OPENDOOR or PANEL_CLOSEDOOR)) <> 0) then ptype := GridTagWall or GridTagDoor
282 else panelTypeToTag(ptype);
283 if g_ol_nice or g_ol_fill_walls then clearEdgeBmp();
284 mapGrid.forEachInAABB(vpx-1, vpy-1, vpw+2, vph+2, doWallCB, ptype);
285 if g_ol_nice then drawEdges();
286 if g_ol_fill_walls then drawFilledWalls();
287 end;
289 begin
290 if g_ol_rlayer_back then doWallsOld(gRenderBackgrounds, PANEL_BACK, 255, 127, 0);
291 if g_ol_rlayer_step then doWallsOld(gSteps, PANEL_STEP, 192, 192, 192);
292 if g_ol_rlayer_wall then doWallsOld(gWalls, PANEL_WALL, 255, 255, 255);
293 if g_ol_rlayer_door then doWallsOld(gWalls, PANEL_OPENDOOR or PANEL_CLOSEDOOR, 0, 255, 0);
294 if g_ol_rlayer_acid1 then doWallsOld(gAcid1, PANEL_ACID1, 255, 0, 0);
295 if g_ol_rlayer_acid2 then doWallsOld(gAcid2, PANEL_ACID2, 198, 198, 0);
296 if g_ol_rlayer_water then doWallsOld(gWater, PANEL_WATER, 0, 255, 255);
297 if g_ol_rlayer_fore then doWallsOld(gRenderForegrounds, PANEL_FORE, 210, 210, 210);
298 end;
300 {$ELSE}
301 var
302 oliner: TOutliner = nil;
304 procedure drawOutlines ();
305 var
306 r, g, b: Integer;
308 procedure clearOliner ();
309 begin
310 //if (oliner <> nil) and ((oliner.height <> vph+2) or (oliner.width <> vpw+2)) then begin oliner.Free(); oliner := nil; end;
311 if (oliner = nil) then oliner := TOutliner.Create(vpw+2, vph+2) else oliner.setup(vpw+2, vph+2);
312 end;
314 procedure drawOutline (ol: TOutliner; sx, sy: Integer);
315 procedure xline (x0, x1, y: Integer);
316 var
317 x: Integer;
318 begin
319 if (g_dbg_scale < 1.0) then
320 begin
321 glBegin(GL_POINTS);
322 for x := x0 to x1 do glVertex2f(sx+x+0.375, sy+y+0.375);
323 glEnd();
324 end
325 else
326 begin
327 glBegin(GL_QUADS);
328 glVertex2f(sx+x0+0, sy+y+0);
329 glVertex2f(sx+x1+1, sy+y+0);
330 glVertex2f(sx+x1+1, sy+y+1);
331 glVertex2f(sx+x0+0, sy+y+1);
332 glEnd();
333 end;
334 end;
335 var
336 y: Integer;
337 sp: TOutliner.TSpanX;
338 begin
339 if (ol = nil) then exit;
340 glPointSize(1);
341 glDisable(GL_POINT_SMOOTH);
342 for y := 0 to ol.height-1 do
343 begin
344 for sp in ol.eachSpanAtY(y) do
345 begin
346 if (g_dbg_scale <= 1.0) then
347 begin
348 glBegin(GL_POINTS);
349 glVertex2f(sx+sp.x0+0.375, sy+y+0.375);
350 glVertex2f(sx+sp.x1+0.375, sy+y+0.375);
351 glEnd();
352 end
353 else
354 begin
355 glBegin(GL_QUADS);
356 glVertex2f(sx+sp.x0+0, sy+y+0);
357 glVertex2f(sx+sp.x0+1, sy+y+0);
358 glVertex2f(sx+sp.x0+1, sy+y+1);
359 glVertex2f(sx+sp.x0+0, sy+y+1);
361 glVertex2f(sx+sp.x1+0, sy+y+0);
362 glVertex2f(sx+sp.x1+1, sy+y+0);
363 glVertex2f(sx+sp.x1+1, sy+y+1);
364 glVertex2f(sx+sp.x1+0, sy+y+1);
365 glEnd();
366 end;
367 end;
368 for sp in ol.eachSpanEdgeAtY(y, -1) do
369 begin
370 xline(sp.x0, sp.x1, y);
372 glBegin(GL_QUADS);
373 glVertex2f(sx+sp.x0+0, sy+y+0);
374 glVertex2f(sx+sp.x1+1, sy+y+0);
375 glVertex2f(sx+sp.x1+1, sy+y+1);
376 glVertex2f(sx+sp.x0+0, sy+y+1);
377 glEnd();
379 end;
380 for sp in ol.eachSpanEdgeAtY(y, +1) do
381 begin
382 xline(sp.x0, sp.x1, y);
384 glBegin(GL_QUADS);
385 glVertex2f(sx+sp.x0+0, sy+y+0);
386 glVertex2f(sx+sp.x1+1, sy+y+0);
387 glVertex2f(sx+sp.x1+1, sy+y+1);
388 glVertex2f(sx+sp.x0+0, sy+y+1);
389 glEnd();
391 end;
392 end;
393 end;
395 procedure doWallsOld (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
396 var
397 f: Integer;
398 pan: TPanel;
399 begin
400 r := ar;
401 g := ag;
402 b := ab;
403 if g_ol_nice then clearOliner();
404 hlmContext.color := TGxRGBA.Create(r, g, b);
405 for f := 0 to High(parr) do
406 begin
407 pan := parr[f];
408 if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then continue;
409 if ((pan.PanelType and ptype) = 0) then continue;
410 if (pan.X > vpx+vpw+41) or (pan.Y > vpy+vph+41) then continue;
411 if (pan.X+pan.Width < vpx-41) then continue;
412 if (pan.Y+pan.Height < vpy-41) then continue;
413 if g_ol_nice then
414 begin
415 oliner.addRect(pan.X-(vpx+1), pan.Y-(vpy+1), pan.Width, pan.Height);
416 end;
417 if g_ol_fill_walls then
418 begin
419 hlmContext.fillRect(pan.X, pan.Y, pan.Width, pan.Height);
420 end
421 else if not g_ol_nice then
422 begin
423 hlmContext.rect(pan.X, pan.Y, pan.Width, pan.Height);
424 end;
425 end;
426 if g_ol_nice then
427 begin
428 glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
429 drawOutline(oliner, vpx+1, vpy+1);
430 end;
431 end;
433 begin
434 if (vpw < 2) or (vph < 2) then exit;
435 if g_ol_rlayer_back then doWallsOld(gRenderBackgrounds, PANEL_BACK, 255, 127, 0);
436 if g_ol_rlayer_step then doWallsOld(gSteps, PANEL_STEP, 192, 192, 192);
437 if g_ol_rlayer_wall then doWallsOld(gWalls, PANEL_WALL, 255, 255, 255);
438 if g_ol_rlayer_door then doWallsOld(gWalls, PANEL_OPENDOOR or PANEL_CLOSEDOOR, 0, 255, 0);
439 if g_ol_rlayer_acid1 then doWallsOld(gAcid1, PANEL_ACID1, 255, 0, 0);
440 if g_ol_rlayer_acid2 then doWallsOld(gAcid2, PANEL_ACID2, 198, 198, 0);
441 if g_ol_rlayer_water then doWallsOld(gWater, PANEL_WATER, 0, 255, 255);
442 if g_ol_rlayer_fore then doWallsOld(gRenderForegrounds, PANEL_FORE, 210, 210, 210);
443 end;
444 {$ENDIF}
447 procedure plrDebugDraw ();
448 procedure drawTileGrid ();
449 var
450 x, y: Integer;
451 begin
452 hlmContext.color := TGxRGBA.Create(96, 96, 96);
453 for y := 0 to (mapGrid.gridHeight div mapGrid.tileSize) do
454 begin
455 hlmContext.line(mapGrid.gridX0, mapGrid.gridY0+y*mapGrid.tileSize, mapGrid.gridX0+mapGrid.gridWidth, mapGrid.gridY0+y*mapGrid.tileSize);
456 end;
458 hlmContext.color := TGxRGBA.Create(96, 96, 96);
459 for x := 0 to (mapGrid.gridWidth div mapGrid.tileSize) do
460 begin
461 hlmContext.line(mapGrid.gridX0+x*mapGrid.tileSize, mapGrid.gridY0, mapGrid.gridX0+x*mapGrid.tileSize, mapGrid.gridY0+y*mapGrid.gridHeight);
462 end;
463 end;
465 {$IFDEF ENABLE_GFX}
466 procedure drawAwakeCells ();
467 var
468 x, y: Integer;
469 begin
470 hlmContext.color := TGxRGBA.Create(128, 0, 128, 64);
471 for y := 0 to (mapGrid.gridHeight div mapGrid.tileSize) do
472 begin
473 for x := 0 to (mapGrid.gridWidth div mapGrid.tileSize) do
474 begin
475 if awmIsSetHolmes(x*mapGrid.tileSize+mapGrid.gridX0+1, y*mapGrid.tileSize++mapGrid.gridY0+1) then
476 begin
477 hlmContext.fillRect(x*mapGrid.tileSize++mapGrid.gridX0, y*mapGrid.tileSize++mapGrid.gridY0, monsGrid.tileSize, monsGrid.tileSize);
478 end;
479 end;
480 end;
481 end;
482 {$ENDIF}
484 procedure drawTraceBox ();
485 var
486 plr: TPlayer;
487 px, py, pw, ph: Integer;
488 pdx, pdy: Integer;
489 ex, ey: Integer;
490 pan: TPanel;
491 begin
492 if (Length(gPlayers) < 1) then exit;
493 plr := gPlayers[0];
494 if (plr = nil) then exit;
495 plr.getMapBox(px, py, pw, ph);
496 hlmContext.color := TGxRGBA.Create(255, 0, 255, 200);
497 hlmContext.rect(px, py, pw, ph);
498 pdx := pmsCurMapX-(px+pw div 2);
499 pdy := pmsCurMapY-(py+ph div 2);
500 hlmContext.color := TGxRGBA.Create(255, 0, 255, 200);
501 hlmContext.line(px+pw div 2, py+ph div 2, px+pw div 2+pdx, py+ph div 2+pdy);
502 pan := mapGrid.traceBox(ex, ey, px, py, pw, ph, pdx, pdy, GridTagObstacle);
503 if (pan = nil) then
504 begin
505 hlmContext.color := TGxRGBA.Create(255, 255, 255, 180);
506 hlmContext.rect(px+pdx, py+pdy, pw, ph);
507 end
508 else
509 begin
510 hlmContext.color := TGxRGBA.Create(255, 255, 0, 180);
511 hlmContext.rect(px+pdx, py+pdy, pw, ph);
512 end;
513 hlmContext.color := TGxRGBA.Create(255, 127, 0, 180);
514 hlmContext.rect(ex, ey, pw, ph);
515 end;
517 procedure hilightCell (cx, cy: Integer);
518 begin
519 hlmContext.color := TGxRGBA.Create(0, 128, 0, 64);
520 hlmContext.fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize);
521 end;
523 procedure hilightBodyCells (proxyId: Integer);
524 var
525 it: CellCoordIter;
526 pcellxy: PGridCellCoord;
527 begin
528 //monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
529 it := monsGrid.forEachBodyCell(proxyId);
530 for pcellxy in it do hilightCell(pcellxy^.x, pcellxy^.y);
531 it.release();
532 end;
534 procedure hilightCell1 (cx, cy: Integer);
535 begin
536 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
537 cx := cx and (not (monsGrid.tileSize-1));
538 cy := cy and (not (monsGrid.tileSize-1));
539 hlmContext.color := TGxRGBA.Create(255, 255, 0, 92);
540 hlmContext.fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize);
541 end;
543 function hilightWallTrc (pan: TPanel; tag: Integer; x, y, prevx, prevy: Integer): Boolean;
544 begin
545 result := false; // don't stop
546 if (pan = nil) then exit; // cell completion, ignore
547 //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY);
548 hlmContext.color := TGxRGBA.Create(0, 128, 128, 64);
549 hlmContext.fillRect(pan.X, pan.Y, pan.Width, pan.Height);
550 end;
552 procedure monsCollector (mon: TMonster);
553 var
554 ex, ey: Integer;
555 mx, my, mw, mh: Integer;
556 begin
557 mon.getMapBox(mx, my, mw, mh);
558 hlmContext.color := TGxRGBA.Create(255, 255, 0, 160);
559 hlmContext.rect(mx, my, mw, mh);
560 //e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 255, 0, 96);
561 if lineAABBIntersects(laserX0, laserY0, laserX1, laserY1, mx, my, mw, mh, ex, ey) then
562 begin
563 //e_DrawPoint(8, ex, ey, 0, 255, 0);
564 hlmContext.color := TGxRGBA.Create(0, 255, 0, 220);
565 hlmContext.fillRect(ex-2, ey-2, 7, 7);
566 end;
567 end;
569 procedure drawMonsterInfo (mon: TMonster);
570 var
571 mx, my, mw, mh: Integer;
573 procedure drawMonsterTargetLine ();
574 var
575 emx, emy, emw, emh: Integer;
576 enemy: TMonster;
577 eplr: TPlayer;
578 ex, ey: Integer;
579 begin
580 if (g_GetUIDType(mon.MonsterTargetUID) = UID_PLAYER) then
581 begin
582 eplr := g_Player_Get(mon.MonsterTargetUID);
583 if (eplr <> nil) then eplr.getMapBox(emx, emy, emw, emh) else exit;
584 end
585 else if (g_GetUIDType(mon.MonsterTargetUID) = UID_MONSTER) then
586 begin
587 enemy := g_Monsters_ByUID(mon.MonsterTargetUID);
588 if (enemy <> nil) then enemy.getMapBox(emx, emy, emw, emh) else exit;
589 end
590 else
591 begin
592 exit;
593 end;
594 mon.getMapBox(mx, my, mw, mh);
595 hlmContext.color := TGxRGBA.Create(255, 0, 0);
596 hlmContext.line(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2);
597 if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
598 begin
599 hlmContext.color := TGxRGBA.Create(0, 255, 0);
600 hlmContext.line(mx+mw div 2, my+mh div 2, ex, ey);
601 end;
602 end;
604 procedure drawLOS2Plr ();
605 var
606 emx, emy, emw, emh: Integer;
607 eplr: TPlayer;
608 ex, ey: Integer;
609 begin
610 eplr := gPlayers[0];
611 if (eplr = nil) then exit;
612 eplr.getMapBox(emx, emy, emw, emh);
613 mon.getMapBox(mx, my, mw, mh);
614 hlmContext.color := TGxRGBA.Create(255, 0, 0);
615 hlmContext.line(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2);
616 {$IF DEFINED(D2F_DEBUG)}
617 mapGrid.dbgRayTraceTileHitCB := hilightCell1;
618 {$ENDIF}
619 if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then
620 //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
621 begin
622 hlmContext.color := TGxRGBA.Create(0, 255, 0);
623 hlmContext.line(mx+mw div 2, my+mh div 2, ex, ey);
624 end;
625 {$IF DEFINED(D2F_DEBUG)}
626 mapGrid.dbgRayTraceTileHitCB := nil;
627 {$ENDIF}
628 end;
630 begin
631 if (mon = nil) then exit;
632 mon.getMapBox(mx, my, mw, mh);
633 //mx += mw div 2;
635 //monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
636 hilightBodyCells(mon.proxyId);
638 if showMonsInfo then
639 begin
640 //fillRect(mx-4, my-7*8-6, 110, 7*8+6, 0, 0, 94, 250);
641 hlmContext.font := 'msx6';
642 hlmContext.color := TGxRGBA.Create(255, 127, 0);
644 hlmContext.darkenRect(mx-4, my-7*hlmContext.charWidth(' ')-6, 110, 7*hlmContext.charWidth(' ')+6, 128);
645 my -= 8;
646 my -= 2;
648 // type
649 hlmContext.drawText(mx, my, Format('%s(U:%u)', [monsTypeToString(mon.MonsterType), mon.UID])); my -= hlmContext.charWidth(' ');
650 // beh
651 hlmContext.drawText(mx, my, Format('Beh: %s', [monsBehToString(mon.MonsterBehaviour)])); my -= hlmContext.charWidth(' ');
652 // state
653 hlmContext.drawText(mx, my, Format('State:%s (%d)', [monsStateToString(mon.MonsterState), mon.MonsterSleep])); my -= hlmContext.charWidth(' ');
654 // health
655 hlmContext.drawText(mx, my, Format('Health:%d', [mon.MonsterHealth])); my -= hlmContext.charWidth(' ');
656 // ammo
657 hlmContext.drawText(mx, my, Format('Ammo:%d', [mon.MonsterAmmo])); my -= hlmContext.charWidth(' ');
658 // target
659 hlmContext.drawText(mx, my, Format('TgtUID:%u', [mon.MonsterTargetUID])); my -= hlmContext.charWidth(' ');
660 hlmContext.drawText(mx, my, Format('TgtTime:%d', [mon.MonsterTargetTime])); my -= hlmContext.charWidth(' ');
661 end;
663 drawMonsterTargetLine();
664 if showMonsLOS2Plr then drawLOS2Plr();
666 property MonsterRemoved: Boolean read FRemoved write FRemoved;
667 property MonsterPain: Integer read FPain write FPain;
668 property MonsterAnim: Byte read FCurAnim write FCurAnim;
670 end;
672 function highlightAllMonsterCells (mon: TMonster): Boolean;
673 begin
674 result := false; // don't stop
675 //monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
676 hilightBodyCells(mon.proxyId);
677 end;
679 procedure drawSelectedPlatformCells ();
680 var
681 pan: TPanel;
682 begin
683 if not showGrid then exit;
684 pan := g_Map_PanelByGUID(platMarkedGUID);
685 if (pan = nil) then exit;
686 //mapGrid.forEachBodyCell(pan.proxyId, hilightCell);
687 hilightBodyCells(pan.proxyId);
688 hlmContext.color := TGxRGBA.Create(0, 200, 0, 200);
689 hlmContext.rect(pan.x, pan.y, pan.width, pan.height);
690 end;
692 procedure drawTrigger (var trig: TTrigger);
694 procedure drawPanelDest (pguid: Integer);
695 var
696 pan: TPanel;
697 begin
698 pan := g_Map_PanelByGUID(pguid);
699 if (pan = nil) then exit;
700 hlmContext.color := TGxRGBA.Create(255, 0, 255, 220);
701 hlmContext.line(trig.trigCenter.x, trig.trigCenter.y, pan.x+pan.width div 2, pan.y+pan.height div 2);
702 end;
704 var
705 tts: AnsiString;
706 tx: Integer;
707 begin
708 hlmContext.font := 'msx6';
709 hlmContext.color := TGxRGBA.Create(255, 0, 255, 96);
710 hlmContext.fillRect(trig.x, trig.y, trig.width, trig.height);
711 tts := trigType2Str(trig.TriggerType);
712 tx := trig.x+(trig.width-Length(tts)*6) div 2;
713 hlmContext.darkenRect(tx-2, trig.y-10, Length(tts)*6+4, 10, 64);
714 hlmContext.color := TGxRGBA.Create(255, 127, 0);
715 hlmContext.drawText(tx, trig.y-9, tts);
716 tx := trig.x+(trig.width-Length(trig.mapId)*6) div 2;
717 hlmContext.darkenRect(tx-2, trig.y-20, Length(trig.mapId)*6+4, 10, 64);
718 hlmContext.color := TGxRGBA.Create(255, 255, 0);
719 hlmContext.drawText(tx, trig.y-19, trig.mapId);
720 drawPanelDest(trig.trigPanelGUID);
721 case trig.TriggerType of
722 TRIGGER_NONE: begin end;
723 TRIGGER_EXIT: begin end;
724 TRIGGER_TELEPORT: begin end;
725 TRIGGER_OPENDOOR: begin end;
726 TRIGGER_CLOSEDOOR: begin end;
727 TRIGGER_DOOR: begin end;
728 TRIGGER_DOOR5: begin end;
729 TRIGGER_CLOSETRAP: begin end;
730 TRIGGER_TRAP: begin end;
731 TRIGGER_SECRET: begin end;
732 TRIGGER_LIFTUP: begin end;
733 TRIGGER_LIFTDOWN: begin end;
734 TRIGGER_LIFT: begin end;
735 TRIGGER_TEXTURE: begin end;
736 TRIGGER_ON, TRIGGER_OFF, TRIGGER_ONOFF, TRIGGER_PRESS:
737 begin
738 if (trig.trigDataRec.trigTWidth > 0) and (trig.trigDataRec.trigTHeight > 0) then
739 begin
740 hlmContext.color := TGxRGBA.Create(0, 255, 255, 42);
741 hlmContext.fillRect(
742 trig.trigDataRec.trigTX, trig.trigDataRec.trigTY,
743 trig.trigDataRec.trigTWidth, trig.trigDataRec.trigTHeight);
744 hlmContext.color := TGxRGBA.Create(255, 0, 255, 220);
745 hlmContext.line(
746 trig.trigCenter.x, trig.trigCenter.y,
747 trig.trigDataRec.trigTX+trig.trigDataRec.trigTWidth div 2,
748 trig.trigDataRec.trigTY+trig.trigDataRec.trigTHeight div 2);
749 end;
750 end;
751 TRIGGER_SOUND: begin end;
752 TRIGGER_SPAWNMONSTER: begin end;
753 TRIGGER_SPAWNITEM: begin end;
754 TRIGGER_MUSIC: begin end;
755 TRIGGER_PUSH: begin end;
756 TRIGGER_SCORE: begin end;
757 TRIGGER_MESSAGE: begin end;
758 TRIGGER_DAMAGE: begin end;
759 TRIGGER_HEALTH: begin end;
760 TRIGGER_SHOT: begin end;
761 TRIGGER_EFFECT: begin end;
762 TRIGGER_SCRIPT: begin end;
763 end;
764 //trigType2Str
765 //trigPanelId: Integer;
766 end;
768 procedure drawTriggers ();
769 var
770 f: Integer;
771 begin
772 for f := 0 to High(gTriggers) do drawTrigger(gTriggers[f]);
773 end;
775 {$IFDEF ENABLE_GIBS}
776 procedure drawGibsBoxes ();
777 var
778 f: Integer;
779 px, py, pw, ph: Integer;
780 gib: PGib;
781 begin
782 for f := 0 to High(gGibs) do
783 begin
784 gib := @gGibs[f];
785 if gib.alive then
786 begin
787 gib.getMapBox(px, py, pw, ph);
788 hlmContext.color := TGxRGBA.Create(255, 0, 255);
789 hlmContext.rect(px, py, pw, ph);
790 end;
791 end;
792 end;
793 {$ENDIF}
795 var
796 mon: TMonster;
797 mit: PMonster;
798 it: TMonsterGrid.Iter;
799 mx, my, mw, mh: Integer;
800 //pan: TPanel;
801 //ex, ey: Integer;
802 s: AnsiString;
803 dx, dy: Integer;
804 begin
805 if (gPlayer1 = nil) then exit;
807 if (hlmContext = nil) then hlmContext := r_fui_gfx_gl.TGxContext.Create();
809 gxSetContext(hlmContext);
810 try
811 //glScissor(0, gScreenHeight-gPlayerScreenSize.Y-1, vpw, vph);
812 //hlmContext.clip := TGxRect.Create(0, gScreenHeight-gPlayerScreenSize.Y-1, gPlayerScreenSize.X, gPlayerScreenSize.Y);
815 glScalef(g_dbg_scale, g_dbg_scale, 1.0);
816 glTranslatef(-vpx, -vpy, 0);
818 hlmContext.glSetScaleTrans(g_dbg_scale, -vpx, -vpy);
819 glEnable(GL_SCISSOR_TEST);
820 glScissor(0, gScreenHeight-gPlayerScreenSize.Y-1, gPlayerScreenSize.X, gPlayerScreenSize.Y);
822 if (showGrid) then drawTileGrid();
823 drawOutlines();
825 if (laserSet) then
826 begin
827 //g_Mons_AlongLine(laserX0, laserY0, laserX1, laserY1, monsCollector, true);
828 it := monsGrid.forEachAlongLine(laserX0, laserY0, laserX1, laserY1, -1, true);
829 for mit in it do monsCollector(mit^);
830 it.release();
831 end;
833 if (monMarkedUID <> -1) then
834 begin
835 mon := g_Monsters_ByUID(monMarkedUID);
836 if (mon <> nil) then
837 begin
838 mon.getMapBox(mx, my, mw, mh);
839 //e_DrawQuad(mx, my, mx+mw-1, my+mh-1, 255, 0, 0, 30);
840 hlmContext.color := TGxRGBA.Create(255, 0, 0, 220);
841 hlmContext.rect(mx, my, mw, mh);
842 drawMonsterInfo(mon);
843 end;
844 end;
846 if showAllMonsCells and showGrid then g_Mons_ForEach(highlightAllMonsterCells);
847 if showTriggers then drawTriggers();
848 if showGrid then drawSelectedPlatformCells();
850 {$IFDEF ENABLE_GFX}
851 // drawAwakeCells();
852 {$ENDIF}
854 if showTraceBox then drawTraceBox();
856 {$IFDEF ENABLE_GIBS}
857 // drawGibsBoxes();
858 {$ENDIF}
860 //pan := g_Map_traceToNearest(16, 608, 16, 8, (GridTagObstacle or GridTagLiquid), @ex, @ey);
861 (*
862 {$IF DEFINED(D2F_DEBUG)}
863 mapGrid.dbgRayTraceTileHitCB := hilightCell1;
864 {$ENDIF}
865 pan := mapGrid.traceRay(ex, ey, 16, 608, 16, 8, nil, (GridTagObstacle or GridTagLiquid));
866 if (pan <> nil) then writeln('end=(', ex, ',', ey, ')');
867 {$IF DEFINED(D2F_DEBUG)}
868 mapGrid.dbgRayTraceTileHitCB := nil;
869 {$ENDIF}
871 pan := g_Map_PanelAtPoint(16, 608, (GridTagObstacle or GridTagLiquid));
872 if (pan <> nil) then writeln('hit!');
873 *)
875 finally
876 gxSetContext(nil);
877 end;
879 if showMapCurPos then
880 begin
881 s := Format('mappos:(%d,%d)', [pmsCurMapX, pmsCurMapY]);
882 gxSetContext(hlmContext);
883 hlmContext.font := 'win8';
884 hlmContext.color := TGxRGBA.Create(0, 0, 0);
885 for dy := -1 to 1 do
886 begin
887 for dx := -1 to 1 do
888 begin
889 if (dx <> 0) or (dy <> 0) then hlmContext.drawText(4+dx, gScreenHeight-10+dy, s);
890 end;
891 end;
892 hlmContext.color := TGxRGBA.Create(255, 255, 0);
893 hlmContext.drawText(4, gScreenHeight-10, s);
894 gxSetContext(nil);
895 end;
896 end;
899 // ////////////////////////////////////////////////////////////////////////// //
900 procedure r_Holmes_Draw ();
901 begin
902 if g_Game_IsNet then exit;
903 if not g_holmes_enabled then exit;
904 if g_holmes_imfunctional then exit;
906 holmesInitCommands();
907 holmesInitBinds();
909 {$IFDEF ENABLE_RENDER}
910 glColorMask(GL_TRUE, GL_TRUE, GL_TRUE, GL_TRUE); // modify color buffer
911 glDisable(GL_STENCIL_TEST);
912 glDisable(GL_BLEND);
913 glDisable(GL_SCISSOR_TEST);
914 glDisable(GL_TEXTURE_2D);
916 if gGameOn then plrDebugDraw();
917 {$ENDIF}
919 laserSet := false;
920 end;
923 procedure r_Holmes_DrawUI ();
924 begin
925 if g_Game_IsNet then exit;
926 if not g_holmes_enabled then exit;
927 if g_holmes_imfunctional then exit;
929 gGfxDoClear := false;
931 {$IFDEF ENABLE_RENDER}
932 //if assigned(prerenderFrameCB) then prerenderFrameCB();
933 uiDraw();
934 glMatrixMode(GL_MODELVIEW);
935 glPushMatrix();
936 try
937 //glLoadIdentity();
938 if assigned(postrenderFrameCB) then postrenderFrameCB();
939 finally
940 glPopMatrix();
941 end;
942 {$ENDIF}
943 end;
946 begin
947 conRegVar('hlm_ui_scale', @fuiRenderScale, 0.01, 5.0, 'Holmes UI scale', '', false);
948 end.