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