src/game/g_textures.pas

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