src/game/g_textures.pas

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