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;
  17
  18 interface
  19
  20 procedure r_Holmes_Draw ();
  21 procedure r_Holmes_DrawUI ();
  22
  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);
  27
  28 function pmsCurMapX (): Integer;
  29 function pmsCurMapY (): Integer;
  30
  31 var
  32   vpSet: Boolean = false;
  33
  34 implementation
  35
  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;
  56
  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;
  63
  64 // ////////////////////////////////////////////////////////////////////////// //
  65
  66 {$INCLUDE r_holmes_ol.inc}
  67
  68 // ////////////////////////////////////////////////////////////////////////// //
  69
  70 procedure r_Holmes_plrViewPos (viewPortX, viewPortY: Integer);
  71 begin
  72   vpSet := true;
  73   vpx := viewPortX;
  74   vpy := viewPortY;
  75 end;
  76
  77 procedure r_Holmes_plrViewSize (viewPortW, viewPortH: Integer);
  78 begin
  79   vpSet := true;
  80   vpw := viewPortW;
  81   vph := viewPortH;
  82 end;
  83
  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;
  93
  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;
  96
  97 {$IFDEF HOLMES_OLD_OUTLINES}
  98 var
  99   edgeBmp: array of Byte = nil;
 100
 101
 102 procedure drawOutlines ();
 103 var
 104   r, g, b: Integer;
 105
 106   procedure clearEdgeBmp ();
 107   begin
 108     SetLength(edgeBmp, (gScreenWidth+4)*(gScreenHeight+4));
 109     FillChar(edgeBmp[0], Length(edgeBmp)*sizeof(edgeBmp[0]), 0);
 110   end;
 111
 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;
 144
 145 var
 146   lsx: Integer = -1;
 147   lex: Integer = -1;
 148   lsy: Integer = -1;
 149
 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;
 171
 172   procedure startLine (y: Integer);
 173   begin
 174     flushLine();
 175     lsy := y;
 176   end;
 177
 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;
 185
 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;
 218
 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;
 243
 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;
 263
 264 var
 265   xptag: Word;
 266
 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;
 274
 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;
 288
 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;
 299
 300 {$ELSE}
 301 var
 302   oliner: TOutliner = nil;
 303
 304 procedure drawOutlines ();
 305 var
 306   r, g, b: Integer;
 307
 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;
 313
 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);
 360
 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);
 371         {
 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();
 378         }
 379       end;
 380       for sp in ol.eachSpanEdgeAtY(y, +1) do
 381       begin
 382         xline(sp.x0, sp.x1, y);
 383         {
 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();
 390         }
 391       end;
 392     end;
 393   end;
 394
 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;
 432
 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}
 445
 446
 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;
 457
 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;
 464
 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}
 483
 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;
 516
 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;
 522
 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;
 533
 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;
 542
 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;
 551
 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;
 568
 569   procedure drawMonsterInfo (mon: TMonster);
 570   var
 571     mx, my, mw, mh: Integer;
 572
 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;
 603
 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;
 629
 630   begin
 631     if (mon = nil) then exit;
 632     mon.getMapBox(mx, my, mw, mh);
 633     //mx += mw div 2;
 634
 635     //monsGrid.forEachBodyCell(mon.proxyId, hilightCell);
 636     hilightBodyCells(mon.proxyId);
 637
 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);
 643
 644       hlmContext.darkenRect(mx-4, my-7*hlmContext.charWidth(' ')-6, 110, 7*hlmContext.charWidth(' ')+6, 128);
 645       my -= 8;
 646       my -= 2;
 647
 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;
 662
 663     drawMonsterTargetLine();
 664     if showMonsLOS2Plr then drawLOS2Plr();
 665     {
 666     property MonsterRemoved: Boolean read FRemoved write FRemoved;
 667     property MonsterPain: Integer read FPain write FPain;
 668     property MonsterAnim: Byte read FCurAnim write FCurAnim;
 669     }
 670   end;
 671
 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;
 678
 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;
 691
 692   procedure drawTrigger (var trig: TTrigger);
 693
 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;
 703
 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;
 767
 768   procedure drawTriggers ();
 769   var
 770     f: Integer;
 771   begin
 772     for f := 0 to High(gTriggers) do drawTrigger(gTriggers[f]);
 773   end;
 774
 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}
 794
 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;
 806
 807   if (hlmContext = nil) then hlmContext := r_fui_gfx_gl.TGxContext.Create();
 808
 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);
 813
 814     {
 815     glScalef(g_dbg_scale, g_dbg_scale, 1.0);
 816     glTranslatef(-vpx, -vpy, 0);
 817     }
 818     hlmContext.glSetScaleTrans(g_dbg_scale, -vpx, -vpy);
 819     glEnable(GL_SCISSOR_TEST);
 820     glScissor(0, gScreenHeight-gPlayerScreenSize.Y-1, gPlayerScreenSize.X, gPlayerScreenSize.Y);
 821
 822     if (showGrid) then drawTileGrid();
 823     drawOutlines();
 824
 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;
 832
 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;
 845
 846     if showAllMonsCells and showGrid then g_Mons_ForEach(highlightAllMonsterCells);
 847     if showTriggers then drawTriggers();
 848     if showGrid then drawSelectedPlatformCells();
 849
 850     {$IFDEF ENABLE_GFX}
 851       // drawAwakeCells();
 852     {$ENDIF}
 853
 854     if showTraceBox then drawTraceBox();
 855
 856     {$IFDEF ENABLE_GIBS}
 857       // drawGibsBoxes();
 858     {$ENDIF}
 859
 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}
 870
 871     pan := g_Map_PanelAtPoint(16, 608, (GridTagObstacle or GridTagLiquid));
 872     if (pan <> nil) then writeln('hit!');
 873     *)
 874
 875   finally
 876     gxSetContext(nil);
 877   end;
 878
 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;
 897
 898
 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;
 905
 906   holmesInitCommands();
 907   holmesInitBinds();
 908
 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);
 915
 916   if gGameOn then plrDebugDraw();
 917 {$ENDIF}
 918
 919   laserSet := false;
 920 end;
 921
 922
 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;
 928
 929   gGfxDoClear := false;
 930
 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;
 944
 945
 946 begin
 947   conRegVar('hlm_ui_scale', @fuiRenderScale, 0.01, 5.0, 'Holmes UI scale', '', false);
 948 end.