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