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