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