src/game/g_panel.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, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$MODE DELPHI}
  17 unit g_panel;
  18
  19 interface
  20
  21 uses
  22   MAPSTRUCT, BinEditor, g_textures;
  23
  24 type
  25   TAddTextureArray = Array of
  26     record
  27       Texture: Cardinal;
  28       Anim: Boolean;
  29     end;
  30
  31   TPanel = Class (TObject)
  32   private
  33     FTextureWidth:    Word;
  34     FTextureHeight:   Word;
  35     FAlpha:           Byte;
  36     FBlending:        Boolean;
  37     FTextureIDs:      Array of
  38                         record
  39                           case Anim: Boolean of
  40                             False: (Tex: Cardinal);
  41                             True:  (AnTex: TAnimation);
  42                         end;
  43
  44   public
  45     FCurTexture:      Integer; // Íîìåð òåêóùåé òåêñòóðû
  46     FCurFrame:        Integer;
  47     FCurFrameCount:   Byte;
  48     X, Y:             Integer;
  49     Width, Height:    Word;
  50     PanelType:        Word;
  51     SaveIt:           Boolean; // Ñîõðàíÿòü ïðè SaveState?
  52     Enabled:          Boolean;
  53     Door:             Boolean;
  54     Moved:            Boolean;
  55     LiftType:         Byte;
  56     LastAnimLoop:     Byte;
  57
  58     constructor Create(PanelRec: TPanelRec_1;
  59                        AddTextures: TAddTextureArray;
  60                        CurTex: Integer;
  61                        var Textures: TLevelTextureArray);
  62     destructor  Destroy(); override;
  63
  64     procedure   Draw();
  65     procedure   Update();
  66     procedure   SetFrame(Frame: Integer; Count: Byte);
  67     procedure   NextTexture(AnimLoop: Byte = 0);
  68     procedure   SetTexture(ID: Integer; AnimLoop: Byte = 0);
  69     function    GetTextureID(): Cardinal;
  70     function    GetTextureCount(): Integer;
  71
  72     procedure   SaveState(var Mem: TBinMemoryWriter);
  73     procedure   LoadState(var Mem: TBinMemoryReader);
  74   end;
  75
  76   TPanelArray = Array of TPanel;
  77
  78 implementation
  79
  80 uses
  81   SysUtils, g_basic, g_map, MAPDEF, g_game, e_graphics,
  82   g_console, g_language, e_log;
  83
  84 const
  85   PANEL_SIGNATURE = $4C4E4150; // 'PANL'
  86
  87 { T P a n e l : }
  88
  89 constructor TPanel.Create(PanelRec: TPanelRec_1;
  90                           AddTextures: TAddTextureArray;
  91                           CurTex: Integer;
  92                           var Textures: TLevelTextureArray);
  93 var
  94   i: Integer;
  95 begin
  96   X := PanelRec.X;
  97   Y := PanelRec.Y;
  98   Width := PanelRec.Width;
  99   Height := PanelRec.Height;
 100   FAlpha := 0;
 101   FBlending := False;
 102   FCurFrame := 0;
 103   FCurFrameCount := 0;
 104   LastAnimLoop := 0;
 105   Moved := False;
 106
 107 // Òèï ïàíåëè:
 108   PanelType := PanelRec.PanelType;
 109   Enabled := True;
 110   Door := False;
 111   LiftType := 0;
 112   SaveIt := False;
 113
 114   case PanelType of
 115     PANEL_OPENDOOR:
 116       begin
 117         Enabled := False;
 118         Door := True;
 119         SaveIt := True;
 120       end;
 121     PANEL_CLOSEDOOR:
 122       begin
 123         Door := True;
 124         SaveIt := True;
 125       end;
 126     PANEL_LIFTUP:
 127       SaveIt := True;
 128     PANEL_LIFTDOWN:
 129       begin
 130         LiftType := 1;
 131         SaveIt := True;
 132       end;
 133     PANEL_LIFTLEFT:
 134       begin
 135         LiftType := 2;
 136         SaveIt := True;
 137       end;
 138     PANEL_LIFTRIGHT:
 139       begin
 140         LiftType := 3;
 141         SaveIt := True;
 142       end;
 143   end;
 144
 145 // Íåâèäèìàÿ:
 146   if ByteBool(PanelRec.Flags and PANEL_FLAG_HIDE) then
 147   begin
 148     SetLength(FTextureIDs, 0);
 149     FCurTexture := -1;
 150     Exit;
 151   end;
 152 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
 153   if ByteBool(PanelType and
 154     (PANEL_LIFTUP or
 155      PANEL_LIFTDOWN or
 156      PANEL_LIFTLEFT or
 157      PANEL_LIFTRIGHT or
 158      PANEL_BLOCKMON)) then
 159   begin
 160     SetLength(FTextureIDs, 0);
 161     FCurTexture := -1;
 162     Exit;
 163   end;
 164
 165 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
 166   if WordBool(PanelType and (PANEL_WATER or PANEL_ACID1 or PANEL_ACID2)) and
 167      (not ByteBool(PanelRec.Flags and PANEL_FLAG_WATERTEXTURES)) then
 168   begin
 169     SetLength(FTextureIDs, 1);
 170     FTextureIDs[0].Anim := False;
 171
 172     case PanelRec.PanelType of
 173       PANEL_WATER:
 174         FTextureIDs[0].Tex := TEXTURE_SPECIAL_WATER;
 175       PANEL_ACID1:
 176         FTextureIDs[0].Tex := TEXTURE_SPECIAL_ACID1;
 177       PANEL_ACID2:
 178         FTextureIDs[0].Tex := TEXTURE_SPECIAL_ACID2;
 179     end;
 180
 181     FCurTexture := 0;
 182     Exit;
 183   end;
 184
 185   SetLength(FTextureIDs, Length(AddTextures));
 186
 187   if CurTex < 0 then
 188     FCurTexture := -1
 189   else
 190     if CurTex >= Length(FTextureIDs) then
 191       FCurTexture := Length(FTextureIDs) - 1
 192     else
 193       FCurTexture := CurTex;
 194
 195   for i := 0 to Length(FTextureIDs)-1 do
 196   begin
 197     FTextureIDs[i].Anim := AddTextures[i].Anim;
 198     if FTextureIDs[i].Anim then
 199       begin // Àíèìèðîâàííàÿ òåêñòóðà
 200         FTextureIDs[i].AnTex :=
 201            TAnimation.Create(Textures[AddTextures[i].Texture].FramesID,
 202                              True, Textures[AddTextures[i].Texture].Speed);
 203         FTextureIDs[i].AnTex.Blending := ByteBool(PanelRec.Flags and PANEL_FLAG_BLENDING);
 204         FTextureIDs[i].AnTex.Alpha := PanelRec.Alpha;
 205         SaveIt := True;
 206       end
 207     else
 208       begin // Îáû÷íàÿ òåêñòóðà
 209         FTextureIDs[i].Tex := Textures[AddTextures[i].Texture].TextureID;
 210       end;
 211   end;
 212
 213 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
 214   if Length(FTextureIDs) > 1 then
 215     SaveIt := True;
 216
 217 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
 218   if PanelRec.TextureNum > High(Textures) then
 219   begin
 220     e_WriteLog(Format('WTF?! PanelRec.TextureNum is out of limits! (%d : %d)', [PanelRec.TextureNum, High(Textures)]), MSG_FATALERROR);
 221     FTextureWidth := 2;
 222     FTextureHeight := 2;
 223     FAlpha := 0;
 224     FBlending := ByteBool(0);
 225   end
 226   else if not g_Map_IsSpecialTexture(Textures[PanelRec.TextureNum].TextureName) then
 227   begin
 228     FTextureWidth := Textures[PanelRec.TextureNum].Width;
 229     FTextureHeight := Textures[PanelRec.TextureNum].Height;
 230     FAlpha := PanelRec.Alpha;
 231     FBlending := ByteBool(PanelRec.Flags and PANEL_FLAG_BLENDING);
 232   end;
 233 end;
 234
 235 destructor TPanel.Destroy();
 236 var
 237   i: Integer;
 238 begin
 239   for i := 0 to High(FTextureIDs) do
 240     if FTextureIDs[i].Anim then
 241       FTextureIDs[i].AnTex.Free();
 242   SetLength(FTextureIDs, 0);
 243
 244   Inherited;
 245 end;
 246
 247 procedure TPanel.Draw();
 248 var
 249   xx, yy: Integer;
 250   NoTextureID: DWORD;
 251   NW, NH: Word;
 252 begin
 253   if Enabled and (FCurTexture >= 0) and
 254      (Width > 0) and (Height > 0) and (FAlpha < 255) and
 255      g_Collide(X, Y, Width, Height,
 256                sX, sY, sWidth, sHeight) then
 257   begin
 258     if FTextureIDs[FCurTexture].Anim then
 259       begin // Àíèìèðîâàííàÿ òåêñòóðà
 260         if FTextureIDs[FCurTexture].AnTex = nil then
 261           Exit;
 262
 263         for xx := 0 to (Width div FTextureWidth)-1 do
 264           for yy := 0 to (Height div FTextureHeight)-1 do
 265             FTextureIDs[FCurTexture].AnTex.Draw(
 266               X + xx*FTextureWidth,
 267               Y + yy*FTextureHeight, M_NONE);
 268       end
 269     else
 270       begin // Îáû÷íàÿ òåêñòóðà
 271         case FTextureIDs[FCurTexture].Tex of
 272           TEXTURE_SPECIAL_WATER:
 273             e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1,
 274                            0, 0, 255, 0, B_FILTER);
 275           TEXTURE_SPECIAL_ACID1:
 276             e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1,
 277                            0, 128, 0, 0, B_FILTER);
 278           TEXTURE_SPECIAL_ACID2:
 279             e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1,
 280                            128, 0, 0, 0, B_FILTER);
 281           TEXTURE_NONE:
 282             if g_Texture_Get('NOTEXTURE', NoTextureID) then
 283             begin
 284               e_GetTextureSize(NoTextureID, @NW, @NH);
 285               e_DrawFill(NoTextureID, X, Y, Width div NW, Height div NH,
 286                          0, False, False);
 287             end else
 288             begin
 289               xx := X + (Width div 2);
 290               yy := Y + (Height div 2);
 291               e_DrawFillQuad(X, Y, xx, yy,
 292                              255, 0, 255, 0);
 293               e_DrawFillQuad(xx, Y, X+Width-1, yy,
 294                              255, 255, 0, 0);
 295               e_DrawFillQuad(X, yy, xx, Y+Height-1,
 296                              255, 255, 0, 0);
 297               e_DrawFillQuad(xx, yy, X+Width-1, Y+Height-1,
 298                              255, 0, 255, 0);
 299             end;
 300
 301           else
 302             e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y,
 303                        Width div FTextureWidth,
 304                        Height div FTextureHeight,
 305                        FAlpha, True, FBlending);
 306         end;
 307       end;
 308   end;
 309 end;
 310
 311 procedure TPanel.Update();
 312 begin
 313   if Enabled and (FCurTexture >= 0) and
 314     (FTextureIDs[FCurTexture].Anim) and
 315     (FTextureIDs[FCurTexture].AnTex <> nil) and
 316     (Width > 0) and (Height > 0) and (FAlpha < 255) then
 317   begin
 318     FTextureIDs[FCurTexture].AnTex.Update();
 319     FCurFrame := FTextureIDs[FCurTexture].AnTex.CurrentFrame;
 320     FCurFrameCount := FTextureIDs[FCurTexture].AnTex.CurrentCounter;
 321   end;
 322 end;
 323
 324 procedure TPanel.SetFrame(Frame: Integer; Count: Byte);
 325
 326   function ClampInt(X, A, B: Integer): Integer;
 327   begin
 328     Result := X;
 329     if X < A then Result := A else if X > B then Result := B;
 330   end;
 331
 332 begin
 333   if Enabled and (FCurTexture >= 0) and
 334     (FTextureIDs[FCurTexture].Anim) and
 335     (FTextureIDs[FCurTexture].AnTex <> nil) and
 336     (Width > 0) and (Height > 0) and (FAlpha < 255) then
 337   begin
 338     FCurFrame := ClampInt(Frame, 0, FTextureIDs[FCurTexture].AnTex.TotalFrames);
 339     FCurFrameCount := Count;
 340     FTextureIDs[FCurTexture].AnTex.CurrentFrame := FCurFrame;
 341     FTextureIDs[FCurTexture].AnTex.CurrentCounter := FCurFrameCount;
 342   end;
 343 end;
 344
 345 procedure TPanel.NextTexture(AnimLoop: Byte = 0);
 346 begin
 347   Assert(FCurTexture >= -1, 'FCurTexture < -1');
 348
 349 // Íåò òåêñòóð:
 350   if Length(FTextureIDs) = 0 then
 351     FCurTexture := -1
 352   else
 353   // Òîëüêî îäíà òåêñòóðà:
 354     if Length(FTextureIDs) = 1 then
 355       begin
 356         if FCurTexture = 0 then
 357           FCurTexture := -1
 358         else
 359           FCurTexture := 0;
 360       end
 361     else
 362     // Áîëüøå îäíîé òåêñòóðû:
 363       begin
 364       // Ñëåäóþùàÿ:
 365         Inc(FCurTexture);
 366       // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
 367         if FCurTexture >= Length(FTextureIDs) then
 368           FCurTexture := 0;
 369       end;
 370
 371 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
 372   if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
 373   begin
 374     if (FTextureIDs[FCurTexture].AnTex = nil) then
 375     begin
 376       g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
 377       Exit;
 378     end;
 379
 380     if AnimLoop = 1 then
 381       FTextureIDs[FCurTexture].AnTex.Loop := True
 382     else
 383       if AnimLoop = 2 then
 384         FTextureIDs[FCurTexture].AnTex.Loop := False;
 385
 386     FTextureIDs[FCurTexture].AnTex.Reset();
 387   end;
 388
 389   LastAnimLoop := AnimLoop;
 390 end;
 391
 392 procedure TPanel.SetTexture(ID: Integer; AnimLoop: Byte = 0);
 393 begin
 394 // Íåò òåêñòóð:
 395   if Length(FTextureIDs) = 0 then
 396     FCurTexture := -1
 397   else
 398   // Òîëüêî îäíà òåêñòóðà:
 399     if Length(FTextureIDs) = 1 then
 400       begin
 401         if (ID = 0) or (ID = -1) then
 402           FCurTexture := ID;
 403       end
 404     else
 405     // Áîëüøå îäíîé òåêñòóðû:
 406       begin
 407         if (ID >= -1) and (ID <= High(FTextureIDs)) then
 408           FCurTexture := ID;
 409       end;
 410
 411 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
 412   if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
 413   begin
 414     if (FTextureIDs[FCurTexture].AnTex = nil) then
 415     begin
 416       g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
 417       Exit;
 418     end;
 419
 420     if AnimLoop = 1 then
 421       FTextureIDs[FCurTexture].AnTex.Loop := True
 422     else
 423       if AnimLoop = 2 then
 424         FTextureIDs[FCurTexture].AnTex.Loop := False;
 425
 426     FTextureIDs[FCurTexture].AnTex.Reset();
 427   end;
 428
 429   LastAnimLoop := AnimLoop;
 430 end;
 431
 432 function TPanel.GetTextureID(): DWORD;
 433 begin
 434   Result := TEXTURE_NONE;
 435
 436   if (FCurTexture >= 0) then
 437   begin
 438     if FTextureIDs[FCurTexture].Anim then
 439       Result := FTextureIDs[FCurTexture].AnTex.FramesID
 440     else
 441       Result := FTextureIDs[FCurTexture].Tex;
 442   end;
 443 end;
 444
 445 function TPanel.GetTextureCount(): Integer;
 446 begin
 447   Result := Length(FTextureIDs);
 448   if Enabled and (FCurTexture >= 0) then
 449      if (FTextureIDs[FCurTexture].Anim) and
 450         (FTextureIDs[FCurTexture].AnTex <> nil) and
 451         (Width > 0) and (Height > 0) and (FAlpha < 255) then
 452        Result := Result + 100;
 453 end;
 454
 455 procedure TPanel.SaveState(Var Mem: TBinMemoryWriter);
 456 var
 457   sig: DWORD;
 458   anim: Boolean;
 459 begin
 460   if (not SaveIt) or (Mem = nil) then
 461     Exit;
 462
 463 // Ñèãíàòóðà ïàíåëè:
 464   sig := PANEL_SIGNATURE; // 'PANL'
 465   Mem.WriteDWORD(sig);
 466 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
 467   Mem.WriteBoolean(Enabled);
 468 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
 469   Mem.WriteByte(LiftType);
 470 // Íîìåð òåêóùåé òåêñòóðû:
 471   Mem.WriteInt(FCurTexture);
 472 // Êîîðäû
 473   Mem.WriteInt(X);
 474   Mem.WriteInt(Y);
 475 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
 476   if (FCurTexture >= 0) and (FTextureIDs[FCurTexture].Anim) then
 477     begin
 478       Assert(FTextureIDs[FCurTexture].AnTex <> nil,
 479              'TPanel.SaveState: No animation object');
 480       anim := True;
 481     end
 482   else
 483     anim := False;
 484   Mem.WriteBoolean(anim);
 485 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ:
 486   if anim then
 487     FTextureIDs[FCurTexture].AnTex.SaveState(Mem);
 488 end;
 489
 490 procedure TPanel.LoadState(var Mem: TBinMemoryReader);
 491 var
 492   sig: DWORD;
 493   anim: Boolean;
 494 begin
 495   if (not SaveIt) or (Mem = nil) then
 496     Exit;
 497
 498 // Ñèãíàòóðà ïàíåëè:
 499   Mem.ReadDWORD(sig);
 500   if sig <> PANEL_SIGNATURE then // 'PANL'
 501   begin
 502     raise EBinSizeError.Create('TPanel.LoadState: Wrong Panel Signature');
 503   end;
 504 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
 505   Mem.ReadBoolean(Enabled);
 506 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
 507   Mem.ReadByte(LiftType);
 508 // Íîìåð òåêóùåé òåêñòóðû:
 509   Mem.ReadInt(FCurTexture);
 510 // Êîîðäû
 511   Mem.ReadInt(X);
 512   Mem.ReadInt(Y);
 513 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
 514   Mem.ReadBoolean(anim);
 515 // Åñëè äà - çàãðóæàåì àíèìàöèþ:
 516   if anim then
 517   begin
 518     Assert((FCurTexture >= 0) and
 519            (FTextureIDs[FCurTexture].Anim) and
 520            (FTextureIDs[FCurTexture].AnTex <> nil),
 521            'TPanel.LoadState: No animation object');
 522     FTextureIDs[FCurTexture].AnTex.LoadState(Mem);
 523   end;
 524 end;
 525
 526 end.