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