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