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   g_game, e_log, g_basic, g_console, wadreader,
 123   g_language, GL, 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     begin
 225       result := true;
 226     end
 227     else
 228     begin
 229       FreeMem(TextureData);
 230     end;
 231   end
 232   else
 233   begin
 234     e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
 235     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 236   end;
 237   WAD.Free();
 238 end;
 239
 240
 241 function g_Texture_CreateFile (var ID: LongWord; const FileName: AnsiString): Boolean;
 242 begin
 243   result := true;
 244   if not e_CreateTexture(FileName, ID) then
 245   begin
 246     e_WriteLog(Format('Error loading texture %s', [FileName]), TMsgType.Warning);
 247     result := false;
 248   end;
 249 end;
 250
 251
 252 function g_Texture_CreateWADEx (const textureName, Resource: AnsiString): Boolean;
 253 var
 254   WAD: TWADFile;
 255   FileName: AnsiString;
 256   TextureData: Pointer;
 257   find_id: LongWord;
 258   ResourceLength: Integer;
 259 begin
 260   FileName := g_ExtractWadName(Resource);
 261
 262   find_id := allocTextureSlot();
 263
 264   WAD := TWADFile.Create;
 265   WAD.ReadFile(FileName);
 266
 267   if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
 268   begin
 269     result := e_CreateTextureMem(TextureData, ResourceLength, texturesArray[find_id].ID);
 270     if result then
 271     begin
 272       e_GetTextureSize(texturesArray[find_id].ID, @texturesArray[find_id].width, @texturesArray[find_id].height);
 273       texturesArray[find_id].used := true;
 274       texturesArray[find_id].Name := textureName;
 275     end
 276     else
 277     begin
 278       FreeMem(TextureData);
 279     end;
 280   end
 281   else
 282   begin
 283     e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
 284     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 285     result := false;
 286   end;
 287   WAD.Free();
 288 end;
 289
 290
 291 function g_Texture_CreateFileEx (const textureName, FileName: AnsiString): Boolean;
 292 var
 293   find_id: LongWord;
 294 begin
 295   find_id := allocTextureSlot();
 296   result := e_CreateTexture(FileName, texturesArray[find_id].ID);
 297   if result then
 298   begin
 299     texturesArray[find_id].used := true;
 300     texturesArray[find_id].Name := textureName;
 301     e_GetTextureSize(texturesArray[find_id].ID, @texturesArray[find_id].width, @texturesArray[find_id].height);
 302   end
 303   else e_WriteLog(Format('Error loading texture %s', [FileName]), TMsgType.Warning);
 304 end;
 305
 306
 307 function g_Texture_Get (const textureName: AnsiString; var id: LongWord): Boolean;
 308 var
 309   a: Integer;
 310 begin
 311   result := false;
 312   if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
 313   for a := 0 to High(texturesArray) do
 314   begin
 315     if (StrEquCI1251(texturesArray[a].name, textureName)) then
 316     begin
 317       id := texturesArray[a].id;
 318       result := true;
 319       break;
 320     end;
 321   end;
 322   //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
 323 end;
 324
 325
 326 function g_Texture_GetSize (const textureName: AnsiString; var w, h: Integer): Boolean; overload;
 327 var
 328   a: Integer;
 329 begin
 330   result := false;
 331   w := 0;
 332   h := 0;
 333   if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
 334   for a := 0 to High(texturesArray) do
 335   begin
 336     if (StrEquCI1251(texturesArray[a].name, textureName)) then
 337     begin
 338       w := texturesArray[a].width;
 339       h := texturesArray[a].height;
 340       result := true;
 341       break;
 342     end;
 343   end;
 344 end;
 345
 346
 347 function g_Texture_GetSize (ID: LongWord; var w, h: Integer): Boolean; overload;
 348 var
 349   a: Integer;
 350 begin
 351   result := false;
 352   w := 0;
 353   h := 0;
 354   if (Length(texturesArray) = 0) then exit;
 355   for a := 0 to High(texturesArray) do
 356   begin
 357     if (texturesArray[a].id = ID) then
 358     begin
 359       w := texturesArray[a].width;
 360       h := texturesArray[a].height;
 361       result := true;
 362       break;
 363     end;
 364   end;
 365 end;
 366
 367
 368 procedure g_Texture_Delete (const textureName: AnsiString);
 369 var
 370   a: Integer;
 371 begin
 372   if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
 373   for a := 0 to High(texturesArray) do
 374   begin
 375     if (StrEquCI1251(texturesArray[a].name, textureName)) then
 376     begin
 377       e_DeleteTexture(texturesArray[a].ID);
 378       texturesArray[a].used := false;
 379       texturesArray[a].name := '';
 380       texturesArray[a].id := 0;
 381       texturesArray[a].width := 0;
 382       texturesArray[a].height := 0;
 383     end;
 384   end;
 385 end;
 386
 387
 388 procedure g_Texture_DeleteAll ();
 389 var
 390   a: Integer;
 391 begin
 392   for a := 0 to High(texturesArray) do
 393   begin
 394     if (texturesArray[a].used) then e_DeleteTexture(texturesArray[a].ID);
 395   end;
 396   texturesArray := nil;
 397 end;
 398
 399
 400 function g_Frames_CreateFile (ID: PDWORD; const Name, FileName: AnsiString;
 401                               mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 402 var
 403   a: Integer;
 404   find_id: LongWord;
 405 begin
 406   result := false;
 407
 408   find_id := allocFrameSlot();
 409
 410   if (mCount <= 2) then BackAnimation := false;
 411
 412   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 413   else SetLength(framesArray[find_id].TexturesID, mCount);
 414
 415   for a := 0 to mCount-1 do
 416   begin
 417     if not e_CreateTextureEx(FileName, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then exit;
 418   end;
 419
 420   if BackAnimation then
 421   begin
 422     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 423   end;
 424
 425   framesArray[find_id].used := true;
 426   framesArray[find_id].FrameWidth := mWidth;
 427   framesArray[find_id].FrameHeight := mHeight;
 428   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 429
 430   if (ID <> nil) then ID^ := find_id;
 431
 432   result := true;
 433 end;
 434
 435
 436 function CreateFramesMem (pData: Pointer; dataSize: LongInt; ID: PDWORD; Name: AnsiString;
 437                           mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 438 var
 439   find_id: LongWord;
 440   a: Integer;
 441 begin
 442   result := false;
 443
 444   find_id := allocFrameSlot();
 445
 446   if (mCount <= 2) then BackAnimation := false;
 447
 448   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 449   else SetLength(framesArray[find_id].TexturesID, mCount);
 450
 451   for a := 0 to mCount-1 do
 452     if not e_CreateTextureMemEx(pData, dataSize, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then
 453     begin
 454       //!!!FreeMem(pData);
 455       exit;
 456     end;
 457
 458   if BackAnimation then
 459   begin
 460     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 461   end;
 462
 463   framesArray[find_id].used := true;
 464   framesArray[find_id].FrameWidth := mWidth;
 465   framesArray[find_id].FrameHeight := mHeight;
 466   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 467
 468   if (ID <> nil) then ID^ := find_id;
 469
 470   result := true;
 471 end;
 472
 473
 474 function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; const Name: AnsiString; BackAnimation: Boolean = false): Boolean;
 475 var
 476   find_id: LongWord;
 477   a, mCount: Integer;
 478 begin
 479   result := false;
 480   find_id := allocFrameSlot();
 481
 482   mCount := Length(ia);
 483
 484   //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
 485
 486   if (mCount < 1) then exit;
 487   if (mCount <= 2) then BackAnimation := false;
 488
 489   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 490   else SetLength(framesArray[find_id].TexturesID, mCount);
 491
 492   //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
 493
 494   for a := 0 to mCount-1 do
 495   begin
 496     if not e_CreateTextureImg(ia[a], framesArray[find_id].TexturesID[a]) then exit;
 497     //e_WriteLog(Format('+++   frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
 498   end;
 499
 500   if BackAnimation then
 501   begin
 502     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 503   end;
 504
 505   framesArray[find_id].used := true;
 506   framesArray[find_id].FrameWidth := ia[0].width;
 507   framesArray[find_id].FrameHeight := ia[0].height;
 508   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 509
 510   if (ID <> nil) then ID^ := find_id;
 511
 512   result := true;
 513 end;
 514
 515
 516 function g_Frames_CreateWAD (ID: PDWORD; const Name, Resource: AnsiString;
 517                              mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
 518 var
 519   WAD: TWADFile;
 520   FileName: AnsiString;
 521   TextureData: Pointer;
 522   ResourceLength: Integer;
 523 begin
 524   result := false;
 525
 526   // models without "advanced" animations asks for "nothing" like this; don't spam log
 527   if (Length(Resource) > 0) and ((Resource[Length(Resource)] = '/') or (Resource[Length(Resource)] = '\')) then exit;
 528
 529   FileName := g_ExtractWadName(Resource);
 530
 531   WAD := TWADFile.Create();
 532   WAD.ReadFile(FileName);
 533
 534   if not WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
 535   begin
 536     WAD.Free();
 537     e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
 538     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 539     exit;
 540   end;
 541
 542   if not CreateFramesMem(TextureData, ResourceLength, ID, Name, mWidth, mHeight, mCount, BackAnimation) then
 543   begin
 544     WAD.Free();
 545     exit;
 546   end;
 547
 548   WAD.Free();
 549
 550   result := true;
 551 end;
 552
 553
 554 function g_Frames_CreateMemory (ID: PDWORD; const Name: AnsiString; pData: Pointer; dataSize: LongInt;
 555                                 mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 556 begin
 557   result := CreateFramesMem(pData, dataSize, ID, Name, mWidth, mHeight, mCount, BackAnimation);
 558 end;
 559
 560
 561 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
 562 var
 563   find_id, b: DWORD;
 564   a, c: Integer;
 565 begin
 566  Result := False;
 567
 568  if not g_Frames_Get(b, Frames) then Exit;
 569
 570  find_id := FindFrame();
 571
 572  FramesArray[find_id].Name := Name;
 573  FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
 574  FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
 575
 576  c := High(FramesArray[find_id].TexturesID);
 577
 578  for a := 0 to c do
 579   FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
 580
 581  Result := True;
 582 end;}
 583
 584
 585 function g_Frames_Dup (const NewName, OldName: AnsiString): Boolean;
 586 var
 587   find_id, b: LongWord;
 588   a, c: Integer;
 589 begin
 590   result := false;
 591
 592   if not g_Frames_Get(b, OldName) then exit;
 593
 594   find_id := allocFrameSlot();
 595
 596   framesArray[find_id].used := true;
 597   framesArray[find_id].Name := NewName;
 598   framesArray[find_id].FrameWidth := framesArray[b].FrameWidth;
 599   framesArray[find_id].FrameHeight := framesArray[b].FrameHeight;
 600
 601   c := High(framesArray[b].TexturesID);
 602   SetLength(framesArray[find_id].TexturesID, c+1);
 603
 604   for a := 0 to c do framesArray[find_id].TexturesID[a] := framesArray[b].TexturesID[a];
 605
 606   result := true;
 607 end;
 608
 609
 610 procedure g_Frames_DeleteByName (const FramesName: AnsiString);
 611 var
 612   a, b: Integer;
 613 begin
 614   if (Length(framesArray) = 0) then exit;
 615   for a := 0 to High(framesArray) do
 616   begin
 617     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 618     begin
 619       if framesArray[a].TexturesID <> nil then
 620       begin
 621         for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]);
 622       end;
 623       framesArray[a].used := false;
 624       framesArray[a].TexturesID := nil;
 625       framesArray[a].Name := '';
 626       framesArray[a].FrameWidth := 0;
 627       framesArray[a].FrameHeight := 0;
 628     end;
 629   end;
 630 end;
 631
 632
 633 procedure g_Frames_DeleteByID (ID: LongWord);
 634 var
 635   b: Integer;
 636 begin
 637   if (Length(framesArray) = 0) then exit;
 638   if (framesArray[ID].TexturesID <> nil) then
 639   begin
 640     for b := 0 to High(framesArray[ID].TexturesID) do e_DeleteTexture(framesArray[ID].TexturesID[b]);
 641   end;
 642   framesArray[ID].used := false;
 643   framesArray[ID].TexturesID := nil;
 644   framesArray[ID].Name := '';
 645   framesArray[ID].FrameWidth := 0;
 646   framesArray[ID].FrameHeight := 0;
 647 end;
 648
 649
 650 procedure g_Frames_DeleteAll ();
 651 var
 652   a, b: Integer;
 653 begin
 654   for a := 0 to High(framesArray) do
 655   begin
 656     if (framesArray[a].used) then
 657     begin
 658       for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]);
 659     end;
 660     framesArray[a].used := false;
 661     framesArray[a].TexturesID := nil;
 662     framesArray[a].Name := '';
 663     framesArray[a].FrameWidth := 0;
 664     framesArray[a].FrameHeight := 0;
 665   end;
 666   framesArray := nil;
 667 end;
 668
 669
 670 function g_Frames_Get (out ID: LongWord; const FramesName: AnsiString): Boolean;
 671 var
 672   a: Integer;
 673 begin
 674   result := false;
 675   if (Length(framesArray) = 0) then exit;
 676   for a := 0 to High(framesArray) do
 677   begin
 678     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 679     begin
 680       ID := a;
 681       result := true;
 682       break;
 683     end;
 684   end;
 685   if not result then g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
 686 end;
 687
 688
 689 function g_Frames_GetTexture (out ID: LongWord; const FramesName: AnsiString; Frame: Word): Boolean;
 690 var
 691   a: Integer;
 692 begin
 693   result := false;
 694   if (Length(framesArray) = 0) then exit;
 695   for a := 0 to High(framesArray) do
 696   begin
 697     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 698     begin
 699       if (Frame < Length(framesArray[a].TexturesID)) then
 700       begin
 701         ID := framesArray[a].TexturesID[Frame];
 702         result := true;
 703         break;
 704       end;
 705     end;
 706   end;
 707   if not result then g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
 708 end;
 709
 710
 711 function g_Frames_Exists (const FramesName: AnsiString): Boolean;
 712 var
 713   a: Integer;
 714 begin
 715   result := false;
 716   if (Length(framesArray) = 0) then exit;
 717   for a := 0 to High(framesArray) do
 718   begin
 719     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 720     begin
 721       result := true;
 722       exit;
 723     end;
 724   end;
 725 end;
 726
 727
 728 procedure DumpTextureNames ();
 729 var
 730   i: Integer;
 731 begin
 732   e_WriteLog('BEGIN Textures:', TMsgType.Notify);
 733   for i := 0 to High(texturesArray) do e_WriteLog('   '+IntToStr(i)+'. '+texturesArray[i].Name, TMsgType.Notify);
 734   e_WriteLog('END Textures.', TMsgType.Notify);
 735
 736   e_WriteLog('BEGIN Frames:', TMsgType.Notify);
 737   for i := 0 to High(framesArray) do e_WriteLog('   '+IntToStr(i)+'. '+framesArray[i].Name, TMsgType.Notify);
 738   e_WriteLog('END Frames.', TMsgType.Notify);
 739 end;
 740
 741
 742 { TAnimation }
 743
 744 constructor TAnimation.Create (aframesID: LongWord; aloop: Boolean; aspeed: Byte);
 745 begin
 746   if (aframesID >= Length(framesArray)) then raise Exception.Create('trying to create inexisting frame: something is very wrong here');
 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.