src/game/opengl/r_map.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_map;
  17
  18 interface
  19
  20   uses g_panel, MAPDEF, binheap; // TPanel, TDFColor
  21
  22   procedure r_Map_Initialize;
  23   procedure r_Map_Finalize;
  24
  25   procedure r_Map_Load;
  26   procedure r_Map_Free;
  27
  28   procedure r_Map_LoadTextures;
  29   procedure r_Map_FreeTextures;
  30
  31   procedure r_Map_Update;
  32
  33   procedure r_Map_DrawPanels (PanelType: Word; hasAmbient: Boolean; constref ambColor: TDFColor); // unaccelerated
  34   procedure r_Map_CollectDrawPanels (x0, y0, wdt, hgt: Integer);
  35   procedure r_Map_DrawPanelShadowVolumes (lightX: Integer; lightY: Integer; radius: Integer);
  36   procedure r_Map_DrawFlags;
  37
  38   procedure r_Panel_Draw (constref p: TPanel; hasAmbient: Boolean; constref ambColor: TDFColor);
  39   procedure r_Panel_DrawShadowVolume (constref p: TPanel; lightX, lightY: Integer; radius: Integer);
  40
  41   type
  42     TBinHeapPanelDrawCmp = class
  43       public
  44         class function less (const a, b: TPanel): Boolean; inline;
  45     end;
  46
  47     TBinHeapPanelDraw = specialize TBinaryHeapBase<TPanel, TBinHeapPanelDrawCmp>;
  48
  49   var
  50     gDrawPanelList: TBinHeapPanelDraw = nil; // binary heap of all walls we have to render, populated by `g_Map_CollectDrawPanels()`
  51
  52 implementation
  53
  54   uses
  55     {$INCLUDE ../nogl/noGLuses.inc}
  56     SysUtils, Classes, Math, e_log, wadreader, CONFIG, utils, g_language,
  57     r_graphics, r_animations, r_textures, g_animations,
  58     g_base, g_basic, g_game, g_options,
  59     g_map
  60   ;
  61
  62   var
  63     RenTextures: array of record
  64       ID: DWORD;
  65       Width, Height: WORD;
  66       Anim: Boolean;
  67     end;
  68     FlagFrames: array [FLAG_RED..FLAG_BLUE] of DWORD;
  69     FlagAnim: TAnimState;
  70
  71   class function TBinHeapPanelDrawCmp.less (const a, b: TPanel): Boolean; inline;
  72   begin
  73     if (a.tag < b.tag) then begin result := true; exit; end;
  74     if (a.tag > b.tag) then begin result := false; exit; end;
  75     result := (a.arrIdx < b.arrIdx);
  76   end;
  77
  78   procedure r_Map_Initialize;
  79   begin
  80     FlagAnim := TAnimState.Create(True, 8, 5);
  81   end;
  82
  83   procedure r_Map_Finalize;
  84   begin
  85     FlagAnim.Invalidate;
  86   end;
  87
  88   procedure r_Map_Load;
  89   begin
  90     g_Frames_CreateWAD(@FlagFrames[FLAG_RED], 'FRAMES_FLAG_RED', GameWAD + ':TEXTURES\FLAGRED', 64, 64, 5, False);
  91     g_Frames_CreateWAD(@FlagFrames[FLAG_BLUE], 'FRAMES_FLAG_BLUE', GameWAD + ':TEXTURES\FLAGBLUE', 64, 64, 5, False);
  92   end;
  93
  94   procedure r_Map_Free;
  95   begin
  96     g_Frames_DeleteByName('FRAMES_FLAG_RED');
  97     g_Frames_DeleteByName('FRAMES_FLAG_BLUE');
  98   end;
  99
 100   procedure r_Map_LoadTextures;
 101     const
 102       log = True;
 103     var
 104       i, n: Integer;
 105       WadName, ResName: String;
 106       WAD, WADZ: TWADFile;
 107       ResData, ReszData: Pointer;
 108       ResLen, ReszLen: Integer;
 109       cfg: TConfig;
 110       TextureResource: String;
 111       Width, Height: Integer;
 112       FramesCount: Integer;
 113       BackAnim: Boolean;
 114   begin
 115     if Textures <> nil then
 116     begin
 117       n := Length(Textures);
 118       SetLength(RenTextures, n);
 119       for i := 0 to n - 1 do
 120       begin
 121         // e_LogWritefln('r_Map_LoadTextures: -> [%s] :: [%s]', [Textures[i].FullName, Textures[i].TextureName]);
 122         RenTextures[i].ID := LongWord(TEXTURE_NONE);
 123         RenTextures[i].Width := 0;
 124         RenTextures[i].Height := 0;
 125         RenTextures[i].Anim := False;
 126         case Textures[i].TextureName of
 127           TEXTURE_NAME_WATER: RenTextures[i].ID := LongWord(TEXTURE_SPECIAL_WATER);
 128           TEXTURE_NAME_ACID1: RenTextures[i].ID := LongWord(TEXTURE_SPECIAL_ACID1);
 129           TEXTURE_NAME_ACID2: RenTextures[i].ID := LongWord(TEXTURE_SPECIAL_ACID2);
 130         else
 131           WadName := g_ExtractWadName(Textures[i].FullName);
 132           ResName := g_ExtractFilePathName(Textures[i].FullName);
 133           WAD := TWADFile.Create();
 134           if WAD.ReadFile(WadName) then
 135           begin
 136             if WAD.GetResource(ResName, ResData, ResLen, log) then
 137             begin
 138               if IsWadData(ResData, ResLen) then
 139               begin
 140                 WADz := TWADFile.Create();
 141                 if WADz.ReadMemory(ResData, ResLen) then
 142                 begin
 143                   if WADz.GetResource('TEXT/ANIM', ReszData, ReszLen) then
 144                   begin
 145                     cfg := TConfig.CreateMem(ReszData, ReszLen);
 146                     FreeMem(ReszData);
 147                     if cfg <> nil then
 148                     begin
 149                       TextureResource := cfg.ReadStr('', 'resource', '');
 150                       Width := cfg.ReadInt('', 'framewidth', 0);
 151                       Height := cfg.ReadInt('', 'frameheight', 0);
 152                       FramesCount := cfg.ReadInt('', 'framecount', 0);
 153                       // Speed := cfg.ReadInt('', 'waitcount', 0);
 154                       BackAnim := cfg.ReadBool('', 'backanimation', False);
 155                       RenTextures[i].Width := Width;
 156                       RenTextures[i].Height := Height;
 157                       if TextureResource <> '' then
 158                       begin
 159                         if WADz.GetResource('TEXTURES/' + TextureResource, ReszData, ReszLen) then
 160                         begin
 161                           if g_Frames_CreateMemory(@RenTextures[i].ID, '', ReszData, ReszLen, Width, Height, FramesCount, BackAnim) then
 162                             RenTextures[i].Anim := True
 163                           else
 164                             e_LogWritefln('r_Map_LoadTextures: failed to create frames object (%s)', [Textures[i].FullName]);
 165                           FreeMem(ReszData)
 166                         end
 167                         else
 168                           e_LogWritefln('r_Map_LoadTextures: failed to open animation resources (%s)', [Textures[i].FullName])
 169                       end
 170                       else
 171                         e_LogWritefln('r_Map_LoadTextures: failed to animation has no texture resource string (%s)', [Textures[i].FullName]);
 172                       cfg.Free
 173                     end
 174                     else
 175                       e_LogWritefln('r_Map_LoadTextures: failed to parse animation description (%s)', [Textures[i].FullName])
 176                   end
 177                   else
 178                     e_LogWritefln('r_Map_LoadTextures: failed to open animation description (%s)', [Textures[i].FullName])
 179                 end
 180                 else
 181                   e_LogWritefln('r_Map_LoadTextures: failed to open animation (%s)', [Textures[i].FullName]);
 182                 WADz.Free
 183               end
 184               else
 185               begin
 186                 if e_CreateTextureMem(ResData, ResLen, RenTextures[i].ID) then
 187                   e_GetTextureSize(RenTextures[i].ID, @RenTextures[i].Width, @RenTextures[i].Height)
 188                 else
 189                   e_LogWritefln('r_Map_LoadTextures: failed to create texture (%s)', [Textures[i].FullName])
 190               end;
 191               FreeMem(ResData);
 192             end
 193             else
 194               e_LogWritefln('r_Map_LoadTextures: failed to open (%s)', [Textures[i].FullName])
 195           end
 196           else
 197             e_LogWritefln('r_Map_LoadTextures: failed to open %s', [WadName]);
 198           WAD.Free;
 199         end
 200       end
 201     end
 202   end;
 203
 204   procedure r_Map_FreeTextures;
 205   begin
 206     // TODO
 207   end;
 208
 209 procedure dplClear ();
 210 begin
 211   if (gDrawPanelList = nil) then gDrawPanelList := TBinHeapPanelDraw.Create() else gDrawPanelList.clear();
 212 end;
 213
 214 // old algo
 215 procedure r_Map_DrawPanels (PanelType: Word; hasAmbient: Boolean; constref ambColor: TDFColor);
 216
 217   procedure DrawPanels (constref panels: TPanelArray; drawDoors: Boolean=False);
 218   var
 219     idx: Integer;
 220   begin
 221     if (panels <> nil) then
 222     begin
 223       // alas, no visible set
 224       for idx := 0 to High(panels) do
 225       begin
 226         if not (drawDoors xor panels[idx].Door) then
 227           r_Panel_Draw(panels[idx], hasAmbient, ambColor);
 228       end;
 229     end;
 230   end;
 231
 232 begin
 233   case PanelType of
 234     PANEL_WALL:       DrawPanels(gWalls);
 235     PANEL_CLOSEDOOR:  DrawPanels(gWalls, True);
 236     PANEL_BACK:       DrawPanels(gRenderBackgrounds);
 237     PANEL_FORE:       DrawPanels(gRenderForegrounds);
 238     PANEL_WATER:      DrawPanels(gWater);
 239     PANEL_ACID1:      DrawPanels(gAcid1);
 240     PANEL_ACID2:      DrawPanels(gAcid2);
 241     PANEL_STEP:       DrawPanels(gSteps);
 242   end;
 243 end;
 244
 245 // new algo
 246 procedure r_Map_CollectDrawPanels (x0, y0, wdt, hgt: Integer);
 247 var
 248   mwit: PPanel;
 249   it: TPanelGrid.Iter;
 250 begin
 251   dplClear();
 252   it := mapGrid.forEachInAABB(x0, y0, wdt, hgt, GridDrawableMask);
 253   for mwit in it do if (((mwit^.tag and GridTagDoor) <> 0) = mwit^.Door) then gDrawPanelList.insert(mwit^);
 254   it.release();
 255   // list will be rendered in `g_game.DrawPlayer()`
 256 end;
 257
 258 procedure r_Map_DrawPanelShadowVolumes (lightX: Integer; lightY: Integer; radius: Integer);
 259 var
 260   mwit: PPanel;
 261   it: TPanelGrid.Iter;
 262 begin
 263   it := mapGrid.forEachInAABB(lightX-radius, lightY-radius, radius*2, radius*2, (GridTagWall or GridTagDoor));
 264   for mwit in it do r_Panel_DrawShadowVolume(mwit^, lightX, lightY, radius);
 265   it.release();
 266 end;
 267
 268   procedure r_Map_DrawFlags;
 269     var i, dx, tx, ty: Integer; Mirror: TMirrorType; f: PFlag;
 270   begin
 271     if gGameSettings.GameMode = GM_CTF then
 272     begin
 273       for i := FLAG_RED to FLAG_BLUE do
 274       begin
 275         f := @gFlags[i];
 276         if not (f.State in [FLAG_STATE_NONE, FLAG_STATE_CAPTURED]) then
 277         begin
 278           f.Obj.lerp(gLerpFactor, tx, ty);
 279           if f.Direction = TDirection.D_LEFT then
 280             Mirror :=  TMirrorType.Horizontal
 281           else
 282             Mirror := TMirrorType.None;
 283           dx := IfThen(f.Direction = TDirection.D_LEFT, -1, +1);
 284           r_AnimState_Draw(FlagFrames[i], FlagAnim, tx + dx, ty + 1, 0, Mirror, False);
 285           if g_debug_Frames then
 286             e_DrawQuad(tx + f.Obj.Rect.X, ty + f.Obj.Rect.Y, tx + f.Obj.Rect.X + f.Obj.Rect.Width - 1, ty + f.Obj.Rect.Y + f.Obj.Rect.Height - 1, 0, 255, 0)
 287         end
 288       end
 289     end
 290   end;
 291
 292   procedure Panel_Lerp (p: TPanel; t: Single; out tX, tY, tW, tH: Integer);
 293   begin
 294     if p.movingActive then
 295     begin
 296       tX := nlerp(p.OldX, p.X, t);
 297       tY := nlerp(p.OldY, p.Y, t);
 298       tW := nlerp(p.OldWidth, p.Width, t);
 299       tH := nlerp(p.OldHeight, p.Height, t);
 300     end
 301     else
 302     begin
 303       tX := p.X;
 304       tY := p.Y;
 305       tW := p.Width;
 306       tH := p.Height;
 307     end;
 308   end;
 309
 310   procedure r_Panel_Draw (constref p: TPanel; hasAmbient: Boolean; constref ambColor: TDFColor);
 311     var tx, ty, tw, th, xx, yy: Integer; NoTextureID, TextureID, FramesID: DWORD; NW, NH: Word; Texture: Cardinal; IsAnim: Boolean; w, h: Integer;
 312   begin
 313     if {p.Enabled and} (p.FCurTexture >= 0) and (p.Width > 0) and (p.Height > 0) and (p.Alpha < 255) {and g_Collide(X, Y, Width, Height, sX, sY, sWidth, sHeight)} then
 314     begin
 315       Panel_Lerp(p, gLerpFactor, tx, ty, tw, th);
 316       Texture := p.TextureIDs[p.FCurTexture].Texture;
 317       IsAnim := RenTextures[Texture].Anim;
 318       if IsAnim then
 319       begin
 320         if p.TextureIDs[p.FCurTexture].AnTex.IsValid() then
 321         begin
 322           FramesID := RenTextures[Texture].ID;
 323           w := RenTextures[Texture].Width;
 324           h := RenTextures[Texture].Height;
 325           for xx := 0 to tw div w - 1 do
 326             for yy := 0 to th div h - 1 do
 327               r_AnimState_Draw(FramesID, p.TextureIDs[p.FCurTexture].AnTex, tx + xx * w, ty + yy * h, p.Alpha, TMirrorType.None, p.Blending);
 328         end
 329       end
 330       else
 331       begin
 332         TextureID := RenTextures[Texture].ID;
 333         w := RenTextures[Texture].Width;
 334         h := RenTextures[Texture].Height;
 335         case TextureID of
 336           LongWord(TEXTURE_SPECIAL_WATER): e_DrawFillQuad(tx, ty, tx + tw - 1, ty + th - 1, 0, 0, 255, 0, TBlending.Filter);
 337           LongWord(TEXTURE_SPECIAL_ACID1): e_DrawFillQuad(tx, ty, tx + tw - 1, ty + th - 1, 0, 230, 0, 0, TBlending.Filter);
 338           LongWord(TEXTURE_SPECIAL_ACID2): e_DrawFillQuad(tx, ty, tx + tw - 1, ty + th - 1, 230, 0, 0, 0, TBlending.Filter);
 339           LongWord(TEXTURE_NONE):
 340             if g_Texture_Get('NOTEXTURE', NoTextureID) then
 341             begin
 342               e_GetTextureSize(NoTextureID, @NW, @NH);
 343               e_DrawFill(NoTextureID, tx, ty, tw div NW, th div NH, 0, False, False);
 344             end
 345             else
 346             begin
 347               xx := tx + (tw div 2);
 348               yy := ty + (th div 2);
 349               e_DrawFillQuad(tx, ty, xx, yy, 255, 0, 255, 0);
 350               e_DrawFillQuad(xx, ty, tx + tw - 1, yy, 255, 255, 0, 0);
 351               e_DrawFillQuad(tx, yy, xx, ty + th - 1, 255, 255, 0, 0);
 352               e_DrawFillQuad(xx, yy, tx + tw - 1, ty + th - 1, 255, 0, 255, 0);
 353             end;
 354         else
 355           if not p.movingActive then
 356             e_DrawFill(TextureID, tx, ty, tw div w, th div h, p.Alpha, True, p.Blending, hasAmbient)
 357           else
 358             e_DrawFillX(TextureID, tx, ty, tw, th, p.Alpha, True, p.Blending, g_dbg_scale, hasAmbient);
 359           if hasAmbient then
 360             e_AmbientQuad(tx, ty, tw, th, ambColor.r, ambColor.g, ambColor.b, ambColor.a);
 361         end
 362       end
 363     end
 364   end;
 365
 366   procedure r_Panel_DrawShadowVolume (constref p: TPanel; lightX, lightY: Integer; radius: Integer);
 367     var tx, ty, tw, th: Integer; Texture: Cardinal;
 368
 369     procedure extrude (x: Integer; y: Integer);
 370     begin
 371       glVertex2i(x + (x - lightX) * 500, y + (y - lightY) * 500);
 372       //e_WriteLog(Format('  : (%d,%d)', [x + (x - lightX) * 300, y + (y - lightY) * 300]), MSG_WARNING);
 373     end;
 374
 375     procedure drawLine (x0: Integer; y0: Integer; x1: Integer; y1: Integer);
 376     begin
 377       // does this side facing the light?
 378       if ((x1 - x0) * (lightY - y0) - (lightX - x0) * (y1 - y0) >= 0) then exit;
 379       //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING);
 380       // this edge is facing the light, extrude and draw it
 381       glVertex2i(x0, y0);
 382       glVertex2i(x1, y1);
 383       extrude(x1, y1);
 384       extrude(x0, y0);
 385     end;
 386
 387   begin
 388     if radius < 4 then exit;
 389     if p.Enabled and (p.FCurTexture >= 0) and (p.Width > 0) and (p.Height > 0) and (p.Alpha < 255) {and g_Collide(X, Y, tw, th, sX, sY, sWidth, sHeight)} then
 390     begin
 391       Panel_Lerp(p, gLerpFactor, tx, ty, tw, th);
 392       Texture := p.TextureIDs[p.FCurTexture].Texture;
 393       if not RenTextures[Texture].Anim then
 394       begin
 395         case RenTextures[Texture].ID of
 396           LongWord(TEXTURE_SPECIAL_WATER): exit;
 397           LongWord(TEXTURE_SPECIAL_ACID1): exit;
 398           LongWord(TEXTURE_SPECIAL_ACID2): exit;
 399           LongWord(TEXTURE_NONE): exit;
 400         end;
 401       end;
 402       if (tx + tw < lightX - radius) then exit;
 403       if (ty + th < lightY - radius) then exit;
 404       if (tx > lightX + radius) then exit;
 405       if (ty > lightY + radius) then exit;
 406       //e_DrawFill(TextureIDs[FCurTexture].Tex, X, Y, tw div TextureWidth, th div TextureHeight, Alpha, True, Blending);
 407       glBegin(GL_QUADS);
 408         drawLine(tx,      ty,      tx + tw, ty); // top
 409         drawLine(tx + tw, ty,      tx + tw, ty + th); // right
 410         drawLine(tx + tw, ty + th, tx,      ty + th); // bottom
 411         drawLine(tx,      ty + th, tx,      ty); // left
 412       glEnd;
 413     end
 414   end;
 415
 416   procedure r_Map_Update;
 417   begin
 418     FlagAnim.Update
 419   end;
 420
 421 end.