src/game/g_textures.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$INCLUDE ../shared/a_modes.inc}
  16 unit g_textures;
  17
  18 interface
  19
  20 uses
  21   SysUtils, Classes,
  22   {$IFDEF USE_MEMPOOL}mempool,{$ENDIF}
  23   g_base, r_graphics, MAPDEF, ImagingTypes, Imaging, ImagingUtility;
  24
  25 type
  26   TLevelTexture = record
  27     textureName: AnsiString;
  28     width, height: Word;
  29     case anim: Boolean of
  30       false: (textureID: LongWord);
  31       true: (framesID: LongWord; framesCount: Byte; speed: Byte);
  32   end;
  33
  34   TLevelTextureArray = array of TLevelTexture;
  35
  36   TAnimation = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
  37   private
  38     mId: LongWord;
  39     mAlpha: Byte;
  40     mBlending: Boolean;
  41     mCounter: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
  42     mSpeed: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
  43     mCurrentFrame: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
  44     mLoop: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
  45     mEnabled: Boolean; // Ðàáîòà ðàçðåøåíà?
  46     mPlayed: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
  47     mHeight: Word;
  48     mWidth: Word;
  49     mMinLength: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
  50     mRevert: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
  51
  52   public
  53     constructor Create (aframesID: LongWord; aloop: Boolean; aspeed: Byte);
  54     destructor  Destroy (); override;
  55
  56     procedure reset ();
  57     procedure update ();
  58     procedure enable ();
  59     procedure disable ();
  60     procedure revert (r: Boolean);
  61
  62     procedure saveState (st: TStream);
  63     procedure loadState (st: TStream);
  64
  65     function totalFrames (): Integer; inline;
  66
  67   public
  68     property played: Boolean read mPlayed;
  69     property enabled: Boolean read mEnabled;
  70     property isReverse: Boolean read mRevert;
  71     property loop: Boolean read mLoop write mLoop;
  72     property speed: Byte read mSpeed write mSpeed;
  73     property minLength: Byte read mMinLength write mMinLength;
  74     property currentFrame: Integer read mCurrentFrame write mCurrentFrame;
  75     property currentCounter: Byte read mCounter write mCounter;
  76     property counter: Byte read mCounter;
  77     property blending: Boolean read mBlending write mBlending;
  78     property alpha: Byte read mAlpha write mAlpha;
  79     property framesId: LongWord read mId;
  80     property width: Word read mWidth;
  81     property height: Word read mHeight;
  82
  83     property id: LongWord read mId;
  84   end;
  85
  86
  87 function g_Texture_CreateWAD (var ID: LongWord; const Resource: AnsiString; filterHint: Boolean = False): Boolean;
  88 function g_Texture_CreateFile (var ID: LongWord; const FileName: AnsiString): Boolean;
  89 function g_Texture_CreateWADEx (const textureName, Resource: AnsiString; filterHint: Boolean = False): Boolean;
  90 function g_Texture_CreateFileEx (const textureName, FileName: AnsiString): Boolean;
  91 function g_Texture_Get (const textureName: AnsiString; var ID: LongWord): Boolean;
  92 function g_Texture_GetSize (const textureName: AnsiString; var w, h: Integer): Boolean; overload;
  93 function g_Texture_GetSize (ID: LongWord; var w, h: Integer): Boolean; overload;
  94 procedure g_Texture_Delete (const textureName: AnsiString);
  95 procedure g_Texture_DeleteAll ();
  96
  97 function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; const Name: AnsiString; BackAnimation: Boolean=false): Boolean;
  98
  99 function g_Frames_CreateWAD (ID: PDWORD; const Name, Resource: AnsiString; mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
 100 function g_Frames_CreateFile (ID: PDWORD; const Name, FileName: AnsiString; mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
 101 function g_Frames_CreateMemory (ID: PDWORD; const Name: AnsiString; pData: Pointer; dataSize: LongInt;
 102                                 mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
 103 function g_Frames_Dup (const NewName, OldName: AnsiString): Boolean;
 104 //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
 105 function g_Frames_Get (out ID: LongWord; const FramesName: AnsiString): Boolean;
 106 function g_Frames_GetTexture (out ID: LongWord; const FramesName: AnsiString; Frame: Word): Boolean;
 107 function g_Frames_Exists (const FramesName: AnsiString): Boolean;
 108 procedure g_Frames_DeleteByName (const FramesName: AnsiString);
 109 procedure g_Frames_DeleteByID (ID: LongWord);
 110 procedure g_Frames_DeleteAll ();
 111
 112 procedure DumpTextureNames ();
 113
 114   type (* private state *)
 115     TFrames = record
 116       texturesID: array of LongWord;
 117       name: AnsiString;
 118       frameWidth, frameHeight: Word;
 119       used: Boolean;
 120     end;
 121
 122   var (* private state *)
 123     framesArray: array of TFrames = nil;
 124
 125 implementation
 126
 127 uses
 128   g_game, e_log, g_basic, g_console, wadreader,
 129   g_language, utils, xstreams;
 130
 131 type
 132   _TTexture = record
 133     name: AnsiString;
 134     id: LongWord;
 135     width, height: Word;
 136     used: Boolean;
 137   end;
 138
 139 var
 140   texturesArray: array of _TTexture = nil;
 141
 142
 143 const
 144   ANIM_SIGNATURE = $4D494E41; // 'ANIM'
 145
 146
 147 function allocTextureSlot (): LongWord;
 148 var
 149   f: integer;
 150 begin
 151   for f := 0 to High(texturesArray) do
 152   begin
 153     if (not texturesArray[f].used) then
 154     begin
 155       result := f;
 156       exit;
 157     end;
 158   end;
 159
 160   result := Length(texturesArray);
 161   SetLength(texturesArray, result+64);
 162   for f := result to High(texturesArray) do
 163   begin
 164     with texturesArray[f] do
 165     begin
 166       name := '';
 167       id := 0;
 168       width := 0;
 169       height := 0;
 170       used := false;
 171     end;
 172   end;
 173 end;
 174
 175
 176 function allocFrameSlot (): LongWord;
 177 var
 178   f: integer;
 179 begin
 180   for f := 0 to High(framesArray) do
 181   begin
 182     if (not framesArray[f].used) then
 183     begin
 184       result := f;
 185       exit;
 186     end;
 187   end;
 188
 189   result := Length(framesArray);
 190   SetLength(framesArray, result+64);
 191   for f := result to High(framesArray) do
 192   begin
 193     with framesArray[f] do
 194     begin
 195       texturesID := nil;
 196       name := '';
 197       frameWidth := 0;
 198       frameHeight := 0;
 199       used := false;
 200     end;
 201   end;
 202 end;
 203
 204
 205 // ////////////////////////////////////////////////////////////////////////// //
 206 function g_Texture_CreateWAD (var ID: LongWord; const Resource: AnsiString; filterHint: Boolean = False): Boolean;
 207 var
 208   WAD: TWADFile;
 209   FileName: AnsiString;
 210   TextureData: Pointer;
 211   ResourceLength: Integer;
 212 begin
 213   result := false;
 214   FileName := g_ExtractWadName(Resource);
 215
 216   WAD := TWADFile.Create;
 217   WAD.ReadFile(FileName);
 218
 219   if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
 220   begin
 221     if e_CreateTextureMem(TextureData, ResourceLength, ID, filterHint) then
 222       result := true;
 223     FreeMem(TextureData)
 224   end
 225   else
 226   begin
 227     e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
 228     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 229   end;
 230   WAD.Free();
 231 end;
 232
 233
 234 function g_Texture_CreateFile (var ID: LongWord; const FileName: AnsiString): Boolean;
 235 begin
 236   result := true;
 237   if not e_CreateTexture(FileName, ID) then
 238   begin
 239     e_WriteLog(Format('Error loading texture %s', [FileName]), TMsgType.Warning);
 240     result := false;
 241   end;
 242 end;
 243
 244
 245 function g_Texture_CreateWADEx (const textureName, Resource: AnsiString; filterHint: Boolean = False): Boolean;
 246 var
 247   WAD: TWADFile;
 248   FileName: AnsiString;
 249   TextureData: Pointer;
 250   find_id: LongWord;
 251   ResourceLength: Integer;
 252 begin
 253   FileName := g_ExtractWadName(Resource);
 254
 255   find_id := allocTextureSlot();
 256
 257   WAD := TWADFile.Create;
 258   WAD.ReadFile(FileName);
 259
 260   if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
 261   begin
 262     result := e_CreateTextureMem(TextureData, ResourceLength, texturesArray[find_id].ID, filterHint);
 263     if result then
 264     begin
 265       e_GetTextureSize(texturesArray[find_id].ID, @texturesArray[find_id].width, @texturesArray[find_id].height);
 266       texturesArray[find_id].used := true;
 267       texturesArray[find_id].Name := textureName;
 268     end;
 269     FreeMem(TextureData)
 270   end
 271   else
 272   begin
 273     e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
 274     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 275     result := false;
 276   end;
 277   WAD.Free();
 278 end;
 279
 280
 281 function g_Texture_CreateFileEx (const textureName, FileName: AnsiString): Boolean;
 282 var
 283   find_id: LongWord;
 284 begin
 285   find_id := allocTextureSlot();
 286   result := e_CreateTexture(FileName, texturesArray[find_id].ID);
 287   if result then
 288   begin
 289     texturesArray[find_id].used := true;
 290     texturesArray[find_id].Name := textureName;
 291     e_GetTextureSize(texturesArray[find_id].ID, @texturesArray[find_id].width, @texturesArray[find_id].height);
 292   end
 293   else e_WriteLog(Format('Error loading texture %s', [FileName]), TMsgType.Warning);
 294 end;
 295
 296
 297 function g_Texture_Get (const textureName: AnsiString; var id: LongWord): Boolean;
 298 var
 299   a: Integer;
 300 begin
 301   result := false;
 302   if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
 303   for a := 0 to High(texturesArray) do
 304   begin
 305     if (StrEquCI1251(texturesArray[a].name, textureName)) then
 306     begin
 307       id := texturesArray[a].id;
 308       result := true;
 309       break;
 310     end;
 311   end;
 312   //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
 313 end;
 314
 315
 316 function g_Texture_GetSize (const textureName: AnsiString; var w, h: Integer): Boolean; overload;
 317 var
 318   a: Integer;
 319 begin
 320   result := false;
 321   w := 0;
 322   h := 0;
 323   if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
 324   for a := 0 to High(texturesArray) do
 325   begin
 326     if (StrEquCI1251(texturesArray[a].name, textureName)) then
 327     begin
 328       w := texturesArray[a].width;
 329       h := texturesArray[a].height;
 330       result := true;
 331       break;
 332     end;
 333   end;
 334 end;
 335
 336
 337 function g_Texture_GetSize (ID: LongWord; var w, h: Integer): Boolean; overload;
 338 var
 339   a: Integer;
 340 begin
 341   result := false;
 342   w := 0;
 343   h := 0;
 344   if (Length(texturesArray) = 0) then exit;
 345   for a := 0 to High(texturesArray) do
 346   begin
 347     if (texturesArray[a].id = ID) then
 348     begin
 349       w := texturesArray[a].width;
 350       h := texturesArray[a].height;
 351       result := true;
 352       break;
 353     end;
 354   end;
 355 end;
 356
 357
 358 procedure g_Texture_Delete (const textureName: AnsiString);
 359 var
 360   a: Integer;
 361 begin
 362   if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
 363   for a := 0 to High(texturesArray) do
 364   begin
 365     if (StrEquCI1251(texturesArray[a].name, textureName)) then
 366     begin
 367       e_DeleteTexture(texturesArray[a].ID);
 368       texturesArray[a].used := false;
 369       texturesArray[a].name := '';
 370       texturesArray[a].id := 0;
 371       texturesArray[a].width := 0;
 372       texturesArray[a].height := 0;
 373     end;
 374   end;
 375 end;
 376
 377
 378 procedure g_Texture_DeleteAll ();
 379 var
 380   a: Integer;
 381 begin
 382   for a := 0 to High(texturesArray) do
 383   begin
 384     if (texturesArray[a].used) then e_DeleteTexture(texturesArray[a].ID);
 385   end;
 386   texturesArray := nil;
 387 end;
 388
 389
 390 function g_Frames_CreateFile (ID: PDWORD; const Name, FileName: AnsiString;
 391                               mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 392 var
 393   a: Integer;
 394   find_id: LongWord;
 395 begin
 396   result := false;
 397
 398   find_id := allocFrameSlot();
 399
 400   if (mCount <= 2) then BackAnimation := false;
 401
 402   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 403   else SetLength(framesArray[find_id].TexturesID, mCount);
 404
 405   for a := 0 to mCount-1 do
 406   begin
 407     if not e_CreateTextureEx(FileName, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then exit;
 408   end;
 409
 410   if BackAnimation then
 411   begin
 412     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 413   end;
 414
 415   framesArray[find_id].used := true;
 416   framesArray[find_id].FrameWidth := mWidth;
 417   framesArray[find_id].FrameHeight := mHeight;
 418   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 419
 420   if (ID <> nil) then ID^ := find_id;
 421
 422   result := true;
 423 end;
 424
 425
 426 function CreateFramesMem (pData: Pointer; dataSize: LongInt; ID: PDWORD; Name: AnsiString;
 427                           mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 428 var
 429   find_id: LongWord;
 430   a: Integer;
 431 begin
 432   result := false;
 433
 434   find_id := allocFrameSlot();
 435
 436   if (mCount <= 2) then BackAnimation := false;
 437
 438   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 439   else SetLength(framesArray[find_id].TexturesID, mCount);
 440
 441   for a := 0 to mCount-1 do
 442     if not e_CreateTextureMemEx(pData, dataSize, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then
 443     begin
 444       //!!!FreeMem(pData);
 445       exit;
 446     end;
 447
 448   if BackAnimation then
 449   begin
 450     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 451   end;
 452
 453   framesArray[find_id].used := true;
 454   framesArray[find_id].FrameWidth := mWidth;
 455   framesArray[find_id].FrameHeight := mHeight;
 456   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 457
 458   if (ID <> nil) then ID^ := find_id;
 459
 460   result := true;
 461 end;
 462
 463
 464 function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; const Name: AnsiString; BackAnimation: Boolean = false): Boolean;
 465 var
 466   find_id: LongWord;
 467   a, mCount: Integer;
 468 begin
 469   result := false;
 470   find_id := allocFrameSlot();
 471
 472   mCount := Length(ia);
 473
 474   //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
 475
 476   if (mCount < 1) then exit;
 477   if (mCount <= 2) then BackAnimation := false;
 478
 479   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 480   else SetLength(framesArray[find_id].TexturesID, mCount);
 481
 482   //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
 483
 484   for a := 0 to mCount-1 do
 485   begin
 486     if not e_CreateTextureImg(ia[a], framesArray[find_id].TexturesID[a]) then exit;
 487     //e_WriteLog(Format('+++   frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
 488   end;
 489
 490   if BackAnimation then
 491   begin
 492     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 493   end;
 494
 495   framesArray[find_id].used := true;
 496   framesArray[find_id].FrameWidth := ia[0].width;
 497   framesArray[find_id].FrameHeight := ia[0].height;
 498   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 499
 500   if (ID <> nil) then ID^ := find_id;
 501
 502   result := true;
 503 end;
 504
 505
 506 function g_Frames_CreateWAD (ID: PDWORD; const Name, Resource: AnsiString;
 507                              mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
 508 var
 509   WAD: TWADFile;
 510   FileName: AnsiString;
 511   TextureData: Pointer;
 512   ResourceLength: Integer;
 513 begin
 514   result := false;
 515
 516   // models without "advanced" animations asks for "nothing" like this; don't spam log
 517   if (Length(Resource) > 0) and ((Resource[Length(Resource)] = '/') or (Resource[Length(Resource)] = '\')) then exit;
 518
 519   FileName := g_ExtractWadName(Resource);
 520
 521   WAD := TWADFile.Create();
 522   WAD.ReadFile(FileName);
 523
 524   if not WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
 525   begin
 526     WAD.Free();
 527     e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
 528     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 529     exit;
 530   end;
 531
 532   if not CreateFramesMem(TextureData, ResourceLength, ID, Name, mWidth, mHeight, mCount, BackAnimation) then
 533   begin
 534     FreeMem(TextureData);
 535     WAD.Free();
 536     exit;
 537   end;
 538
 539   FreeMem(TextureData);
 540   WAD.Free();
 541
 542   result := true;
 543 end;
 544
 545
 546 function g_Frames_CreateMemory (ID: PDWORD; const Name: AnsiString; pData: Pointer; dataSize: LongInt;
 547                                 mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 548 begin
 549   result := CreateFramesMem(pData, dataSize, ID, Name, mWidth, mHeight, mCount, BackAnimation);
 550 end;
 551
 552
 553 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
 554 var
 555   find_id, b: DWORD;
 556   a, c: Integer;
 557 begin
 558  Result := False;
 559
 560  if not g_Frames_Get(b, Frames) then Exit;
 561
 562  find_id := FindFrame();
 563
 564  FramesArray[find_id].Name := Name;
 565  FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
 566  FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
 567
 568  c := High(FramesArray[find_id].TexturesID);
 569
 570  for a := 0 to c do
 571   FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
 572
 573  Result := True;
 574 end;}
 575
 576
 577 function g_Frames_Dup (const NewName, OldName: AnsiString): Boolean;
 578 var
 579   find_id, b: LongWord;
 580   a, c: Integer;
 581 begin
 582   result := false;
 583
 584   if not g_Frames_Get(b, OldName) then exit;
 585
 586   find_id := allocFrameSlot();
 587
 588   framesArray[find_id].used := true;
 589   framesArray[find_id].Name := NewName;
 590   framesArray[find_id].FrameWidth := framesArray[b].FrameWidth;
 591   framesArray[find_id].FrameHeight := framesArray[b].FrameHeight;
 592
 593   c := High(framesArray[b].TexturesID);
 594   SetLength(framesArray[find_id].TexturesID, c+1);
 595
 596   for a := 0 to c do framesArray[find_id].TexturesID[a] := framesArray[b].TexturesID[a];
 597
 598   result := true;
 599 end;
 600
 601
 602 procedure g_Frames_DeleteByName (const FramesName: AnsiString);
 603 var
 604   a, b: Integer;
 605 begin
 606   if (Length(framesArray) = 0) then exit;
 607   for a := 0 to High(framesArray) do
 608   begin
 609     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 610     begin
 611       if framesArray[a].TexturesID <> nil then
 612       begin
 613         for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]);
 614       end;
 615       framesArray[a].used := false;
 616       framesArray[a].TexturesID := nil;
 617       framesArray[a].Name := '';
 618       framesArray[a].FrameWidth := 0;
 619       framesArray[a].FrameHeight := 0;
 620     end;
 621   end;
 622 end;
 623
 624
 625 procedure g_Frames_DeleteByID (ID: LongWord);
 626 var
 627   b: Integer;
 628 begin
 629   if (Length(framesArray) = 0) then exit;
 630   if (framesArray[ID].TexturesID <> nil) then
 631   begin
 632     for b := 0 to High(framesArray[ID].TexturesID) do e_DeleteTexture(framesArray[ID].TexturesID[b]);
 633   end;
 634   framesArray[ID].used := false;
 635   framesArray[ID].TexturesID := nil;
 636   framesArray[ID].Name := '';
 637   framesArray[ID].FrameWidth := 0;
 638   framesArray[ID].FrameHeight := 0;
 639 end;
 640
 641
 642 procedure g_Frames_DeleteAll ();
 643 var
 644   a, b: Integer;
 645 begin
 646   for a := 0 to High(framesArray) do
 647   begin
 648     if (framesArray[a].used) then
 649     begin
 650       for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]);
 651     end;
 652     framesArray[a].used := false;
 653     framesArray[a].TexturesID := nil;
 654     framesArray[a].Name := '';
 655     framesArray[a].FrameWidth := 0;
 656     framesArray[a].FrameHeight := 0;
 657   end;
 658   framesArray := nil;
 659 end;
 660
 661
 662 function g_Frames_Get (out ID: LongWord; const FramesName: AnsiString): Boolean;
 663 var
 664   a: Integer;
 665 begin
 666   result := false;
 667   if (Length(framesArray) = 0) then exit;
 668   for a := 0 to High(framesArray) do
 669   begin
 670     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 671     begin
 672       ID := a;
 673       result := true;
 674       break;
 675     end;
 676   end;
 677   if not result then g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
 678 end;
 679
 680
 681 function g_Frames_GetTexture (out ID: LongWord; const FramesName: AnsiString; Frame: Word): Boolean;
 682 var
 683   a: Integer;
 684 begin
 685   result := false;
 686   if (Length(framesArray) = 0) then exit;
 687   for a := 0 to High(framesArray) do
 688   begin
 689     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 690     begin
 691       if (Frame < Length(framesArray[a].TexturesID)) then
 692       begin
 693         ID := framesArray[a].TexturesID[Frame];
 694         result := true;
 695         break;
 696       end;
 697     end;
 698   end;
 699   if not result then g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
 700 end;
 701
 702
 703 function g_Frames_Exists (const FramesName: AnsiString): Boolean;
 704 var
 705   a: Integer;
 706 begin
 707   result := false;
 708   if (Length(framesArray) = 0) then exit;
 709   for a := 0 to High(framesArray) do
 710   begin
 711     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 712     begin
 713       result := true;
 714       exit;
 715     end;
 716   end;
 717 end;
 718
 719
 720 procedure DumpTextureNames ();
 721 var
 722   i: Integer;
 723 begin
 724   e_WriteLog('BEGIN Textures:', TMsgType.Notify);
 725   for i := 0 to High(texturesArray) do e_WriteLog('   '+IntToStr(i)+'. '+texturesArray[i].Name, TMsgType.Notify);
 726   e_WriteLog('END Textures.', TMsgType.Notify);
 727
 728   e_WriteLog('BEGIN Frames:', TMsgType.Notify);
 729   for i := 0 to High(framesArray) do e_WriteLog('   '+IntToStr(i)+'. '+framesArray[i].Name, TMsgType.Notify);
 730   e_WriteLog('END Frames.', TMsgType.Notify);
 731 end;
 732
 733
 734 { TAnimation }
 735
 736 constructor TAnimation.Create (aframesID: LongWord; aloop: Boolean; aspeed: Byte);
 737 begin
 738   if (aframesID >= Length(framesArray)) then
 739   begin
 740     //raise Exception.Create('trying to create inexisting frame: something is very wrong here');
 741     e_LogWritefln('trying to create inexisting frame %u of %u: something is very wrong here', [aframesID, LongWord(Length(framesArray))], TMsgType.Warning);
 742     aframesID := 0;
 743     if (Length(framesArray) = 0) then raise Exception.Create('trying to create inexisting frame: something is very wrong here');
 744   end;
 745   mId := aframesID;
 746   mMinLength := 0;
 747   mLoop := aloop;
 748   mSpeed := aspeed;
 749   mEnabled := true;
 750   mCurrentFrame := 0;
 751   mPlayed := false;
 752   mAlpha := 0;
 753   mWidth := framesArray[mId].FrameWidth;
 754   mHeight := framesArray[mId].FrameHeight;
 755 end;
 756
 757
 758 destructor TAnimation.Destroy ();
 759 begin
 760   inherited;
 761 end;
 762
 763
 764 procedure TAnimation.update ();
 765 begin
 766   if (not mEnabled) then exit;
 767
 768   mCounter += 1;
 769
 770   if (mCounter >= mSpeed) then
 771   begin
 772     // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
 773     // Îáðàòíûé ïîðÿäîê êàäðîâ?
 774     if mRevert then
 775     begin
 776       // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå
 777       if (mCurrentFrame = 0) then
 778       begin
 779         if (Length(framesArray[mId].TexturesID)*mSpeed+mCounter < mMinLength) then exit;
 780       end;
 781
 782       mCurrentFrame -= 1;
 783       mPlayed := (mCurrentFrame < 0);
 784
 785       // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó?
 786       if mPlayed then
 787       begin
 788         if mLoop then mCurrentFrame := High(framesArray[mId].TexturesID) else mCurrentFrame += 1;
 789       end;
 790
 791       mCounter := 0;
 792     end
 793     else
 794     begin
 795       // Ïðÿìîé ïîðÿäîê êàäðîâ
 796       // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå
 797       if (mCurrentFrame = High(framesArray[mId].TexturesID)) then
 798       begin
 799         if (Length(framesArray[mId].TexturesID)*mSpeed+mCounter < mMinLength) then exit;
 800       end;
 801
 802       mCurrentFrame += 1;
 803       mPlayed := (mCurrentFrame > High(framesArray[mId].TexturesID));
 804
 805       // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó?
 806       if mPlayed then
 807       begin
 808         if mLoop then mCurrentFrame := 0 else mCurrentFrame -= 1;
 809       end;
 810
 811       mCounter := 0;
 812     end;
 813   end;
 814 end;
 815
 816
 817 procedure TAnimation.reset ();
 818 begin
 819   if mRevert then mCurrentFrame := High(framesArray[mId].TexturesID) else mCurrentFrame := 0;
 820   mCounter := 0;
 821   mPlayed := false;
 822 end;
 823
 824
 825 procedure TAnimation.disable (); begin mEnabled := false; end;
 826 procedure TAnimation.enable (); begin mEnabled := true; end;
 827
 828
 829 function TAnimation.totalFrames (): Integer; inline; begin result := Length(framesArray[mId].TexturesID); end;
 830
 831
 832 procedure TAnimation.revert (r: Boolean);
 833 begin
 834   mRevert := r;
 835   reset();
 836 end;
 837
 838
 839 procedure TAnimation.saveState (st: TStream);
 840 begin
 841   if (st = nil) then exit;
 842
 843   utils.writeSign(st, 'ANIM');
 844   utils.writeInt(st, Byte(0)); // version
 845   // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
 846   utils.writeInt(st, Byte(mCounter));
 847   // Òåêóùèé êàäð
 848   utils.writeInt(st, LongInt(mCurrentFrame));
 849   // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
 850   utils.writeBool(st, mPlayed);
 851   // Alpha-êàíàë âñåé òåêñòóðû
 852   utils.writeInt(st, Byte(mAlpha));
 853   // Ðàçìûòèå òåêñòóðû
 854   utils.writeInt(st, Byte(mBlending));
 855   // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
 856   utils.writeInt(st, Byte(mSpeed));
 857   // Çàöèêëåíà ëè àíèìàöèÿ
 858   utils.writeBool(st, mLoop);
 859   // Âêëþ÷åíà ëè
 860   utils.writeBool(st, mEnabled);
 861   // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
 862   utils.writeInt(st, Byte(mMinLength));
 863   // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
 864   utils.writeBool(st, mRevert);
 865 end;
 866
 867
 868 procedure TAnimation.loadState (st: TStream);
 869 begin
 870   if (st = nil) then exit;
 871
 872   if not utils.checkSign(st, 'ANIM') then raise XStreamError.Create('animation chunk expected');
 873   if (utils.readByte(st) <> 0) then raise XStreamError.Create('invalid animation chunk version');
 874   // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
 875   mCounter := utils.readByte(st);
 876   // Òåêóùèé êàäð
 877   mCurrentFrame := utils.readLongInt(st);
 878   // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
 879   mPlayed := utils.readBool(st);
 880   // Alpha-êàíàë âñåé òåêñòóðû
 881   mAlpha := utils.readByte(st);
 882   // Ðàçìûòèå òåêñòóðû
 883   mBlending := utils.readBool(st);
 884   // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
 885   mSpeed := utils.readByte(st);
 886   // Çàöèêëåíà ëè àíèìàöèÿ
 887   mLoop := utils.readBool(st);
 888   // Âêëþ÷åíà ëè
 889   mEnabled := utils.readBool(st);
 890   // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
 891   mMinLength := utils.readByte(st);
 892   // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
 893   mRevert := utils.readBool(st);
 894 end;
 895
 896 end.