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