DEADSOFTWARE

animated images from gif/apng
authorKetmar Dark <ketmar@ketmar.no-ip.org>
Sun, 24 Apr 2016 00:08:55 +0000 (03:08 +0300)
committerKetmar Dark <ketmar@ketmar.no-ip.org>
Sun, 24 Apr 2016 01:41:04 +0000 (04:41 +0300)
src/engine/e_graphics.pas
src/engine/e_textures.pas
src/game/g_map.pas
src/game/g_textures.pas

index c5a97b90c56961b8088fd4464fd0b763114aff88..9f9bfa20f348a020eb03fec23d8a42b4b16df184 100644 (file)
@@ -4,7 +4,7 @@ unit e_graphics;
 interface
 
 uses
-  SysUtils, Classes, Math, e_log, e_textures, SDL2, GL, GLExt, MAPDEF;
+  SysUtils, Classes, Math, e_log, e_textures, SDL2, GL, GLExt, MAPDEF, ImagingTypes, Imaging, ImagingUtility;
 
 type
   TMirrorType=(M_NONE, M_HORIZONTAL, M_VERTICAL);
@@ -63,6 +63,7 @@ procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byt
 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
                          Blending: TBlending = B_NONE);
 
+function e_CreateTextureImg (var img: TImageData; var ID: DWORD): Boolean;
 function e_CreateTexture(FileName: string; var ID: DWORD): Boolean;
 function e_CreateTextureEx(FileName: string; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
 function e_CreateTextureMem(pData: Pointer; dataSize: LongInt; var ID: DWORD): Boolean;
@@ -332,6 +333,22 @@ begin
  Result := True;
 end;
 
+function e_CreateTextureImg (var img: TImageData; var ID: DWORD): Boolean;
+var
+  find_id: DWORD;
+  fmt, tw, th: Word;
+begin
+  result := false;
+  find_id := FindTexture();
+  if not LoadTextureImg(img, e_Textures[find_id].tx, tw, th, @fmt) then exit;
+  //writeln(' tw=', tw, '; th=', th);
+  e_Textures[find_id].Width := tw;
+  e_Textures[find_id].Height := th;
+  e_Textures[find_id].Fmt := fmt;
+  ID := find_id;
+  result := True;
+end;
+
 procedure e_GetTextureSize(ID: DWORD; Width, Height: PWord);
 begin
  if Width <> nil then Width^ := e_Textures[ID].Width;
index 19efb4b1659cd844b340281ee9ec243f6fceb5c2..157ba55430200f8b1ed4b6216b58541914f14806 100644 (file)
@@ -8,7 +8,8 @@ unit e_textures;
 interface
 
 uses
-  GL, GLExt, SysUtils, e_log;
+  GL, GLExt, SysUtils, e_log,
+  ImagingTypes, Imaging, ImagingUtility;
 
 type
   GLTexture = record
@@ -30,11 +31,14 @@ function LoadTextureEx (Filename: String; var Texture: GLTexture; fX, fY, fWidth
 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
 
+// `img` must be valid!
+function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
+
+
 implementation
 
 uses
-  Classes, BinEditor, g_options, utils,
-  ImagingTypes, Imaging, ImagingUtility;
+  Classes, BinEditor, g_options, utils;
 
 
 function AlignP2 (n: Word): Word;
@@ -160,6 +164,54 @@ begin
   Result := true;
 end;
 
+// `img` must be valid!
+function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
+var
+  image, ii: PByte;
+  width, height: Integer;
+  imageSize: Integer;
+  x, y: Integer;
+  clr: TColor32Rec;
+begin
+  result := false;
+  pWidth := 0;
+  pHeight := 0;
+  if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
+
+  if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
+  begin
+    e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
+    exit;
+  end;
+  //ConvertImage(img, ifA8R8G8B8);
+  width := img.width;
+  height := img.height;
+  pWidth := width;
+  pHeight := height;
+  imageSize := Width*Height*4;
+  GetMem(image, imageSize);
+  try
+    // it's slow, but i don't care for now
+    ii := image;
+    for y := height-1 downto 0 do
+    begin
+      for x := 0 to width-1 do
+      begin
+        clr := GetPixel32(img, x, y);
+        ii^ := clr.r; Inc(ii);
+        ii^ := clr.g; Inc(ii);
+        ii^ := clr.b; Inc(ii);
+        ii^ := clr.a; Inc(ii);
+      end;
+    end;
+    CreateTexture(Texture, width, height, GL_RGBA, image);
+    result := true;
+  finally
+    FreeMem(image);
+  end;
+end;
+
+
 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
 var
   image, ii: PByte;
@@ -181,37 +233,7 @@ begin
     exit;
   end;
   try
-    if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
-    begin
-      e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
-      exit;
-    end;
-    //ConvertImage(img, ifA8R8G8B8);
-    width := img.width;
-    height := img.height;
-    pWidth := width;
-    pHeight := height;
-    imageSize := Width*Height*32;
-    GetMem(image, imageSize);
-    try
-      // it's slow, but i don't care for now
-      ii := image;
-      for y := height-1 downto 0 do
-      begin
-        for x := 0 to width-1 do
-        begin
-          clr := GetPixel32(img, x, y);
-          ii^ := clr.r; Inc(ii);
-          ii^ := clr.g; Inc(ii);
-          ii^ := clr.b; Inc(ii);
-          ii^ := clr.a; Inc(ii);
-        end;
-      end;
-      CreateTexture(Texture, width, height, GL_RGBA, image);
-      result := true;
-    finally
-      FreeMem(image);
-    end;
+    result := LoadTextureImg(img, Texture, pWidth, pHeight, Fmt);
   finally
     FreeImage(img);
   end;
@@ -247,7 +269,7 @@ begin
     if fY > img.height then exit;
     if fX+fWidth > img.width then exit;
     if fY+fHeight > img.height then exit;
-    imageSize := img.width*img.height*32;
+    imageSize := img.width*img.height*4;
     GetMem(image, imageSize);
     try
       // it's slow, but i don't care for now
index 2c611442025585a94d1c42d998ff5c900c6d2f6d..a05a2cf405d1c1a07751fca69af1a424d56b7866 100644 (file)
@@ -118,7 +118,9 @@ uses
   GL, GLExt, g_weapons, g_game, g_sound, e_sound, CONFIG,
   g_options, MAPREADER, g_triggers, g_player, MAPDEF,
   Math, g_monsters, g_saveload, g_language, g_netmsg,
-  utils, sfs;
+  utils, sfs,
+  ImagingTypes, Imaging, ImagingUtility,
+  ImagingGif, ImagingNetworkGraphics;
 
 const
   FLAGRECT: TRectWH = (X:15; Y:12; Width:33; Height:52);
@@ -366,7 +368,7 @@ function CreateTexture(RecName: String; Map: string; log: Boolean): Integer;
 var
   WAD: TWADFile;
   TextureData: Pointer;
-  WADName: String;
+  WADName, txname: String;
   a, ResLength: Integer;
 begin
   Result := -1;
@@ -418,6 +420,15 @@ begin
 
   WAD.ReadFile(WADName);
 
+  txname := RecName;
+  {
+  if (WADName = Map) and WAD.GetResource(g_ExtractFilePathName(RecName), TextureData, ResLength) then
+  begin
+    FreeMem(TextureData);
+    RecName := 'COMMON\ALIEN';
+  end;
+  }
+
   if WAD.GetResource(g_ExtractFilePathName(RecName), TextureData, ResLength) then
     begin
       SetLength(Textures, Length(Textures)+1);
@@ -427,17 +438,20 @@ begin
                        @Textures[High(Textures)].Width,
                        @Textures[High(Textures)].Height);
       FreeMem(TextureData);
-      Textures[High(Textures)].TextureName := RecName;
+      Textures[High(Textures)].TextureName := {RecName}txname;
       Textures[High(Textures)].Anim := False;
 
       result := High(Textures);
     end
   else // Íåò òàêîãî ðåóñðñà â WAD'å
+  begin
+    //e_WriteLog(Format('SHIT! Error loading texture %s : %s : %s', [RecName, txname, g_ExtractFilePathName(RecName)]), MSG_WARNING);
     if log then
       begin
         e_WriteLog(Format('Error loading texture %s', [RecName]), MSG_WARNING);
         //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
       end;
+  end;
 
   WAD.Free();
 end;
@@ -445,113 +459,245 @@ end;
 function CreateAnimTexture(RecName: String; Map: string; log: Boolean): Integer;
 var
   WAD: TWADFile;
-  TextureWAD: Pointer;
-  TextData: Pointer;
-  TextureData: Pointer;
-  cfg: TConfig;
+  TextureWAD: PChar = nil;
+  ttw: PChar = nil;
+  TextData: Pointer = nil;
+  TextureData: Pointer = nil;
+  cfg: TConfig = nil;
   WADName: String;
-  ResLength: Integer;
+  ResLength, rrl: Integer;
   TextureResource: String;
   _width, _height, _framecount, _speed: Integer;
   _backanimation: Boolean;
+  imgfmt: string;
+  ia: TDynImageDataArray = nil;
+  il: TImageFileFormat = nil;
+  meta: TMetadata = nil;
+  f: Integer;
+  gf: TGIFFileFormat;
+  pf: TPNGFileFormat;
 begin
-  Result := -1;
+  result := -1;
 
-// ×èòàåì WAD-ðåñóðñ àíèì.òåêñòóðû èç WAD'à â ïàìÿòü:
+  //e_WriteLog(Format('*** Loading animated texture "%s"', [RecName]), MSG_NOTIFY);
+
+  // ×èòàåì WAD-ðåñóðñ àíèì.òåêñòóðû èç WAD'à â ïàìÿòü:
   WADName := g_ExtractWadName(RecName);
 
   WAD := TWADFile.Create();
+  try
+    if WADName <> '' then
+      WADName := GameDir+'/wads/'+WADName
+    else
+      WADName := Map;
 
-  if WADName <> '' then
-    WADName := GameDir+'/wads/'+WADName
-  else
-    WADName := Map;
+    WAD.ReadFile(WADName);
 
-  WAD.ReadFile(WADName);
+    if not WAD.GetResource(g_ExtractFilePathName(RecName), TextureWAD, ResLength) then
+    begin
+      if log then
+      begin
+        e_WriteLog(Format('Error loading animation texture %s', [RecName]), MSG_WARNING);
+        //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
+      end;
+      exit;
+    end;
 
-  if not WAD.GetResource(g_ExtractFilePathName(RecName), TextureWAD, ResLength) then
-  begin
-    if log then
+    {TEST
+    if WADName = Map then
     begin
-      e_WriteLog(Format('Error loading animation texture %s', [RecName]), MSG_WARNING);
-      //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
+      //FreeMem(TextureWAD);
+      if not WAD.GetResource('COMMON/animation', TextureWAD, ResLength) then Halt(1);
     end;
-    WAD.Free();
-    Exit;
-  end;
+    }
 
-  WAD.FreeWAD();
+    WAD.FreeWAD();
 
-  if not WAD.ReadMemory(TextureWAD, ResLength) then
-  begin
-    FreeMem(TextureWAD);
-    WAD.Free();
-    Exit;
-  end;
+    if ResLength < 6 then
+    begin
+      e_WriteLog(Format('Animated texture file "%s" too short', [RecName]), MSG_WARNING);
+      exit;
+    end;
 
-// ×èòàåì INI-ðåñóðñ àíèì. òåêñòóðû è çàïîìèíàåì åãî óñòàíîâêè:
-  if not WAD.GetResource('TEXT/ANIM', TextData, ResLength) then
-  begin
-    FreeMem(TextureWAD);
-    WAD.Free();
-    Exit;
-  end;
+    // ýòî ïòèöà? ýòî ñàìîë¸ò?
+    if (TextureWAD[0] = 'D') and (TextureWAD[1] = 'F') and
+       (TextureWAD[2] = 'W') and (TextureWAD[3] = 'A') and (TextureWAD[4] = 'D') then
+    begin
+      // íåò, ýòî ñóïåðìåí!
+      if not WAD.ReadMemory(TextureWAD, ResLength) then
+      begin
+        e_WriteLog(Format('Animated texture WAD file "%s" is invalid', [RecName]), MSG_WARNING);
+        exit;
+      end;
 
-  cfg := TConfig.CreateMem(TextData, ResLength);
+      // ×èòàåì INI-ðåñóðñ àíèì. òåêñòóðû è çàïîìèíàåì åãî óñòàíîâêè:
+      if not WAD.GetResource('TEXT/ANIM', TextData, ResLength) then
+      begin
+        e_WriteLog(Format('Animated texture file "%s" has invalid INI', [RecName]), MSG_WARNING);
+        exit;
+      end;
 
-  TextureResource := cfg.ReadStr('', 'resource', '');
+      cfg := TConfig.CreateMem(TextData, ResLength);
 
-  if TextureResource = '' then
-  begin
-    FreeMem(TextureWAD);
-    FreeMem(TextData);
-    WAD.Free();
-    cfg.Free();
-    Exit;
-  end;
+      TextureResource := cfg.ReadStr('', 'resource', '');
+      if TextureResource = '' then
+      begin
+        e_WriteLog(Format('Animated texture WAD file "%s" has no "resource"', [RecName]), MSG_WARNING);
+        exit;
+      end;
 
-  _width := cfg.ReadInt('', 'framewidth', 0);
-  _height := cfg.ReadInt('', 'frameheight', 0);
-  _framecount := cfg.ReadInt('', 'framecount', 0);
-  _speed := cfg.ReadInt('', 'waitcount', 0);
-  _backanimation := cfg.ReadBool('', 'backanimation', False);
+      _width := cfg.ReadInt('', 'framewidth', 0);
+      _height := cfg.ReadInt('', 'frameheight', 0);
+      _framecount := cfg.ReadInt('', 'framecount', 0);
+      _speed := cfg.ReadInt('', 'waitcount', 0);
+      _backanimation := cfg.ReadBool('', 'backanimation', False);
 
-  cfg.Free();
+      cfg.Free();
+      cfg := nil;
 
-// ×èòàåì ðåñóðñ òåêñòóð (êàäðîâ) àíèì. òåêñòóðû â ïàìÿòü:
-  if not WAD.GetResource('TEXTURES/'+TextureResource, TextureData, ResLength) then
-  begin
-    FreeMem(TextureWAD);
-    FreeMem(TextData);
-    WAD.Free();
-    Exit;
-  end;
+      // ×èòàåì ðåñóðñ òåêñòóð (êàäðîâ) àíèì. òåêñòóðû â ïàìÿòü:
+      if not WAD.GetResource('TEXTURES/'+TextureResource, TextureData, ResLength) then
+      begin
+        e_WriteLog(Format('Animated texture WAD file "%s" has no texture "%s"', [RecName, 'TEXTURES/'+TextureResource]), MSG_WARNING);
+        exit;
+      end;
 
-  WAD.Free();
+      WAD.Free();
+      WAD := nil;
 
-  SetLength(Textures, Length(Textures)+1);
-  with Textures[High(Textures)] do
-  begin
-  // Ñîçäàåì êàäðû àíèì. òåêñòóðû èç ïàìÿòè:
-    if g_Frames_CreateMemory(@FramesID, '', TextureData, ResLength,
-         _width, _height, _framecount, _backanimation) then
+      SetLength(Textures, Length(Textures)+1);
+      with Textures[High(Textures)] do
+      begin
+        // Ñîçäàåì êàäðû àíèì. òåêñòóðû èç ïàìÿòè:
+        if g_Frames_CreateMemory(@FramesID, '', TextureData, ResLength, _width, _height, _framecount, _backanimation) then
+        begin
+          TextureName := RecName;
+          Width := _width;
+          Height := _height;
+          Anim := True;
+          FramesCount := _framecount;
+          Speed := _speed;
+          result := High(Textures);
+        end
+        else
+        begin
+          if log then e_WriteLog(Format('Error loading animation texture %s', [RecName]), MSG_WARNING);
+        end;
+      end;
+    end
+    else
+    begin
+      // try animated image
+      imgfmt := DetermineMemoryFormat(TextureWAD, ResLength);
+      if length(imgfmt) = 0 then
+      begin
+        e_WriteLog(Format('Animated texture file "%s" has unknown format', [RecName]), MSG_WARNING);
+        exit;
+      end;
+      if imgfmt = 'gif' then
+      begin
+        meta := TMetadata.Create();
+        gf := TGIFFileFormat.Create(meta);
+        gf.LoadAnimated := true;
+        il := gf;
+      end
+      else if imgfmt = 'png' then
+      begin
+        meta := TMetadata.Create();
+        pf := TPNGFileFormat.Create(meta);
+        pf.LoadAnimated := true;
+        il := pf;
+      end;
+      if il <> nil then
+      begin
+        if not il.LoadFromMemory(TextureWAD, ResLength, ia) then
+        begin
+          e_WriteLog(Format('Animated texture file "%s" cannot be loaded', [RecName]), MSG_WARNING);
+          exit;
+        end;
+      end
+      else if LoadMultiImageFromMemory(TextureWAD, ResLength, ia) then
+      begin
+        if length(ia) > 1 then
+        begin
+          for f := 1 to High(ia) do FreeImage(ia[f]);
+          SetLength(ia, 1);
+        end;
+      end
+      else
+      begin
+        e_WriteLog(Format('Animated texture file "%s" cannot be loaded', [RecName]), MSG_WARNING);
+        exit;
+      end;
+      if length(ia) = 0 then
       begin
-        TextureName := RecName;
-        Width := _width;
-        Height := _height;
-        Anim := True;
-        FramesCount := _framecount;
-        Speed := _speed;
+        e_WriteLog(Format('Animated texture file "%s" has no frames', [RecName]), MSG_WARNING);
+        exit;
+      end;
+
+      WAD.Free();
+      WAD := nil;
+
+      _width := ia[0].width;
+      _height := ia[0].height;
+      _framecount := length(ia);
+      _speed := 1;
+      _backanimation := false;
+      if meta <> nil then
+      begin
+        if meta.HasMetaItem(SMetaFrameDelay) then
+        begin
+          //writeln(' frame delay: ', meta.MetaItems[SMetaFrameDelay]);
+          try
+            f := meta.MetaItems[SMetaFrameDelay];
+            f := f div 27;
+            if f < 1 then f := 1 else if f > 255 then f := 255;
+            _speed := f;
+          except
+          end;
+        end;
+        if meta.HasMetaItem(SMetaAnimationLoops) then
+        begin
+          //writeln(' frame loop : ', meta.MetaItems[SMetaAnimationLoops]);
+          try
+            f := meta.MetaItems[SMetaAnimationLoops];
+            if f <> 0 then _backanimation := true;
+          except
+          end;
+        end;
+      end;
+      //writeln(' creating animated texture with ', length(ia), ' frames (delay:', _speed, '; backloop:', _backanimation, ') from "', RecName, '"...');
+      //for f := 0 to high(ia) do writeln('  frame #', f, ': ', ia[f].width, 'x', ia[f].height);
+      //e_WriteLog(Format('Animated texture file "%s": %d frames (delay:%d), %dx%d', [RecName, length(ia), _speed, _width, _height]), MSG_NOTIFY);
 
+      SetLength(Textures, Length(Textures)+1);
+      // cîçäàåì êàäðû àíèì. òåêñòóðû èç êàðòèíîê
+      if g_CreateFramesImg(ia, @Textures[High(Textures)].FramesID, '', _backanimation) then
+      begin
+        Textures[High(Textures)].TextureName := RecName;
+        Textures[High(Textures)].Width := _width;
+        Textures[High(Textures)].Height := _height;
+        Textures[High(Textures)].Anim := True;
+        Textures[High(Textures)].FramesCount := length(ia);
+        Textures[High(Textures)].Speed := _speed;
         result := High(Textures);
+        //writeln(' CREATED!');
       end
-    else
-      if log then
-        e_WriteLog(Format('Error loading animation texture %s', [RecName]), MSG_WARNING);
+      else
+      begin
+        if log then e_WriteLog(Format('Error loading animation texture "%s" images', [RecName]), MSG_WARNING);
+      end;
+    end;
+  finally
+    for f := 0 to High(ia) do FreeImage(ia[f]);
+    il.Free();
+    //???meta.Free();
+    WAD.Free();
+    cfg.Free();
+    if TextureWAD <> nil then FreeMem(TextureWAD);
+    if TextData <> nil then FreeMem(TextData);
+    if TextureData <> nil then FreeMem(TextureData);
   end;
-
-  FreeMem(TextureWAD);
-  FreeMem(TextData);
 end;
 
 procedure CreateItem(Item: TItemRec_1);
index 4e1cffad133903770bb6900a9e4e8bf699ff2a97..613419e21e451e1f0793126bdbf9c67fe174eaf3 100644 (file)
@@ -4,7 +4,7 @@ unit g_textures;
 interface
 
 uses
-  e_graphics, BinEditor;
+  e_graphics, BinEditor, ImagingTypes, Imaging, ImagingUtility;
 
 Type
   TLevelTexture = record
@@ -75,6 +75,8 @@ function g_Texture_Get(TextureName: ShortString; var ID: DWORD): Boolean;
 procedure g_Texture_Delete(TextureName: ShortString);
 procedure g_Texture_DeleteAll();
 
+function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; Name: ShortString; BackAnimation: Boolean = False): Boolean;
+
 function g_Frames_CreateWAD(ID: PDWORD; Name: ShortString; Resource: String;
                             FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
 function g_Frames_CreateFile(ID: PDWORD; Name: ShortString; FileName: String;
@@ -385,6 +387,53 @@ begin
   Result := True;
 end;
 
+function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; Name: ShortString; BackAnimation: Boolean = False): Boolean;
+var
+  find_id: DWORD;
+  a, FCount: Integer;
+begin
+  result := false;
+  find_id := FindFrame();
+
+  FCount := length(ia);
+
+  //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
+
+  if FCount < 1 then exit;
+  if FCount <= 2 then BackAnimation := False;
+  if BackAnimation then
+    SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2)
+  else
+    SetLength(FramesArray[find_id].TexturesID, FCount);
+
+  //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
+
+  for a := 0 to FCount-1 do
+  begin
+    if not e_CreateTextureImg(ia[a], FramesArray[find_id].TexturesID[a]) then exit;
+    //e_WriteLog(Format('+++   frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
+  end;
+
+  if BackAnimation then
+  begin
+    for a := 1 to FCount-2 do
+    begin
+      FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a];
+    end;
+  end;
+
+  FramesArray[find_id].FrameWidth := ia[0].width;
+  FramesArray[find_id].FrameHeight := ia[0].height;
+  if Name <> '' then
+    FramesArray[find_id].Name := LowerCase(Name)
+  else
+    FramesArray[find_id].Name := '<noname>';
+
+  if ID <> nil then ID^ := find_id;
+
+  result := true;
+end;
+
 function g_Frames_CreateWAD(ID: PDWORD; Name: ShortString; Resource: string;
                             FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
 var