src/game/g_textures.pas

   1 {$MODE DELPHI}
   2 unit g_textures;
   3
   4 interface
   5
   6 uses
   7   e_graphics, BinEditor;
   8
   9 Type
  10   TLevelTexture = record
  11     TextureName: String;
  12     Width,
  13     Height:      Word;
  14     case Anim: Boolean of
  15       False: (TextureID:   DWORD;);
  16       True:  (FramesID:    DWORD;
  17               FramesCount: Byte;
  18               Speed:       Byte);
  19   end;
  20
  21   TLevelTextureArray = Array of TLevelTexture;
  22
  23   TAnimation = class(TObject)
  24   private
  25     ID:            DWORD;
  26     FAlpha:        Byte;
  27     FBlending:     Boolean;
  28     FCounter:      Byte;    // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
  29     FSpeed:        Byte;    // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
  30     FCurrentFrame: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
  31     FLoop:         Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
  32     FEnabled:      Boolean; // Ðàáîòà ðàçðåøåíà?
  33     FPlayed:       Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
  34     FHeight:       Word;
  35     FWidth:        Word;
  36     FMinLength:    Byte;    // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
  37     FRevert:       Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
  38
  39   public
  40     constructor Create(FramesID: DWORD; Loop: Boolean; Speed: Byte);
  41     destructor  Destroy(); override;
  42     procedure   Draw(X, Y: Integer; Mirror: TMirrorType);
  43     procedure   DrawEx(X, Y: Integer; Mirror: TMirrorType; RPoint: TPoint;
  44                        Angle: SmallInt);
  45     procedure   Reset();
  46     procedure   Update();
  47     procedure   Enable();
  48     procedure   Disable();
  49     procedure   Revert(r: Boolean);
  50     procedure   SaveState(Var Mem: TBinMemoryWriter);
  51     procedure   LoadState(Var Mem: TBinMemoryReader);
  52     function    TotalFrames(): Integer;
  53
  54     property    Played: Boolean read FPlayed;
  55     property    Enabled: Boolean read FEnabled;
  56     property    IsReverse: Boolean read FRevert;
  57     property    Loop: Boolean read FLoop write FLoop;
  58     property    Speed: Byte read FSpeed write FSpeed;
  59     property    MinLength: Byte read FMinLength write FMinLength;
  60     property    CurrentFrame: Integer read FCurrentFrame write FCurrentFrame;
  61     property    CurrentCounter: Byte read FCounter write FCounter;
  62     property    Counter: Byte read FCounter;
  63     property    Blending: Boolean read FBlending write FBlending;
  64     property    Alpha: Byte read FAlpha write FAlpha;
  65     property    FramesID: DWORD read ID;
  66     property    Width: Word read FWidth;
  67     property    Height: Word read FHeight;
  68   end;
  69
  70 function g_Texture_CreateWAD(var ID: DWORD; Resource: String): Boolean;
  71 function g_Texture_CreateFile(var ID: DWORD; FileName: String): Boolean;
  72 function g_Texture_CreateWADEx(TextureName: ShortString; Resource: String): Boolean;
  73 function g_Texture_CreateFileEx(TextureName: ShortString; FileName: String): Boolean;
  74 function g_Texture_Get(TextureName: ShortString; var ID: DWORD): Boolean;
  75 procedure g_Texture_Delete(TextureName: ShortString);
  76 procedure g_Texture_DeleteAll();
  77
  78 function g_Frames_CreateWAD(ID: PDWORD; Name: ShortString; Resource: String;
  79                             FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
  80 function g_Frames_CreateFile(ID: PDWORD; Name: ShortString; FileName: String;
  81                              FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
  82 function g_Frames_CreateMemory(ID: PDWORD; Name: ShortString; pData: Pointer; dataSize: LongInt;
  83                                FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
  84 //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
  85 function g_Frames_Get(var ID: DWORD; FramesName: ShortString): Boolean;
  86 function g_Frames_GetTexture(var ID: DWORD; FramesName: ShortString; Frame: Word): Boolean;
  87 function g_Frames_Exists(FramesName: String): Boolean;
  88 procedure g_Frames_DeleteByName(FramesName: ShortString);
  89 procedure g_Frames_DeleteByID(ID: DWORD);
  90 procedure g_Frames_DeleteAll();
  91
  92 procedure DumpTextureNames();
  93
  94 implementation
  95
  96 uses
  97   g_game, e_log, g_basic, SysUtils, g_console, wadreader,
  98   g_language;
  99
 100 type
 101   _TTexture = record
 102     Name: ShortString;
 103     ID: DWORD;
 104     Width, Height: Word;
 105   end;
 106
 107   TFrames = record
 108     TexturesID: Array of DWORD;
 109     Name: ShortString;
 110     FrameWidth,
 111     FrameHeight: Word;
 112   end;
 113
 114 var
 115   TexturesArray: Array of _TTexture = nil;
 116   FramesArray: Array of TFrames = nil;
 117
 118 const
 119   ANIM_SIGNATURE = $4D494E41; // 'ANIM'
 120
 121 function FindTexture(): DWORD;
 122 var
 123   i: integer;
 124 begin
 125   if TexturesArray <> nil then
 126   for i := 0 to High(TexturesArray) do
 127     if TexturesArray[i].Name = '' then
 128     begin
 129       Result := i;
 130       Exit;
 131     end;
 132
 133   if TexturesArray = nil then
 134   begin
 135     SetLength(TexturesArray, 8);
 136     Result := 0;
 137   end
 138   else
 139   begin
 140     Result := High(TexturesArray) + 1;
 141     SetLength(TexturesArray, Length(TexturesArray) + 8);
 142   end;
 143 end;
 144
 145 function g_Texture_CreateWAD(var ID: DWORD; Resource: String): Boolean;
 146 var
 147   WAD: TWADFile;
 148   FileName: String;
 149   TextureData: Pointer;
 150   ResourceLength: Integer;
 151 begin
 152   Result := False;
 153   FileName := g_ExtractWadName(Resource);
 154
 155   WAD := TWADFile.Create;
 156   WAD.ReadFile(FileName);
 157
 158   if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
 159   begin
 160     if e_CreateTextureMem(TextureData, ResourceLength, ID) then
 161       Result := True
 162     else
 163       FreeMem(TextureData);
 164   end
 165   else
 166   begin
 167     e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
 168     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 169   end;
 170   WAD.Free();
 171 end;
 172
 173 function g_Texture_CreateFile(var ID: DWORD; FileName: String): Boolean;
 174 begin
 175   Result := True;
 176   if not e_CreateTexture(FileName, ID) then
 177   begin
 178     e_WriteLog(Format('Error loading texture %s', [FileName]), MSG_WARNING);
 179     Result := False;
 180   end;
 181 end;
 182
 183 function g_Texture_CreateWADEx(TextureName: ShortString; Resource: String): Boolean;
 184 var
 185   WAD: TWADFile;
 186   FileName: String;
 187   TextureData: Pointer;
 188   find_id: DWORD;
 189   ResourceLength: Integer;
 190 begin
 191   FileName := g_ExtractWadName(Resource);
 192
 193   find_id := FindTexture();
 194
 195   WAD := TWADFile.Create;
 196   WAD.ReadFile(FileName);
 197
 198   if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
 199   begin
 200     Result := e_CreateTextureMem(TextureData, ResourceLength, TexturesArray[find_id].ID);
 201     if Result then
 202     begin
 203       e_GetTextureSize(TexturesArray[find_id].ID, @TexturesArray[find_id].Width,
 204                        @TexturesArray[find_id].Height);
 205       TexturesArray[find_id].Name := LowerCase(TextureName);
 206     end
 207     else
 208       FreeMem(TextureData);
 209   end
 210   else
 211   begin
 212     e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
 213     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 214     Result := False;
 215   end;
 216   WAD.Free();
 217 end;
 218
 219 function g_Texture_CreateFileEx(TextureName: ShortString; FileName: String): Boolean;
 220 var
 221   find_id: DWORD;
 222 begin
 223   find_id := FindTexture;
 224
 225   Result := e_CreateTexture(FileName, TexturesArray[find_id].ID);
 226   if Result then
 227   begin
 228     TexturesArray[find_id].Name := LowerCase(TextureName);
 229     e_GetTextureSize(TexturesArray[find_id].ID, @TexturesArray[find_id].Width,
 230                      @TexturesArray[find_id].Height);
 231   end
 232   else e_WriteLog(Format('Error loading texture %s', [FileName]), MSG_WARNING);
 233 end;
 234
 235 function g_Texture_Get(TextureName: ShortString; var ID: DWORD): Boolean;
 236 var
 237   a: DWORD;
 238 begin
 239   Result := False;
 240
 241   if TexturesArray = nil then Exit;
 242
 243   if TextureName = '' then Exit;
 244
 245   TextureName := LowerCase(TextureName);
 246
 247   for a := 0 to High(TexturesArray) do
 248     if TexturesArray[a].Name = TextureName then
 249     begin
 250       ID := TexturesArray[a].ID;
 251       Result := True;
 252       Break;
 253     end;
 254
 255   //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
 256 end;
 257
 258 procedure g_Texture_Delete(TextureName: ShortString);
 259 var
 260   a: DWORD;
 261 begin
 262   if TexturesArray = nil then Exit;
 263
 264   TextureName := LowerCase(TextureName);
 265
 266   for a := 0 to High(TexturesArray) do
 267     if TexturesArray[a].Name = TextureName then
 268     begin
 269       e_DeleteTexture(TexturesArray[a].ID);
 270       TexturesArray[a].Name := '';
 271       TexturesArray[a].ID := 0;
 272       TexturesArray[a].Width := 0;
 273       TexturesArray[a].Height := 0;
 274     end;
 275 end;
 276
 277 procedure g_Texture_DeleteAll();
 278 var
 279   a: DWORD;
 280 begin
 281   if TexturesArray = nil then Exit;
 282
 283   for a := 0 to High(TexturesArray) do
 284     if TexturesArray[a].Name <> '' then
 285       e_DeleteTexture(TexturesArray[a].ID);
 286
 287   TexturesArray := nil;
 288 end;
 289
 290 function FindFrame(): DWORD;
 291 var
 292   i: integer;
 293 begin
 294   if FramesArray <> nil then
 295     for i := 0 to High(FramesArray) do
 296       if FramesArray[i].TexturesID = nil then
 297       begin
 298         Result := i;
 299         Exit;
 300       end;
 301
 302   if FramesArray = nil then
 303   begin
 304     SetLength(FramesArray, 64);
 305     Result := 0;
 306   end
 307   else
 308   begin
 309     Result := High(FramesArray) + 1;
 310     SetLength(FramesArray, Length(FramesArray) + 64);
 311   end;
 312 end;
 313
 314 function g_Frames_CreateFile(ID: PDWORD; Name: ShortString; FileName: String;
 315                              FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
 316 var
 317   a: Integer;
 318   find_id: DWORD;
 319 begin
 320   Result := False;
 321
 322   find_id := FindFrame;
 323
 324   if FCount <= 2 then BackAnimation := False;
 325
 326   if BackAnimation then SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2)
 327     else SetLength(FramesArray[find_id].TexturesID, FCount);
 328
 329   for a := 0 to FCount-1 do
 330     if not e_CreateTextureEx(FileName, FramesArray[find_id].TexturesID[a],
 331                              a*FWidth, 0, FWidth, FHeight) then Exit;
 332
 333   if BackAnimation then
 334     for a := 1 to FCount-2 do
 335       FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a];
 336
 337   FramesArray[find_id].FrameWidth := FWidth;
 338   FramesArray[find_id].FrameHeight := FHeight;
 339   if Name <> '' then
 340     FramesArray[find_id].Name := LowerCase(Name)
 341   else
 342     FramesArray[find_id].Name := '<noname>';
 343
 344   if ID <> nil then ID^ := find_id;
 345
 346   Result := True;
 347 end;
 348
 349 function CreateFramesMem(pData: Pointer; dataSize: LongInt; ID: PDWORD; Name: ShortString;
 350                          FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
 351 var
 352   find_id: DWORD;
 353   a: Integer;
 354 begin
 355   Result := False;
 356
 357   find_id := FindFrame();
 358
 359   if FCount <= 2 then BackAnimation := False;
 360
 361   if BackAnimation then SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2)
 362     else SetLength(FramesArray[find_id].TexturesID, FCount);
 363
 364   for a := 0 to FCount-1 do
 365     if not e_CreateTextureMemEx(pData, dataSize, FramesArray[find_id].TexturesID[a],
 366                                 a*FWidth, 0, FWidth, FHeight) then
 367     begin
 368       FreeMem(pData);
 369       Exit;
 370     end;
 371
 372   if BackAnimation then
 373     for a := 1 to FCount-2 do
 374       FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a];
 375
 376   FramesArray[find_id].FrameWidth := FWidth;
 377   FramesArray[find_id].FrameHeight := FHeight;
 378   if Name <> '' then
 379     FramesArray[find_id].Name := LowerCase(Name)
 380   else
 381     FramesArray[find_id].Name := '<noname>';
 382
 383   if ID <> nil then ID^ := find_id;
 384
 385   Result := True;
 386 end;
 387
 388 function g_Frames_CreateWAD(ID: PDWORD; Name: ShortString; Resource: string;
 389                             FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
 390 var
 391   WAD: TWADFile;
 392   FileName: string;
 393   TextureData: Pointer;
 394   ResourceLength: Integer;
 395 begin
 396   Result := False;
 397
 398   FileName := g_ExtractWadName(Resource);
 399
 400   WAD := TWADFile.Create();
 401   WAD.ReadFile(FileName);
 402
 403   if not WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
 404   begin
 405     WAD.Free();
 406     e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
 407     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 408     Exit;
 409   end;
 410
 411   if not CreateFramesMem(TextureData, ResourceLength, ID, Name, FWidth, FHeight, FCount, BackAnimation) then
 412   begin
 413     WAD.Free();
 414     Exit;
 415   end;
 416
 417   WAD.Free();
 418
 419   Result := True;
 420 end;
 421
 422 function g_Frames_CreateMemory(ID: PDWORD; Name: ShortString; pData: Pointer; dataSize: LongInt;
 423                                FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
 424 begin
 425   Result := CreateFramesMem(pData, dataSize, ID, Name, FWidth, FHeight, FCount, BackAnimation);
 426 end;
 427
 428 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
 429 var
 430   find_id, b: DWORD;
 431   a, c: Integer;
 432 begin
 433  Result := False;
 434
 435  if not g_Frames_Get(b, Frames) then Exit;
 436
 437  find_id := FindFrame();
 438
 439  FramesArray[find_id].Name := Name;
 440  FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
 441  FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
 442
 443  c := High(FramesArray[find_id].TexturesID);
 444
 445  for a := 0 to c do
 446   FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
 447
 448  Result := True;
 449 end;}
 450
 451 procedure g_Frames_DeleteByName(FramesName: ShortString);
 452 var
 453   a: DWORD;
 454   b: Integer;
 455 begin
 456   if FramesArray = nil then Exit;
 457
 458   FramesName := LowerCase(FramesName);
 459
 460   for a := 0 to High(FramesArray) do
 461     if FramesArray[a].Name = FramesName then
 462     begin
 463       if FramesArray[a].TexturesID <> nil then
 464         for b := 0 to High(FramesArray[a].TexturesID) do
 465           e_DeleteTexture(FramesArray[a].TexturesID[b]);
 466       FramesArray[a].TexturesID := nil;
 467       FramesArray[a].Name := '';
 468       FramesArray[a].FrameWidth := 0;
 469       FramesArray[a].FrameHeight := 0;
 470     end;
 471 end;
 472
 473 procedure g_Frames_DeleteByID(ID: DWORD);
 474 var
 475   b: Integer;
 476 begin
 477   if FramesArray = nil then Exit;
 478
 479   if FramesArray[ID].TexturesID <> nil then
 480     for b := 0 to High(FramesArray[ID].TexturesID) do
 481       e_DeleteTexture(FramesArray[ID].TexturesID[b]);
 482   FramesArray[ID].TexturesID := nil;
 483   FramesArray[ID].Name := '';
 484   FramesArray[ID].FrameWidth := 0;
 485   FramesArray[ID].FrameHeight := 0;
 486 end;
 487
 488 procedure g_Frames_DeleteAll;
 489 var
 490   a: DWORD;
 491   b: DWORD;
 492 begin
 493   if FramesArray = nil then Exit;
 494
 495   for a := 0 to High(FramesArray) do
 496     if FramesArray[a].TexturesID <> nil then
 497     begin
 498       for b := 0 to High(FramesArray[a].TexturesID) do
 499         e_DeleteTexture(FramesArray[a].TexturesID[b]);
 500       FramesArray[a].TexturesID := nil;
 501       FramesArray[a].Name := '';
 502       FramesArray[a].FrameWidth := 0;
 503       FramesArray[a].FrameHeight := 0;
 504     end;
 505
 506   FramesArray := nil;
 507 end;
 508
 509 function g_Frames_Get(var ID: DWORD; FramesName: ShortString): Boolean;
 510 var
 511   a: DWORD;
 512 begin
 513   Result := False;
 514
 515   if FramesArray = nil then
 516     Exit;
 517
 518   FramesName := LowerCase(FramesName);
 519
 520   for a := 0 to High(FramesArray) do
 521     if FramesArray[a].Name = FramesName then
 522     begin
 523       ID := a;
 524       Result := True;
 525       Break;
 526     end;
 527
 528   if not Result then
 529     g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
 530 end;
 531
 532 function g_Frames_GetTexture(var ID: DWORD; FramesName: ShortString; Frame: Word): Boolean;
 533 var
 534   a: DWORD;
 535 begin
 536   Result := False;
 537
 538   if FramesArray = nil then
 539     Exit;
 540
 541   FramesName := LowerCase(FramesName);
 542
 543   for a := 0 to High(FramesArray) do
 544     if FramesArray[a].Name = FramesName then
 545       if Frame <= High(FramesArray[a].TexturesID) then
 546       begin
 547         ID := FramesArray[a].TexturesID[Frame];
 548         Result := True;
 549         Break;
 550       end;
 551
 552   if not Result then
 553     g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
 554 end;
 555
 556 function g_Frames_Exists(FramesName: string): Boolean;
 557 var
 558   a: DWORD;
 559 begin
 560   Result := False;
 561
 562   if FramesArray = nil then Exit;
 563
 564   FramesName := LowerCase(FramesName);
 565
 566   for a := 0 to High(FramesArray) do
 567     if FramesArray[a].Name = FramesName then
 568     begin
 569       Result := True;
 570       Exit;
 571     end;
 572 end;
 573
 574 procedure DumpTextureNames();
 575 var
 576   i: Integer;
 577 begin
 578   e_WriteLog('BEGIN Textures:', MSG_NOTIFY);
 579   for i := 0 to High(TexturesArray) do
 580     e_WriteLog('   '+IntToStr(i)+'. '+TexturesArray[i].Name, MSG_NOTIFY);
 581   e_WriteLog('END Textures.', MSG_NOTIFY);
 582
 583   e_WriteLog('BEGIN Frames:', MSG_NOTIFY);
 584   for i := 0 to High(FramesArray) do
 585     e_WriteLog('   '+IntToStr(i)+'. '+FramesArray[i].Name, MSG_NOTIFY);
 586   e_WriteLog('END Frames.', MSG_NOTIFY);
 587 end;
 588
 589 { TAnimation }
 590
 591 constructor TAnimation.Create(FramesID: DWORD; Loop: Boolean; Speed: Byte);
 592 begin
 593   ID := FramesID;
 594
 595   FMinLength := 0;
 596   FLoop := Loop;
 597   FSpeed := Speed;
 598   FEnabled := True;
 599   FCurrentFrame := 0;
 600   FPlayed := False;
 601   FAlpha := 0;
 602   FWidth := FramesArray[ID].FrameWidth;
 603   FHeight := FramesArray[ID].FrameHeight;
 604 end;
 605
 606 destructor TAnimation.Destroy;
 607 begin
 608   inherited;
 609 end;
 610
 611 procedure TAnimation.Draw(X, Y: Integer; Mirror: TMirrorType);
 612 begin
 613   if not FEnabled then
 614     Exit;
 615
 616   e_DrawAdv(FramesArray[ID].TexturesID[FCurrentFrame], X, Y, FAlpha,
 617             True, FBlending, 0, nil, Mirror);
 618   //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
 619 end;
 620
 621 procedure TAnimation.Update();
 622 begin
 623   if not FEnabled then
 624     Exit;
 625
 626   FCounter := FCounter + 1;
 627
 628   if FCounter >= FSpeed then
 629   begin // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
 630     if FRevert then
 631       begin // Îáðàòíûé ïîðÿäîê êàäðîâ
 632       // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
 633         if FCurrentFrame = 0 then
 634           if Length(FramesArray[ID].TexturesID) * FSpeed +
 635                FCounter < FMinLength then
 636             Exit;
 637
 638         FCurrentFrame := FCurrentFrame - 1;
 639         FPlayed := FCurrentFrame < 0;
 640
 641       // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
 642         if FPlayed then
 643           if FLoop then
 644             FCurrentFrame := High(FramesArray[ID].TexturesID)
 645           else
 646             FCurrentFrame := FCurrentFrame + 1;
 647
 648         FCounter := 0;
 649       end
 650     else
 651       begin // Ïðÿìîé ïîðÿäîê êàäðîâ
 652       // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
 653         if FCurrentFrame = High(FramesArray[ID].TexturesID) then
 654           if Length(FramesArray[ID].TexturesID) * FSpeed +
 655                FCounter < FMinLength then
 656             Exit;
 657
 658         FCurrentFrame := FCurrentFrame + 1;
 659         FPlayed := (FCurrentFrame > High(FramesArray[ID].TexturesID));
 660
 661       // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
 662         if FPlayed then
 663           if FLoop then
 664             FCurrentFrame := 0
 665           else
 666             FCurrentFrame := FCurrentFrame - 1;
 667
 668         FCounter := 0;
 669       end;
 670   end;
 671 end;
 672
 673 procedure TAnimation.Reset();
 674 begin
 675   if FRevert then
 676     FCurrentFrame := High(FramesArray[ID].TexturesID)
 677   else
 678     FCurrentFrame := 0;
 679
 680   FCounter := 0;
 681   FPlayed := False;
 682 end;
 683
 684 procedure TAnimation.Disable;
 685 begin
 686   FEnabled := False;
 687 end;
 688
 689 procedure TAnimation.Enable;
 690 begin
 691   FEnabled := True;
 692 end;
 693
 694 procedure TAnimation.DrawEx(X, Y: Integer; Mirror: TMirrorType; RPoint: TPoint;
 695                             Angle: SmallInt);
 696 begin
 697   if not FEnabled then
 698     Exit;
 699
 700   e_DrawAdv(FramesArray[ID].TexturesID[FCurrentFrame], X, Y, FAlpha,
 701             True, FBlending, Angle, @RPoint, Mirror);
 702 end;
 703
 704 function TAnimation.TotalFrames(): Integer;
 705 begin
 706   Result := Length(FramesArray[ID].TexturesID);
 707 end;
 708
 709 procedure TAnimation.Revert(r: Boolean);
 710 begin
 711   FRevert := r;
 712   Reset();
 713 end;
 714
 715 procedure TAnimation.SaveState(Var Mem: TBinMemoryWriter);
 716 var
 717   sig: DWORD;
 718 begin
 719   if Mem = nil then
 720     Exit;
 721
 722 // Ñèãíàòóðà àíèìàöèè:
 723   sig := ANIM_SIGNATURE; // 'ANIM'
 724   Mem.WriteDWORD(sig);
 725 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
 726   Mem.WriteByte(FCounter);
 727 // Òåêóùèé êàäð:
 728   Mem.WriteInt(FCurrentFrame);
 729 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
 730   Mem.WriteBoolean(FPlayed);
 731 // Alpha-êàíàë âñåé òåêñòóðû:
 732   Mem.WriteByte(FAlpha);
 733 // Ðàçìûòèå òåêñòóðû:
 734   Mem.WriteBoolean(FBlending);
 735 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
 736   Mem.WriteByte(FSpeed);
 737 // Çàöèêëåíà ëè àíèìàöèÿ:
 738   Mem.WriteBoolean(FLoop);
 739 // Âêëþ÷åíà ëè:
 740   Mem.WriteBoolean(FEnabled);
 741 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
 742   Mem.WriteByte(FMinLength);
 743 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
 744   Mem.WriteBoolean(FRevert);
 745 end;
 746
 747 procedure TAnimation.LoadState(Var Mem: TBinMemoryReader);
 748 var
 749   sig: DWORD;
 750 begin
 751   if Mem = nil then
 752     Exit;
 753
 754 // Ñèãíàòóðà àíèìàöèè:
 755   Mem.ReadDWORD(sig);
 756   if sig <> ANIM_SIGNATURE then // 'ANIM'
 757   begin
 758     raise EBinSizeError.Create('TAnimation.LoadState: Wrong Animation Signature');
 759   end;
 760 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
 761   Mem.ReadByte(FCounter);
 762 // Òåêóùèé êàäð:
 763   Mem.ReadInt(FCurrentFrame);
 764 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
 765   Mem.ReadBoolean(FPlayed);
 766 // Alpha-êàíàë âñåé òåêñòóðû:
 767   Mem.ReadByte(FAlpha);
 768 // Ðàçìûòèå òåêñòóðû:
 769   Mem.ReadBoolean(FBlending);
 770 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
 771   Mem.ReadByte(FSpeed);
 772 // Çàöèêëåíà ëè àíèìàöèÿ:
 773   Mem.ReadBoolean(FLoop);
 774 // Âêëþ÷åíà ëè:
 775   Mem.ReadBoolean(FEnabled);
 776 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
 777   Mem.ReadByte(FMinLength);
 778 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
 779   Mem.ReadBoolean(FRevert);
 780 end;
 781
 782 end.