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