src/game/opengl/r_animations.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 r_animations;
  17
  18 interface
  19
  20   uses g_base, g_textures, MAPDEF, Imaging; // TMirrorType, TAnimationState, TDFPoint, TDynImageDataArray
  21
  22   procedure r_AnimationState_Draw (FID: DWORD; t: TAnimationState; x, y: Integer; alpha: Byte; mirror: TMirrorType; blending: Boolean);
  23   procedure r_AnimationState_DrawEx (FID: DWORD; t: TAnimationState; x, y: Integer; alpha: Byte; mirror: TMirrorType; blending: Boolean; rpoint: TDFPoint; angle: SmallInt);
  24
  25   procedure r_AnimState_Draw (FID: DWORD; const t: TAnimState; x, y: Integer; alpha: Byte; mirror: TMirrorType; blending: Boolean);
  26   procedure r_AnimState_DrawEx (FID: DWORD; const t: TAnimState; x, y: Integer; alpha: Byte; mirror: TMirrorType; blending: Boolean; rpoint: TDFPoint; angle: SmallInt);
  27
  28   function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; const Name: AnsiString; BackAnimation: Boolean = false): Boolean;
  29
  30   function g_Frames_CreateWAD (ID: PDWORD; const Name, Resource: AnsiString; mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
  31   function g_Frames_CreateFile (ID: PDWORD; const Name, FileName: AnsiString; mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
  32   function g_Frames_CreateMemory (ID: PDWORD; const Name: AnsiString; pData: Pointer; dataSize: LongInt; mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
  33   function g_Frames_Dup (const NewName, OldName: AnsiString): Boolean;
  34   function g_Frames_Get (out ID: LongWord; const FramesName: AnsiString): Boolean;
  35   function g_Frames_GetTexture (out ID: LongWord; const FramesName: AnsiString; Frame: Word): Boolean;
  36   procedure g_Frames_GetFrameSize (ID: DWORD; out w, h: Integer);
  37   function g_Frames_Exists (const FramesName: AnsiString): Boolean;
  38   procedure g_Frames_DeleteByName (const FramesName: AnsiString);
  39   procedure g_Frames_DeleteByID (ID: LongWord);
  40   procedure g_Frames_DeleteAll;
  41
  42   type
  43     TFrames = record
  44       texturesID: array of LongWord;
  45       name: AnsiString;
  46       frameWidth, frameHeight: Word;
  47       used: Boolean;
  48     end;
  49
  50   var
  51     framesArray: array of TFrames = nil;
  52
  53 implementation
  54
  55   uses
  56     SysUtils, Classes, Math,
  57     WadReader, utils,
  58     e_log,
  59     r_graphics,
  60     g_language, g_game
  61   ;
  62
  63   procedure g_Frames_GetFrameSize (ID: DWORD; out w, h: Integer);
  64   begin
  65     w := 0;
  66     h := 0;
  67     if framesArray <> nil then
  68     begin
  69       w := framesArray[ID].frameWidth;
  70       h := framesArray[ID].frameHeight;
  71     end
  72   end;
  73
  74   procedure r_AnimationState_Draw (FID: DWORD; t: TAnimationState; x, y: Integer; alpha: Byte; mirror: TMirrorType; blending: Boolean);
  75   begin
  76     if t.enabled then
  77       e_DrawAdv(framesArray[FID].TexturesID[t.currentFrame], x, y, alpha, true, blending, 0, nil, mirror)
  78   end;
  79
  80   procedure r_AnimationState_DrawEx (FID: DWORD; t: TAnimationState; x, y: Integer; alpha: Byte; mirror: TMirrorType; blending: Boolean; rpoint: TDFPoint; angle: SmallInt);
  81   begin
  82     if t.enabled then
  83       e_DrawAdv(framesArray[FID].TexturesID[t.currentFrame], x, y, alpha, true, blending, angle, @rpoint, mirror)
  84   end;
  85
  86   procedure r_AnimState_Draw (FID: DWORD; const t: TAnimState; x, y: Integer; alpha: Byte; mirror: TMirrorType; blending: Boolean);
  87   begin
  88     if t.enabled then
  89       e_DrawAdv(framesArray[FID].TexturesID[t.currentFrame], x, y, alpha, true, blending, 0, nil, mirror)
  90   end;
  91
  92   procedure r_AnimState_DrawEx (FID: DWORD; const t: TAnimState; x, y: Integer; alpha: Byte; mirror: TMirrorType; blending: Boolean; rpoint: TDFPoint; angle: SmallInt);
  93   begin
  94     if t.enabled then
  95       e_DrawAdv(framesArray[FID].TexturesID[t.currentFrame], x, y, alpha, true, blending, angle, @rpoint, mirror)
  96   end;
  97
  98 function allocFrameSlot (): LongWord;
  99 var
 100   f: integer;
 101 begin
 102   for f := 0 to High(framesArray) do
 103   begin
 104     if (not framesArray[f].used) then
 105     begin
 106       result := f;
 107       exit;
 108     end;
 109   end;
 110
 111   result := Length(framesArray);
 112   SetLength(framesArray, result+64);
 113   for f := result to High(framesArray) do
 114   begin
 115     with framesArray[f] do
 116     begin
 117       texturesID := nil;
 118       name := '';
 119       frameWidth := 0;
 120       frameHeight := 0;
 121       used := false;
 122     end;
 123   end;
 124 end;
 125
 126 function g_Frames_CreateFile (ID: PDWORD; const Name, FileName: AnsiString;
 127                               mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 128 var
 129   a: Integer;
 130   find_id: LongWord;
 131 begin
 132   result := false;
 133
 134   find_id := allocFrameSlot();
 135
 136   if (mCount <= 2) then BackAnimation := false;
 137
 138   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 139   else SetLength(framesArray[find_id].TexturesID, mCount);
 140
 141   for a := 0 to mCount-1 do
 142   begin
 143     if not e_CreateTextureEx(FileName, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then exit;
 144   end;
 145
 146   if BackAnimation then
 147   begin
 148     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 149   end;
 150
 151   framesArray[find_id].used := true;
 152   framesArray[find_id].FrameWidth := mWidth;
 153   framesArray[find_id].FrameHeight := mHeight;
 154   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 155
 156   if (ID <> nil) then ID^ := find_id;
 157
 158   result := true;
 159 end;
 160
 161 function CreateFramesMem (pData: Pointer; dataSize: LongInt; ID: PDWORD; Name: AnsiString;
 162                           mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 163 var
 164   find_id: LongWord;
 165   a: Integer;
 166 begin
 167   result := false;
 168
 169   find_id := allocFrameSlot();
 170
 171   if (mCount <= 2) then BackAnimation := false;
 172
 173   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 174   else SetLength(framesArray[find_id].TexturesID, mCount);
 175
 176   for a := 0 to mCount-1 do
 177     if not e_CreateTextureMemEx(pData, dataSize, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then
 178     begin
 179       //!!!FreeMem(pData);
 180       exit;
 181     end;
 182
 183   if BackAnimation then
 184   begin
 185     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 186   end;
 187
 188   framesArray[find_id].used := true;
 189   framesArray[find_id].FrameWidth := mWidth;
 190   framesArray[find_id].FrameHeight := mHeight;
 191   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 192
 193   if (ID <> nil) then ID^ := find_id;
 194
 195   result := true;
 196 end;
 197
 198 function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; const Name: AnsiString; BackAnimation: Boolean = false): Boolean;
 199 var
 200   find_id: LongWord;
 201   a, mCount: Integer;
 202 begin
 203   result := false;
 204   find_id := allocFrameSlot();
 205
 206   mCount := Length(ia);
 207
 208   //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
 209
 210   if (mCount < 1) then exit;
 211   if (mCount <= 2) then BackAnimation := false;
 212
 213   if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
 214   else SetLength(framesArray[find_id].TexturesID, mCount);
 215
 216   //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
 217
 218   for a := 0 to mCount-1 do
 219   begin
 220     if not e_CreateTextureImg(ia[a], framesArray[find_id].TexturesID[a]) then exit;
 221     //e_WriteLog(Format('+++   frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
 222   end;
 223
 224   if BackAnimation then
 225   begin
 226     for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
 227   end;
 228
 229   framesArray[find_id].used := true;
 230   framesArray[find_id].FrameWidth := ia[0].width;
 231   framesArray[find_id].FrameHeight := ia[0].height;
 232   if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
 233
 234   if (ID <> nil) then ID^ := find_id;
 235
 236   result := true;
 237 end;
 238
 239 function g_Frames_CreateWAD (ID: PDWORD; const Name, Resource: AnsiString;
 240                              mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
 241 var
 242   WAD: TWADFile;
 243   FileName: AnsiString;
 244   TextureData: Pointer;
 245   ResourceLength: Integer;
 246 begin
 247   result := false;
 248
 249   // models without "advanced" animations asks for "nothing" like this; don't spam log
 250   if (Length(Resource) > 0) and ((Resource[Length(Resource)] = '/') or (Resource[Length(Resource)] = '\')) then exit;
 251
 252   FileName := g_ExtractWadName(Resource);
 253
 254   WAD := TWADFile.Create();
 255   WAD.ReadFile(FileName);
 256
 257   if not WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
 258   begin
 259     WAD.Free();
 260     e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
 261     //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
 262     exit;
 263   end;
 264
 265   if not CreateFramesMem(TextureData, ResourceLength, ID, Name, mWidth, mHeight, mCount, BackAnimation) then
 266   begin
 267     FreeMem(TextureData);
 268     WAD.Free();
 269     exit;
 270   end;
 271
 272   FreeMem(TextureData);
 273   WAD.Free();
 274
 275   result := true;
 276 end;
 277
 278 function g_Frames_CreateMemory (ID: PDWORD; const Name: AnsiString; pData: Pointer; dataSize: LongInt;
 279                                 mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
 280 begin
 281   result := CreateFramesMem(pData, dataSize, ID, Name, mWidth, mHeight, mCount, BackAnimation);
 282 end;
 283
 284 function g_Frames_Dup (const NewName, OldName: AnsiString): Boolean;
 285 var
 286   find_id, b: LongWord;
 287   a, c: Integer;
 288 begin
 289   result := false;
 290
 291   if not g_Frames_Get(b, OldName) then exit;
 292
 293   find_id := allocFrameSlot();
 294
 295   framesArray[find_id].used := true;
 296   framesArray[find_id].Name := NewName;
 297   framesArray[find_id].FrameWidth := framesArray[b].FrameWidth;
 298   framesArray[find_id].FrameHeight := framesArray[b].FrameHeight;
 299
 300   c := High(framesArray[b].TexturesID);
 301   SetLength(framesArray[find_id].TexturesID, c+1);
 302
 303   for a := 0 to c do framesArray[find_id].TexturesID[a] := framesArray[b].TexturesID[a];
 304
 305   result := true;
 306 end;
 307
 308
 309 procedure g_Frames_DeleteByName (const FramesName: AnsiString);
 310 var
 311   a, b: Integer;
 312 begin
 313   if (Length(framesArray) = 0) then exit;
 314   for a := 0 to High(framesArray) do
 315   begin
 316     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 317     begin
 318       if framesArray[a].TexturesID <> nil then
 319       begin
 320         for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]);
 321       end;
 322       framesArray[a].used := false;
 323       framesArray[a].TexturesID := nil;
 324       framesArray[a].Name := '';
 325       framesArray[a].FrameWidth := 0;
 326       framesArray[a].FrameHeight := 0;
 327     end;
 328   end;
 329 end;
 330
 331 procedure g_Frames_DeleteByID (ID: LongWord);
 332 var
 333   b: Integer;
 334 begin
 335   if (Length(framesArray) = 0) then exit;
 336   if (framesArray[ID].TexturesID <> nil) then
 337   begin
 338     for b := 0 to High(framesArray[ID].TexturesID) do e_DeleteTexture(framesArray[ID].TexturesID[b]);
 339   end;
 340   framesArray[ID].used := false;
 341   framesArray[ID].TexturesID := nil;
 342   framesArray[ID].Name := '';
 343   framesArray[ID].FrameWidth := 0;
 344   framesArray[ID].FrameHeight := 0;
 345 end;
 346
 347 procedure g_Frames_DeleteAll ();
 348 var
 349   a, b: Integer;
 350 begin
 351   for a := 0 to High(framesArray) do
 352   begin
 353     if (framesArray[a].used) then
 354     begin
 355       for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]);
 356     end;
 357     framesArray[a].used := false;
 358     framesArray[a].TexturesID := nil;
 359     framesArray[a].Name := '';
 360     framesArray[a].FrameWidth := 0;
 361     framesArray[a].FrameHeight := 0;
 362   end;
 363   framesArray := nil;
 364 end;
 365
 366
 367 function g_Frames_Get (out ID: LongWord; const FramesName: AnsiString): Boolean;
 368 var
 369   a: Integer;
 370 begin
 371   result := false;
 372   if (Length(framesArray) = 0) then exit;
 373   for a := 0 to High(framesArray) do
 374   begin
 375     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 376     begin
 377       ID := a;
 378       result := true;
 379       break;
 380     end;
 381   end;
 382   if not result then g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
 383 end;
 384
 385 function g_Frames_GetTexture (out ID: LongWord; const FramesName: AnsiString; Frame: Word): Boolean;
 386 var
 387   a: Integer;
 388 begin
 389   result := false;
 390   if (Length(framesArray) = 0) then exit;
 391   for a := 0 to High(framesArray) do
 392   begin
 393     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 394     begin
 395       if (Frame < Length(framesArray[a].TexturesID)) then
 396       begin
 397         ID := framesArray[a].TexturesID[Frame];
 398         result := true;
 399         break;
 400       end;
 401     end;
 402   end;
 403   if not result then g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
 404 end;
 405
 406 function g_Frames_Exists (const FramesName: AnsiString): Boolean;
 407 var
 408   a: Integer;
 409 begin
 410   result := false;
 411   if (Length(framesArray) = 0) then exit;
 412   for a := 0 to High(framesArray) do
 413   begin
 414     if (StrEquCI1251(framesArray[a].Name, FramesName)) then
 415     begin
 416       result := true;
 417       exit;
 418     end;
 419   end;
 420 end;
 421
 422 end.