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