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