Fix #350 -- Show diagrams Animations as animated .gif images

ihaskell-display/ihaskell-diagrams/IHaskell/Display/Diagrams.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, FlexibleInstances  #-}
-module IHaskell.Display.Diagrams (diagram) where
+module IHaskell.Display.Diagrams (diagram, animation) where
 
 import ClassyPrelude
 
@@ -11,6 +11,7 @@ import Diagrams.Prelude
 import Diagrams.Backend.Cairo
 
 import IHaskell.Display
+import IHaskell.Display.Diagrams.Animation
 
 instance IHaskellDisplay (QDiagram Cairo R2 Any) where
   display renderable = do

ihaskell-display/ihaskell-diagrams/IHaskell/Display/Diagrams/Animation.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, FlexibleInstances  #-}
+module IHaskell.Display.Diagrams.Animation (animation) where
+
+import ClassyPrelude hiding (filename)
+
+import Diagrams.Prelude
+import Diagrams.Backend.Cairo
+import Diagrams.Backend.Cairo.CmdLine (GifOpts (..))
+import Diagrams.Backend.CmdLine (DiagramOpts (..), mainRender)
+
+import IHaskell.Display
+
+instance IHaskellDisplay (QAnimation Cairo R2 Any) where
+  display renderable = do
+    gif <- animationData renderable
+    return $ Display [html $ "<img src=\"data:image/gif;base64,"
+                               ++ gif ++ "\" />"]
+
+animationData :: Animation Cairo R2 -> IO String
+animationData renderable = do
+  switchToTmpDir
+
+  -- Generate the frames
+  let fps = 30
+      animAdjusted = animEnvelope' fps renderable
+      frames = simulate fps animAdjusted
+      timediff = 100 `div` ceiling fps :: Int
+      frameSet = map (\x -> (x # bg white, timediff)) frames
+
+  -- Compute width and height.
+  let shape = activeStart animAdjusted
+      w = width shape
+      h = height shape
+      aspect = w / h
+      imgHeight = 300
+      imgWidth = aspect * imgHeight
+
+  -- Write the image.
+  let filename = ".ihaskell-diagram.gif"
+      diagOpts = DiagramOpts {
+                             _width = Just . ceiling $ imgWidth
+                           , _height = Just . ceiling $ imgHeight
+                           , _output = filename
+                           }
+      gifOpts = GifOpts {
+                  _dither = True
+                , _noLooping = False
+                , _loopRepeat = Nothing
+                }
+  mainRender (diagOpts, gifOpts) frameSet
+
+  -- Convert to ascii represented base64 encoding
+  imgData <- readFile $ fpFromString filename
+  return . unpack . base64 $ imgData
+
+-- Rendering hint.
+animation :: Animation Cairo R2 -> Animation Cairo R2
+animation = id

ihaskell-display/ihaskell-diagrams/ihaskell-diagrams.cabal

@@ -51,7 +51,7 @@ library
   exposed-modules:     IHaskell.Display.Diagrams
   
   -- Modules included in this library but not exported.
-  -- other-modules:       
+  other-modules:       IHaskell.Display.Diagrams.Animation
   
   -- Language extensions.
   default-extensions: DoAndIfThenElse
@@ -66,8 +66,11 @@ library
                        diagrams==1.2.*,
                        diagrams-lib,
                        diagrams-cairo,
-                       ihaskell >= 0.5
-  
+                       ihaskell >= 0.5,
+
+                       -- The active package, used to represent animations
+                       active >= 0.1.0 && <0.1.1
+
   -- Directories containing source files.
   -- hs-source-dirs: