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