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; const altrsrc: 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 texture_CreateWADExInternal (const textureName, Resource: AnsiString; showmsg: Boolean): 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     if showmsg then
 282     begin
 283       e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
 284     end;
 285     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 286     result := false;
 287   end;
 288   WAD.Free();
 289 end;
 290
 291
 292 function g_Texture_CreateWADEx (const textureName, Resource: AnsiString; const altrsrc: AnsiString=''): Boolean;
 293 begin
 294   if (Length(altrsrc) > 0) then
 295   begin
 296     result := texture_CreateWADExInternal(textureName, altrsrc, false);
 297     if result then exit;
 298   end;
 299   result := texture_CreateWADExInternal(textureName, Resource, true);
 300 end;
 301
 302
 303 function g_Texture_CreateFileEx (const textureName, FileName: AnsiString): Boolean;
 304 var
 305   find_id: LongWord;
 306 begin
 307   find_id := allocTextureSlot();
 308   result := e_CreateTexture(FileName, texturesArray[find_id].ID);
 309   if result then
 310   begin
 311     texturesArray[find_id].used := true;
 312     texturesArray[find_id].Name := textureName;
 313     e_GetTextureSize(texturesArray[find_id].ID, @texturesArray[find_id].width, @texturesArray[find_id].height);
 314   end
 315   else e_WriteLog(Format('Error loading texture %s', [FileName]), TMsgType.Warning);
 316 end;
 317
 318
 319 function g_Texture_Get (const textureName: AnsiString; var id: LongWord): Boolean;
 320 var
 321   a: Integer;
 322 begin
 323   result := false;
 324   if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
 325   for a := 0 to High(texturesArray) do
 326   begin
 327     if (StrEquCI1251(texturesArray[a].name, textureName)) then
 328     begin
 329       id := texturesArray[a].id;
 330       result := true;
 331       break;
 332     end;
 333   end;
 334   //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
 335 end;
 336
 337
 338 procedure g_Texture_Delete (const textureName: AnsiString);
 339 var
 340   a: Integer;
 341 begin
 342   if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
 343   for a := 0 to High(texturesArray) do
 344   begin
 345     if (StrEquCI1251(texturesArray[a].name, textureName)) then
 346     begin
 347       e_DeleteTexture(texturesArray[a].ID);
 348       texturesArray[a].used := false;
 349       texturesArray[a].name := '';
 350       texturesArray[a].id := 0;
 351       texturesArray[a].width := 0;
 352       texturesArray[a].height := 0;
 353     end;
 354   end;
 355 end;
 356
 357
 358 procedure g_Texture_DeleteAll ();
 359 var
 360   a: Integer;
 361 begin
 362   for a := 0 to High(texturesArray) do
 363   begin
 364     if (texturesArray[a].used) then e_DeleteTexture(texturesArray[a].ID);
 365   end;
 366   texturesArray := nil;
 367 end;
 368
 369
 370 function g_Frames_CreateFile (ID: PDWORD; const Name, FileName: AnsiString;
 371                               mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 372 var
 373   a: Integer;
 374   find_id: LongWord;
 375 begin
 376   result := false;
 377
 378   find_id := allocFrameSlot();
 379
 380   if (mCount <= 2) then BackAnimation := false;
 381
 382   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 383   else SetLength(framesArray[find_id].TexturesID, mCount);
 384
 385   for a := 0 to mCount-1 do
 386   begin
 387     if not e_CreateTextureEx(FileName, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then exit;
 388   end;
 389
 390   if BackAnimation then
 391   begin
 392     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 393   end;
 394
 395   framesArray[find_id].used := true;
 396   framesArray[find_id].FrameWidth := mWidth;
 397   framesArray[find_id].FrameHeight := mHeight;
 398   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 399
 400   if (ID <> nil) then ID^ := find_id;
 401
 402   result := true;
 403 end;
 404
 405
 406 function CreateFramesMem (pData: Pointer; dataSize: LongInt; ID: PDWORD; Name: AnsiString;
 407                           mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 408 var
 409   find_id: LongWord;
 410   a: Integer;
 411 begin
 412   result := false;
 413
 414   find_id := allocFrameSlot();
 415
 416   if (mCount <= 2) then BackAnimation := false;
 417
 418   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 419   else SetLength(framesArray[find_id].TexturesID, mCount);
 420
 421   for a := 0 to mCount-1 do
 422     if not e_CreateTextureMemEx(pData, dataSize, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then
 423     begin
 424       //!!!FreeMem(pData);
 425       exit;
 426     end;
 427
 428   if BackAnimation then
 429   begin
 430     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 431   end;
 432
 433   framesArray[find_id].used := true;
 434   framesArray[find_id].FrameWidth := mWidth;
 435   framesArray[find_id].FrameHeight := mHeight;
 436   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 437
 438   if (ID <> nil) then ID^ := find_id;
 439
 440   result := true;
 441 end;
 442
 443
 444 function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; const Name: AnsiString; BackAnimation: Boolean = false): Boolean;
 445 var
 446   find_id: LongWord;
 447   a, mCount: Integer;
 448 begin
 449   result := false;
 450   find_id := allocFrameSlot();
 451
 452   mCount := Length(ia);
 453
 454   //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
 455
 456   if (mCount < 1) then exit;
 457   if (mCount <= 2) then BackAnimation := false;
 458
 459   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 460   else SetLength(framesArray[find_id].TexturesID, mCount);
 461
 462   //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
 463
 464   for a := 0 to mCount-1 do
 465   begin
 466     if not e_CreateTextureImg(ia[a], framesArray[find_id].TexturesID[a]) then exit;
 467     //e_WriteLog(Format('+++   frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
 468   end;
 469
 470   if BackAnimation then
 471   begin
 472     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 473   end;
 474
 475   framesArray[find_id].used := true;
 476   framesArray[find_id].FrameWidth := ia[0].width;
 477   framesArray[find_id].FrameHeight := ia[0].height;
 478   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 479
 480   if (ID <> nil) then ID^ := find_id;
 481
 482   result := true;
 483 end;
 484
 485
 486 function g_Frames_CreateWAD (ID: PDWORD; const Name, Resource: AnsiString;
 487                              mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
 488 var
 489   WAD: TWADFile;
 490   FileName: AnsiString;
 491   TextureData: Pointer;
 492   ResourceLength: Integer;
 493 begin
 494   result := false;
 495
 496   // models without "advanced" animations asks for "nothing" like this; don't spam log
 497   if (Length(Resource) > 0) and ((Resource[Length(Resource)] = '/') or (Resource[Length(Resource)] = '\')) then exit;
 498
 499   FileName := g_ExtractWadName(Resource);
 500
 501   WAD := TWADFile.Create();
 502   WAD.ReadFile(FileName);
 503
 504   if not WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
 505   begin
 506     WAD.Free();
 507     e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
 508     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 509     exit;
 510   end;
 511
 512   if not CreateFramesMem(TextureData, ResourceLength, ID, Name, mWidth, mHeight, mCount, BackAnimation) then
 513   begin
 514     WAD.Free();
 515     exit;
 516   end;
 517
 518   WAD.Free();
 519
 520   result := true;
 521 end;
 522
 523
 524 function g_Frames_CreateMemory (ID: PDWORD; const Name: AnsiString; pData: Pointer; dataSize: LongInt;
 525                                 mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 526 begin
 527   result := CreateFramesMem(pData, dataSize, ID, Name, mWidth, mHeight, mCount, BackAnimation);
 528 end;
 529
 530
 531 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
 532 var
 533   find_id, b: DWORD;
 534   a, c: Integer;
 535 begin
 536  Result := False;
 537
 538  if not g_Frames_Get(b, Frames) then Exit;
 539
 540  find_id := FindFrame();
 541
 542  FramesArray[find_id].Name := Name;
 543  FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
 544  FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
 545
 546  c := High(FramesArray[find_id].TexturesID);
 547
 548  for a := 0 to c do
 549   FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
 550
 551  Result := True;
 552 end;}
 553
 554
 555 function g_Frames_Dup (const NewName, OldName: AnsiString): Boolean;
 556 var
 557   find_id, b: LongWord;
 558   a, c: Integer;
 559 begin
 560   result := false;
 561
 562   if not g_Frames_Get(b, OldName) then exit;
 563
 564   find_id := allocFrameSlot();
 565
 566   framesArray[find_id].used := true;
 567   framesArray[find_id].Name := NewName;
 568   framesArray[find_id].FrameWidth := framesArray[b].FrameWidth;
 569   framesArray[find_id].FrameHeight := framesArray[b].FrameHeight;
 570
 571   c := High(framesArray[b].TexturesID);
 572   SetLength(framesArray[find_id].TexturesID, c+1);
 573
 574   for a := 0 to c do framesArray[find_id].TexturesID[a] := framesArray[b].TexturesID[a];
 575
 576   result := true;
 577 end;
 578
 579
 580 procedure g_Frames_DeleteByName (const FramesName: AnsiString);
 581 var
 582   a, b: Integer;
 583 begin
 584   if (Length(framesArray) = 0) then exit;
 585   for a := 0 to High(framesArray) do
 586   begin
 587     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 588     begin
 589       if framesArray[a].TexturesID <> nil then
 590       begin
 591         for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]);
 592       end;
 593       framesArray[a].used := false;
 594       framesArray[a].TexturesID := nil;
 595       framesArray[a].Name := '';
 596       framesArray[a].FrameWidth := 0;
 597       framesArray[a].FrameHeight := 0;
 598     end;
 599   end;
 600 end;
 601
 602
 603 procedure g_Frames_DeleteByID (ID: LongWord);
 604 var
 605   b: Integer;
 606 begin
 607   if (Length(framesArray) = 0) then exit;
 608   if (framesArray[ID].TexturesID <> nil) then
 609   begin
 610     for b := 0 to High(framesArray[ID].TexturesID) do e_DeleteTexture(framesArray[ID].TexturesID[b]);
 611   end;
 612   framesArray[ID].used := false;
 613   framesArray[ID].TexturesID := nil;
 614   framesArray[ID].Name := '';
 615   framesArray[ID].FrameWidth := 0;
 616   framesArray[ID].FrameHeight := 0;
 617 end;
 618
 619
 620 procedure g_Frames_DeleteAll ();
 621 var
 622   a, b: Integer;
 623 begin
 624   for a := 0 to High(framesArray) do
 625   begin
 626     if (framesArray[a].used) then
 627     begin
 628       for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]);
 629     end;
 630     framesArray[a].used := false;
 631     framesArray[a].TexturesID := nil;
 632     framesArray[a].Name := '';
 633     framesArray[a].FrameWidth := 0;
 634     framesArray[a].FrameHeight := 0;
 635   end;
 636   framesArray := nil;
 637 end;
 638
 639
 640 function g_Frames_Get (out ID: LongWord; const FramesName: AnsiString): Boolean;
 641 var
 642   a: Integer;
 643 begin
 644   result := false;
 645   if (Length(framesArray) = 0) then exit;
 646   for a := 0 to High(framesArray) do
 647   begin
 648     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 649     begin
 650       ID := a;
 651       result := true;
 652       break;
 653     end;
 654   end;
 655   if not result then g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
 656 end;
 657
 658
 659 function g_Frames_GetTexture (out ID: LongWord; const FramesName: AnsiString; Frame: Word): Boolean;
 660 var
 661   a: Integer;
 662 begin
 663   result := false;
 664   if (Length(framesArray) = 0) then exit;
 665   for a := 0 to High(framesArray) do
 666   begin
 667     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 668     begin
 669       if (Frame < Length(framesArray[a].TexturesID)) then
 670       begin
 671         ID := framesArray[a].TexturesID[Frame];
 672         result := true;
 673         break;
 674       end;
 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_Exists (const FramesName: AnsiString): 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       result := true;
 692       exit;
 693     end;
 694   end;
 695 end;
 696
 697
 698 procedure DumpTextureNames ();
 699 var
 700   i: Integer;
 701 begin
 702   e_WriteLog('BEGIN Textures:', TMsgType.Notify);
 703   for i := 0 to High(texturesArray) do e_WriteLog('   '+IntToStr(i)+'. '+texturesArray[i].Name, TMsgType.Notify);
 704   e_WriteLog('END Textures.', TMsgType.Notify);
 705
 706   e_WriteLog('BEGIN Frames:', TMsgType.Notify);
 707   for i := 0 to High(framesArray) do e_WriteLog('   '+IntToStr(i)+'. '+framesArray[i].Name, TMsgType.Notify);
 708   e_WriteLog('END Frames.', TMsgType.Notify);
 709 end;
 710
 711
 712 { TAnimation }
 713
 714 constructor TAnimation.Create (aframesID: LongWord; aloop: Boolean; aspeed: Byte);
 715 begin
 716   if (aframesID >= Length(framesArray)) then raise Exception.Create('trying to create inexisting frame: something is very wrong here');
 717   mId := aframesID;
 718   mMinLength := 0;
 719   mLoop := aloop;
 720   mSpeed := aspeed;
 721   mEnabled := true;
 722   mCurrentFrame := 0;
 723   mPlayed := false;
 724   mAlpha := 0;
 725   mWidth := framesArray[mId].FrameWidth;
 726   mHeight := framesArray[mId].FrameHeight;
 727 end;
 728
 729
 730 destructor TAnimation.Destroy ();
 731 begin
 732   inherited;
 733 end;
 734
 735
 736 procedure TAnimation.draw (x, y: Integer; mirror: TMirrorType);
 737 begin
 738   if (not mEnabled) then exit;
 739   e_DrawAdv(framesArray[mId].TexturesID[mCurrentFrame], x, y, mAlpha, true, mBlending, 0, nil, mirror);
 740   //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
 741 end;
 742
 743
 744 procedure TAnimation.update ();
 745 begin
 746   if (not mEnabled) then exit;
 747
 748   mCounter += 1;
 749
 750   if (mCounter >= mSpeed) then
 751   begin
 752     // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
 753     // Îáðàòíûé ïîðÿäîê êàäðîâ?
 754     if mRevert then
 755     begin
 756       // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå
 757       if (mCurrentFrame = 0) then
 758       begin
 759         if (Length(framesArray[mId].TexturesID)*mSpeed+mCounter < mMinLength) then exit;
 760       end;
 761
 762       mCurrentFrame -= 1;
 763       mPlayed := (mCurrentFrame < 0);
 764
 765       // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó?
 766       if mPlayed then
 767       begin
 768         if mLoop then mCurrentFrame := High(framesArray[mId].TexturesID) else mCurrentFrame += 1;
 769       end;
 770
 771       mCounter := 0;
 772     end
 773     else
 774     begin
 775       // Ïðÿìîé ïîðÿäîê êàäðîâ
 776       // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå
 777       if (mCurrentFrame = High(framesArray[mId].TexturesID)) then
 778       begin
 779         if (Length(framesArray[mId].TexturesID)*mSpeed+mCounter < mMinLength) then exit;
 780       end;
 781
 782       mCurrentFrame += 1;
 783       mPlayed := (mCurrentFrame > High(framesArray[mId].TexturesID));
 784
 785       // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó?
 786       if mPlayed then
 787       begin
 788         if mLoop then mCurrentFrame := 0 else mCurrentFrame -= 1;
 789       end;
 790
 791       mCounter := 0;
 792     end;
 793   end;
 794 end;
 795
 796
 797 procedure TAnimation.reset ();
 798 begin
 799   if mRevert then mCurrentFrame := High(framesArray[mId].TexturesID) else mCurrentFrame := 0;
 800   mCounter := 0;
 801   mPlayed := false;
 802 end;
 803
 804
 805 procedure TAnimation.disable (); begin mEnabled := false; end;
 806 procedure TAnimation.enable (); begin mEnabled := true; end;
 807
 808
 809 procedure TAnimation.drawEx (x, y: Integer; mirror: TMirrorType; rpoint: TDFPoint; angle: SmallInt);
 810 begin
 811   if (not mEnabled) then exit;
 812   e_DrawAdv(framesArray[mId].TexturesID[mCurrentFrame], x, y, mAlpha, true, mBlending, angle, @rpoint, mirror);
 813 end;
 814
 815
 816 function TAnimation.totalFrames (): Integer; inline; begin result := Length(framesArray[mId].TexturesID); end;
 817
 818
 819 procedure TAnimation.revert (r: Boolean);
 820 begin
 821   mRevert := r;
 822   reset();
 823 end;
 824
 825
 826 procedure TAnimation.saveState (st: TStream);
 827 begin
 828   if (st = nil) then exit;
 829
 830   utils.writeSign(st, 'ANIM');
 831   utils.writeInt(st, Byte(0)); // version
 832   // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
 833   utils.writeInt(st, Byte(mCounter));
 834   // Òåêóùèé êàäð
 835   utils.writeInt(st, LongInt(mCurrentFrame));
 836   // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
 837   utils.writeBool(st, mPlayed);
 838   // Alpha-êàíàë âñåé òåêñòóðû
 839   utils.writeInt(st, Byte(mAlpha));
 840   // Ðàçìûòèå òåêñòóðû
 841   utils.writeInt(st, Byte(mBlending));
 842   // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
 843   utils.writeInt(st, Byte(mSpeed));
 844   // Çàöèêëåíà ëè àíèìàöèÿ
 845   utils.writeBool(st, mLoop);
 846   // Âêëþ÷åíà ëè
 847   utils.writeBool(st, mEnabled);
 848   // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
 849   utils.writeInt(st, Byte(mMinLength));
 850   // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
 851   utils.writeBool(st, mRevert);
 852 end;
 853
 854
 855 procedure TAnimation.loadState (st: TStream);
 856 begin
 857   if (st = nil) then exit;
 858
 859   if not utils.checkSign(st, 'ANIM') then raise XStreamError.Create('animation chunk expected');
 860   if (utils.readByte(st) <> 0) then raise XStreamError.Create('invalid animation chunk version');
 861   // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
 862   mCounter := utils.readByte(st);
 863   // Òåêóùèé êàäð
 864   mCurrentFrame := utils.readLongInt(st);
 865   // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
 866   mPlayed := utils.readBool(st);
 867   // Alpha-êàíàë âñåé òåêñòóðû
 868   mAlpha := utils.readByte(st);
 869   // Ðàçìûòèå òåêñòóðû
 870   mBlending := utils.readBool(st);
 871   // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
 872   mSpeed := utils.readByte(st);
 873   // Çàöèêëåíà ëè àíèìàöèÿ
 874   mLoop := utils.readBool(st);
 875   // Âêëþ÷åíà ëè
 876   mEnabled := utils.readBool(st);
 877   // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
 878   mMinLength := utils.readByte(st);
 879   // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
 880   mRevert := utils.readBool(st);
 881 end;
 882
 883
 884 // ////////////////////////////////////////////////////////////////////////// //
 885 var
 886   ltexid: GLuint = 0;
 887
 888 function g_Texture_Light (): Integer;
 889 const
 890   Radius: Integer = 128;
 891 var
 892   tex, tpp: PByte;
 893   x, y, a: Integer;
 894   dist: Double;
 895 begin
 896   if ltexid = 0 then
 897   begin
 898     GetMem(tex, (Radius*2)*(Radius*2)*4);
 899     tpp := tex;
 900     for y := 0 to Radius*2-1 do
 901     begin
 902       for x := 0 to Radius*2-1 do
 903       begin
 904         dist := 1.0-sqrt((x-Radius)*(x-Radius)+(y-Radius)*(y-Radius))/Radius;
 905         if (dist < 0) then
 906         begin
 907           tpp^ := 0; Inc(tpp);
 908           tpp^ := 0; Inc(tpp);
 909           tpp^ := 0; Inc(tpp);
 910           tpp^ := 0; Inc(tpp);
 911         end
 912         else
 913         begin
 914           //tc.setPixel(x, y, Color(cast(int)(dist*255), cast(int)(dist*255), cast(int)(dist*255)));
 915           if (dist > 0.5) then dist := 0.5;
 916           a := round(dist*255);
 917           if (a < 0) then a := 0 else if (a > 255) then a := 255;
 918           tpp^ := 255; Inc(tpp);
 919           tpp^ := 255; Inc(tpp);
 920           tpp^ := 255; Inc(tpp);
 921           tpp^ := Byte(a); Inc(tpp);
 922         end;
 923       end;
 924     end;
 925
 926     glGenTextures(1, @ltexid);
 927     //if (tid == 0) assert(0, "VGL: can't create screen texture");
 928
 929     glBindTexture(GL_TEXTURE_2D, ltexid);
 930     glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
 931     glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
 932     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
 933     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
 934
 935     //GLfloat[4] bclr = 0.0;
 936     //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
 937
 938     glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Radius*2, Radius*2, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex);
 939   end;
 940
 941   result := ltexid;
 942 end;
 943
 944
 945 end.