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