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