src/game/g_textures.pas

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