Having trouble producing transparent GIF animation

Question

I'm having difficulty producing a proper animated gif (for inclusion in a PowerPoint presentation). The code I have is this:

 HSBhsl[h_, s_, l_] := 
 Module[{H, S, B}, H = h; B = l + s (1 - Abs[2 l - 1])/2; 
  S = (2 B - l)/B; {H, S, B}]
TestCube[\[Theta]_] := 
 Graphics3D[Rotate[{EdgeForm[], Hue[HSBhsl[32/250, 228/250, 105/256]],                  
    Cuboid[{0, 0, 0}, {1, 1, 1}]}, -\[Theta] Degree, {0, 0, 1}, {1, 1,
     1}], Lighting -> {{"Ambient", 
     RGBColor[0.7, 0.7, 0.7]}, {"Directional", 
     RGBColor[0.35, 0.35, 0.35], ImageScaled[{0, 5, 0}]}}, 
  Boxed -> False, Background -> None, 
  PlotRange -> 4 {{-1, 1}, {-1, 1}, {-1, 1}}, ViewAngle -> Pi/10000]

The animation is then produced like so:

list = Table[
   Show[TestCube[t], ViewPoint -> {1000, 1000, 1000}], {t, 0, 360, 1}];
SetDirectory@NotebookDirectory[];
Export["CubesAnimation.gif", list, "TransparentColor" -> White]

Unfortunately, this produces an amimation that seems to stack images on top of each other, thus giving the appearance of a "trace" left by the previous frame. I tried adding "TransitionEffect" -> Background, but this had no effect.

How do I get a proper GIF animation, with a transparent background, of the rotating cube?

Answer 1

I have investigated the problem and it seems that this is indeed a limitation of Export. We will add support for "TransitionEffect" option in Export in the next release of Mathematica.

In the meantime, as a workaround, you can use a low-level function from GIFTools paclet GIFTools`Private`$WriteFrames. The function is not documented because it is not supposed to be used directly, it serves as a back-end to Export.

But here is how you can use it in your case:

list = Table[Show[TestCube[t], ViewPoint -> {1000, 1000, 1000}], {t, 0, 360, 1}];
SetDirectory@NotebookDirectory[];

(* Load and initialize GIFTools paclet *)
Needs["GIFTools`"]
GIFTools`Private`InitGIFTools[]

GIFTools`Private`$WriteFrames[
    Image3D[list],           (* All frames stuffed into a single Image3D *)
    "CubesAnimation.gif",    (* Output file name *)
    "",                      (* Comment, none in this case *)
    {0.1},                   (* Display duration for each frame *)
    "None",                  (* Dithering method, none in this case *)
    1,                       (* How many times to play the animation *)
    True,                    (* Interlacing *)
    {255, 255, 255},         (* Background color *)
    {255, 255, 255},         (* Transparent color - white *)
    {2}                      (* Disposal mode - Restore to background color*)
]

As an alternative you can consider exporting to Animated PNG, which supports alpha channel.

Answer 2

To export to an animated PNG with transparency you should convert Graphics to Image first:

list = Table[Image[Show[TestCube[t], ViewPoint -> {1000, 1000, 1000}]], {t,
       0, 360, 1}];

Then, you call Export:

In[9]:= Export["CubesAnimation.png", list]

Out[9]= "CubesAnimation.png"

In[10]:= ImageMeasurements[Import["CubesAnimation.png", {"ImageList", 1}], "Transparency"]

Out[10]= True