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