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