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