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