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