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