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