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