5
$\begingroup$

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?

|improve this question
$\endgroup$
  • $\begingroup$ You haven't defined HSBhsl $\endgroup$ – bill s Oct 3 '18 at 21:51
  • $\begingroup$ Sorry, updated my post. Thanks! $\endgroup$ – Pirx Oct 3 '18 at 21:53
  • $\begingroup$ What do you mean by "proper"? Just using Export["CubesAnimation.gif", list] seems to produce a "proper" GIF. $\endgroup$ – JimB Oct 3 '18 at 23:56
  • $\begingroup$ The issue is that this results in the animation having a white background. I need the background to be transparent. Using the options I gave in my post, I do get a transparent background, but I also get that unwanted "stacking effect". $\endgroup$ – Pirx Oct 4 '18 at 0:02
6
$\begingroup$

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.

|improve this answer
$\endgroup$
  • $\begingroup$ How nice! But, is the semicolon in Image3D[list]; deliberate? $\endgroup$ – J. M. will be back soon♦ Oct 4 '18 at 10:13
  • $\begingroup$ No, it was a typo, I have edited my answer. Thanks for catching that. $\endgroup$ – rafalc Oct 4 '18 at 10:17
  • $\begingroup$ Thanks, this solves the issue! $\endgroup$ – Pirx Oct 4 '18 at 11:19
  • $\begingroup$ Unfortunately, Powerpoint doesn't seem to support animated PNGs. $\endgroup$ – Pirx Oct 4 '18 at 11:35
  • 2
    $\begingroup$ Hah, I got it now: It was some issue with cut-and-paste mangling that backwards quote; I did get a character that looks like a backwards quote, but apparently it wasn't the right backward quote. Just manually typing that quote in Mathematica fixed the issue. Thanks everybody! $\endgroup$ – Pirx Oct 4 '18 at 11:56
4
$\begingroup$

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
|improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.