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