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   tx, ty: Integer;
 225   Mirror: TMirrorType;
 226 begin
 227   if gGameSettings.GameMode <> GM_CTF then
 228     Exit;
 229
 230   for i := FLAG_RED to FLAG_BLUE do
 231     with gFlags[i] do
 232       if State <> FLAG_STATE_CAPTURED then
 233       begin
 234         if State = FLAG_STATE_NONE then
 235           continue;
 236
 237         Obj.lerp(gLerpFactor, tx, ty);
 238
 239         if Direction = TDirection.D_LEFT then
 240           begin
 241             Mirror := TMirrorType.Horizontal;
 242             dx := -1;
 243           end
 244         else
 245           begin
 246             Mirror := TMirrorType.None;
 247             dx := 1;
 248           end;
 249
 250         r_Animation_Draw(Animation, tx + dx, ty + 1, Mirror);
 251
 252         if g_debug_Frames then
 253         begin
 254           e_DrawQuad(Obj.X+Obj.Rect.X,
 255                      Obj.Y+Obj.Rect.Y,
 256                      Obj.X+Obj.Rect.X+Obj.Rect.Width-1,
 257                      Obj.Y+Obj.Rect.Y+Obj.Rect.Height-1,
 258                      0, 255, 0);
 259         end;
 260       end;
 261 end;
 262
 263   procedure Panel_Lerp (p: TPanel; t: Single; out tX, tY, tW, tH: Integer);
 264   begin
 265     if p.movingActive then
 266     begin
 267       tX := nlerp(p.OldX, p.X, t);
 268       tY := nlerp(p.OldY, p.Y, t);
 269       tW := nlerp(p.OldWidth, p.Width, t);
 270       tH := nlerp(p.OldHeight, p.Height, t);
 271     end
 272     else
 273     begin
 274       tX := p.X;
 275       tY := p.Y;
 276       tW := p.Width;
 277       tH := p.Height;
 278     end;
 279   end;
 280
 281   procedure r_Panel_Draw (constref p: TPanel; hasAmbient: Boolean; constref ambColor: TDFColor);
 282     var tx, ty, tw, th, xx, yy: Integer; NoTextureID, TextureID, FramesID: DWORD; NW, NH: Word; Texture: Cardinal; IsAnim: Boolean; w, h: Integer;
 283   begin
 284     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
 285     begin
 286       Panel_Lerp(p, gLerpFactor, tx, ty, tw, th);
 287       Texture := p.TextureIDs[p.FCurTexture].Texture;
 288       IsAnim := RenTextures[Texture].Anim;
 289       if IsAnim then
 290       begin
 291         if p.TextureIDs[p.FCurTexture].AnTex <> nil then
 292         begin
 293           FramesID := RenTextures[Texture].ID;
 294           w := RenTextures[Texture].Width;
 295           h := RenTextures[Texture].Height;
 296           for xx := 0 to tw div w - 1 do
 297             for yy := 0 to th div h - 1 do
 298               r_AnimationState_Draw(FramesID, p.TextureIDs[p.FCurTexture].AnTex, tx + xx * w, ty + yy * h, TMirrorType.None);
 299         end
 300       end
 301       else
 302       begin
 303         TextureID := RenTextures[Texture].ID;
 304         w := RenTextures[Texture].Width;
 305         h := RenTextures[Texture].Height;
 306         case TextureID of
 307           LongWord(TEXTURE_SPECIAL_WATER): e_DrawFillQuad(tx, ty, tx + tw - 1, ty + th - 1, 0, 0, 255, 0, TBlending.Filter);
 308           LongWord(TEXTURE_SPECIAL_ACID1): e_DrawFillQuad(tx, ty, tx + tw - 1, ty + th - 1, 0, 230, 0, 0, TBlending.Filter);
 309           LongWord(TEXTURE_SPECIAL_ACID2): e_DrawFillQuad(tx, ty, tx + tw - 1, ty + th - 1, 230, 0, 0, 0, TBlending.Filter);
 310           LongWord(TEXTURE_NONE):
 311             if g_Texture_Get('NOTEXTURE', NoTextureID) then
 312             begin
 313               e_GetTextureSize(NoTextureID, @NW, @NH);
 314               e_DrawFill(NoTextureID, tx, ty, tw div NW, th div NH, 0, False, False);
 315             end
 316             else
 317             begin
 318               xx := tx + (tw div 2);
 319               yy := ty + (th div 2);
 320               e_DrawFillQuad(tx, ty, xx, yy, 255, 0, 255, 0);
 321               e_DrawFillQuad(xx, ty, tx + tw - 1, yy, 255, 255, 0, 0);
 322               e_DrawFillQuad(tx, yy, xx, ty + th - 1, 255, 255, 0, 0);
 323               e_DrawFillQuad(xx, yy, tx + tw - 1, ty + th - 1, 255, 0, 255, 0);
 324             end;
 325         else
 326           if not p.movingActive then
 327             e_DrawFill(TextureID, tx, ty, tw div w, th div h, p.Alpha, True, p.Blending, hasAmbient)
 328           else
 329             e_DrawFillX(TextureID, tx, ty, tw, th, p.Alpha, True, p.Blending, g_dbg_scale, hasAmbient);
 330           if hasAmbient then
 331             e_AmbientQuad(tx, ty, tw, th, ambColor.r, ambColor.g, ambColor.b, ambColor.a);
 332         end
 333       end
 334     end
 335   end;
 336
 337   procedure r_Panel_DrawShadowVolume (constref p: TPanel; lightX, lightY: Integer; radius: Integer);
 338     var tx, ty, tw, th: Integer; Texture: Cardinal;
 339
 340     procedure extrude (x: Integer; y: Integer);
 341     begin
 342       glVertex2i(x + (x - lightX) * 500, y + (y - lightY) * 500);
 343       //e_WriteLog(Format('  : (%d,%d)', [x + (x - lightX) * 300, y + (y - lightY) * 300]), MSG_WARNING);
 344     end;
 345
 346     procedure drawLine (x0: Integer; y0: Integer; x1: Integer; y1: Integer);
 347     begin
 348       // does this side facing the light?
 349       if ((x1 - x0) * (lightY - y0) - (lightX - x0) * (y1 - y0) >= 0) then exit;
 350       //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING);
 351       // this edge is facing the light, extrude and draw it
 352       glVertex2i(x0, y0);
 353       glVertex2i(x1, y1);
 354       extrude(x1, y1);
 355       extrude(x0, y0);
 356     end;
 357
 358   begin
 359     if radius < 4 then exit;
 360     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
 361     begin
 362       Panel_Lerp(p, gLerpFactor, tx, ty, tw, th);
 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 (tx + tw < lightX - radius) then exit;
 374       if (ty + th < lightY - radius) then exit;
 375       if (tx > lightX + radius) then exit;
 376       if (ty > lightY + radius) then exit;
 377       //e_DrawFill(TextureIDs[FCurTexture].Tex, X, Y, tw div TextureWidth, th div TextureHeight, Alpha, True, Blending);
 378       glBegin(GL_QUADS);
 379         drawLine(tx,      ty,      tx + tw, ty); // top
 380         drawLine(tx + tw, ty,      tx + tw, ty + th); // right
 381         drawLine(tx + tw, ty + th, tx,      ty + th); // bottom
 382         drawLine(tx,      ty + th, tx,      ty); // left
 383       glEnd;
 384     end
 385   end;
 386
 387 end.