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