Allow generating gifs vor visualizing steps of the graham algo

TODO: this still requires us to hack on Main.hs, because
it isn't compatible with the GUI.
Also see https://github.com/diagrams/diagrams-cairo/issues/55

Algorithms/ConvexHull.hs

@@ -64,3 +64,20 @@ grahamGetCH vs = f . grahamSort $ vs
       | ccw x y z = x : f (y:z:xs)
       | otherwise = f (x:z:xs)
     f xs          = xs
+
+
+-- |Only compute steps of the graham scan algorithm to allow
+-- visualizing it.
+grahamGetCHSteps :: [PT] -> [[PT]]
+grahamGetCHSteps vs = reverse . g $ (length . grahamGetCH $ vs)
+  where
+    vs' = grahamSort vs
+    g c
+      | c >= 0 = f 0 vs' : g (c - 1)
+      | otherwise = []
+      where
+        f c' (x:y:z:xs)
+          | c' >= c   = [x,y]
+          | ccw x y z = x : f (c' + 1) (y:z:xs)
+          | otherwise = f (c' + 1) (x:z:xs)
+        f _ xs        = xs

CG2.cabal

@@ -60,7 +60,7 @@ executable CG2
   -- other-extensions:
 
   -- Other library packages from which modules are imported.
-  build-depends:       base >=4.6 && <4.8, diagrams-lib >=1.2 && <1.3, diagrams-cairo >=1.2 && <1.3, transformers >=0.4 && <0.5, glade >=0.12 && <0.13, gtk >=0.12 && <0.13, directory >=1.2 && <1.3
+  build-depends:       base >=4.6 && <4.8, diagrams-lib >=1.2 && <1.3, diagrams-cairo >=1.2 && <1.3, transformers >=0.4 && <0.5, glade >=0.12 && <0.13, gtk >=0.12 && <0.13, directory >=1.2 && <1.3, JuicyPixels >= 3.1.7.1
 
   -- Directories containing source files.
   -- hs-source-dirs:

Diagram.hs

@@ -7,12 +7,15 @@ module Diagram (t,
                 defaultProp,
                 diag,
                 diagS,
+                gifDiag,
+                gifDiagS,
                 whiteRect) where
 
 import Algorithms.ConvexHull
+import Codec.Picture.Gif
 import Class.Defaults
-import Diagrams.Prelude
 import Diagrams.Backend.Cairo
+import Diagrams.Prelude
 import LinearAlgebra.Vector
 import Parser.Meshparser
 
@@ -104,6 +107,8 @@ showConvexHullPoints = Diag f
               vtch = grahamGetCH vt
 
 
+-- |Create a diagram which shows the lines along the convex hull
+-- points.
 showConvexHullLines :: Diag
 showConvexHullLines = Diag f
   where
@@ -116,6 +121,19 @@ showConvexHullLines = Diag f
         ) # moveTo (head $ grahamGetCH vt) # lc red
 
 
+-- |Same as showConvexHullLines, except that it returns an array
+-- of diagrams with each step of the algorithm.
+showConvexHullLinesInterval :: DiagProp -> [PT] -> [Diagram Cairo R2]
+showConvexHullLinesInterval _ xs =
+  fmap g (grahamGetCHSteps xs)
+    where
+      g vt
+        = (strokeTrail        .
+           fromVertices       $
+           vt
+          ) # moveTo (head vt) # lc red
+
+
 -- |Creates a Diagram that shows an XAxis which is bound
 -- by the dimensions given in xD from DiagProp.
 showXAxis :: Diag
@@ -150,8 +168,9 @@ diag p = case alg p of
          (mconcat [showCoordinates, showXAxis, showYAxis, showWhiteRectB])
          p
   1 -> mkDiag
-         (mconcat [showConvexHullPoints, showConvexHullLines,
+         (mconcat $
-                   showCoordinates, showXAxis, showYAxis, showWhiteRectB])
+           [showConvexHullPoints, showConvexHullLines, showCoordinates,
+            showXAxis, showYAxis, showWhiteRectB])
          p
   _ -> mempty
 
@@ -165,6 +184,30 @@ diagS p mesh
       mesh) # bg white
 
 
+-- |Return a list of tuples used by 'gifMain' to generate an animated gif.
+gifDiag :: DiagProp -> [PT] -> [(Diagram Cairo R2, GifDelay)]
+gifDiag p xs = fmap (\x -> (x, 100))                      .
+                 fmap (\x -> x <> g)                      .
+                 flip (++)
+                   [mkDiag (showConvexHullLines `mappend`
+                            showConvexHullPoints) p xs]   $
+                 (showConvexHullLinesInterval p xs)
+                   where
+                     g = mconcat                      .
+                           fmap (\x -> mkDiag x p xs) $
+                           [showCoordinates,
+                            showXAxis,
+                            showYAxis,
+                            showWhiteRectB]
+
+
+-- |Same as gifDiag, except that it takes a string containing the
+-- mesh file content instead of the the points.
+gifDiagS :: DiagProp -> String -> [(Diagram Cairo R2, GifDelay)]
+gifDiagS p = gifDiag p .
+               meshToArr
+
+
 -- |Create a white rectangle with the given width and height.
 whiteRect :: Double -> Double -> Diagram Cairo R2
 whiteRect x y = rect x y # lwG 0.00 # bg white

Gtk.hs

@@ -1,12 +1,13 @@
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
-module Gtk (makeGUI) where
+module Gtk (makeGUI, gifCLI) where
 
 import Control.Monad.IO.Class
 import Class.Defaults
 import Diagram
 import Diagrams.Prelude
 import Diagrams.Backend.Cairo
+import Diagrams.Backend.Cairo.CmdLine
 import Diagrams.Backend.Cairo.Internal
 import Graphics.UI.Gtk
 import Graphics.UI.Gtk.Glade
@@ -76,6 +77,12 @@ makeMyGladeGUI = do
   return $ MkMyGUI win' dB' sB' qB' fB' da' hs' xl' xu' yl' yu' aD' cB'
 
 
+gifCLI :: FilePath -> IO ()
+gifCLI startFile = do
+  mesh       <- readFile "UB1_sonderfaelle.obj"
+  gifMain (gifDiagS def mesh)
+
+
 -- |Main entry point for the GTK GUI routines.
 makeGUI :: FilePath -> IO ()
 makeGUI startFile = do