From 75f357f8ca3c0ed33b79fe409c882062728b6e9b Mon Sep 17 00:00:00 2001 From: Lemmih Date: Sun, 20 Sep 2020 15:03:31 +0000 Subject: [PATCH] =?UTF-8?q?Deploying=20to=20gh-pages=20from=20=20@=200aca2?= =?UTF-8?q?333e21df5bcaf4fee958a30fecd3c1023a8=20=F0=9F=9A=80?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- playground/snippets.js | 6 +- .../Geom2D.CubicBezier.Linear.hs.html | 682 +++++++++--------- .../Reanimate.Driver.hs.html | 443 ++++++------ 3 files changed, 564 insertions(+), 567 deletions(-) diff --git a/playground/snippets.js b/playground/snippets.js index 352e2b8..fde0c22 100644 --- a/playground/snippets.js +++ b/playground/snippets.js @@ -3,10 +3,10 @@ const snippets = [{"title": "Hello World","url": "https://reanimate.clozecards.c ,{"title": "Color Maps","url": "https://reanimate.clozecards.com/D2qhcmUMxQc/60.svg","code": "animation :: Animation\nanimation = docEnv $ scene $ do\n play $ staticFrame 1 (showColorMap parula)\n & label \"Parula\"\n play $ staticFrame 1 (showColorMap viridis)\n & label \"Viridis\"\n play $ staticFrame 1 (showColorMap turbo)\n & label \"Turbo\"\n play $ staticFrame 1 (showColorMap greyscale)\n & label \"Greyscale\"\n\nlabel txt = overlay $\n withFillOpacity 1 $ withStrokeWidth 0 $\n withFillColor \"white\" $\n translate screenLeft (screenBottom+0.2) $\n latex txt\n\noverlay svg ani = ani `parA` staticFrame (duration ani) svg\n"} ,{"title": "Try it live","url": "https://reanimate.clozecards.com/OwjMi4FCJ4Z/90.svg","code": "background = \"lightblue\"\n\nshape :: SVG\nshape = mkCircle 4\n--shape = mkRect 6 6\n--shape = mkLine (screenLeft, screenBottom) (screenRight, screenTop)\n\nanimation :: Animation\nanimation = docEnv $\n addStatic (mkBackground background) $\n playThenReverseA $\n signalA (curveS 2) $\n setDuration 3 $ animate $ \\t ->\n partialSvg t $ pathify shape\n"} ,{"title": "Basic Objects","url": "https://reanimate.clozecards.com/CjGaiUUQ1eT/90.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n scene $ do\n circ <- newObject $ Circle 3\n oModify circ $\n oContext .~ withFillColor \"pink\"\n box <- newObject $ Rectangle 5 5\n oModify box $\n oContext .~ withFillColor \"lightblue\"\n \n oShowWith circ oGrow; wait 1\n oTransform circ box 1; wait 1\n oHideWith box oFadeOut; wait 1\n"} - ,{"title": "LaTeX","url": "https://reanimate.clozecards.com/BKHmgAI32CA/181.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n scene $ do\n drawLatex \"e^{i\\\\pi}+1=0\"\n drawLatex \"\\\\sum_{k=1}^\\\\infty {1 \\\\over k^2} = {\\\\pi^2 \\\\over 6}\"\n drawLatex \"\\\\sum_{k=1}^\\\\infty\"\n wait 1\n\ndrawLatex txt = do\n -- Draw outline\n fork $ do\n play $ animate $ \\t ->\n withFillOpacity 0 $\n partialSvg t svg\n -- Fade outline\n play $ animate $ \\t ->\n withFillOpacity 0 $\n withStrokeWidth (defaultStrokeWidth*(1-t)) $\n svg\n wait 0.7\n -- Fill in letters\n play $ animate $ \\t ->\n withFillOpacity t $ withStrokeWidth 0 $\n svg\n -- Hold static image and then fade out\n play $ staticFrame 2 (withStrokeWidth 0 svg)\n & applyE (overEnding 0.3 fadeOutE)\n where\n svg = scale 2 $ center $ latexAlign txt\n"} - ,{"title": "Easing Functions","url": "https://reanimate.clozecards.com/J$Nxz3yvngq/45.svg","code": "animation :: Animation\nanimation = docEnv $ pauseAtEnd 1 $ scene $ do\n showEasing 0 \"curveS\" (curveS 2)\n showEasing 1 \"bellS\" (bellS 2)\n showEasing 2 \"constantS\" (constantS 0.7)\n showEasing 3 \"oscillateS\" oscillateS\n showEasing 4 \"powerS\" (powerS 2)\n showEasing 5 \"reverseS\" reverseS\n showEasing 6 \"id\" id\n\nshowEasing nth txt fn = do\n let yOffset | even nth = 0\n | odd nth = -1\n xOffset = -6 + fromIntegral nth*2\n newSpriteSVG_ $\n \ttranslate xOffset yOffset $\n label txt\n fork $ play $ mapA (translate xOffset 0) $\n mapA (rotate 90) $\n mapA (scale (screenHeight/screenWidth * 0.6)) $\n signalA fn drawProgress\n\nlabel txt =\n translate 0 (-2.5) $\n scale 0.7 $\n center $\n withStrokeWidth 0 $\n withFillOpacity 1 $\n svg\n where\n svg = latex txt\n"} + ,{"title": "LaTeX","url": "https://reanimate.clozecards.com/F++VVYnubuc/181.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n scene $ do\n drawLatex \"e^{i\\\\pi}+1=0\"\n drawLatex \"\\\\sum_{k=1}^\\\\infty {1 \\\\over k^2} = {\\\\pi^2 \\\\over 6}\"\n drawLatex \"\\\\sum_{k=1}^\\\\infty\"\n wait 1\n\ndrawLatex txt = do\n -- Draw outline\n fork $ do\n play $ animate $ \\t ->\n withFillOpacity 0 $\n partialSvg t svg\n -- Fade outline\n play $ animate $ \\t ->\n withFillOpacity 0 $\n withStrokeWidth (defaultStrokeWidth*(1-t))\n svg\n wait 0.7\n -- Fill in letters\n play $ animate $ \\t ->\n withFillOpacity t $ withStrokeWidth 0\n svg\n -- Hold static image and then fade out\n play $ staticFrame 2 (withStrokeWidth 0 svg)\n & applyE (overEnding 0.3 fadeOutE)\n where\n svg = scale 2 $ center $ latexAlign txt\n"} + ,{"title": "Easing Functions","url": "https://reanimate.clozecards.com/Bc6Shtcsjgk/45.svg","code": "animation :: Animation\nanimation = docEnv $ pauseAtEnd 1 $ scene $ do\n showEasing 0 \"curveS\" (curveS 2)\n showEasing 1 \"bellS\" (bellS 2)\n showEasing 2 \"constantS\" (constantS 0.7)\n showEasing 3 \"oscillateS\" oscillateS\n showEasing 4 \"powerS\" (powerS 2)\n showEasing 5 \"reverseS\" reverseS\n showEasing 6 \"id\" id\n\nshowEasing nth txt fn = do\n let yOffset | even nth = 0\n | odd nth = -1\n xOffset = -6 + fromIntegral nth*2\n newSpriteSVG_ $\n \ttranslate xOffset yOffset $\n label txt\n fork $ play $ mapA (translate xOffset 0) $\n mapA (rotate 90) $\n mapA (scale (screenHeight/screenWidth * 0.6)) $\n signalA fn drawProgress\n\nlabel txt =\n translate 0 (-2.5) $\n scale 0.7 $\n center $\n withStrokeWidth 0 $\n withFillOpacity 1\n svg\n where\n svg = latex txt\n"} ,{"title": "Easing Graphs","url": "https://reanimate.clozecards.com/PYgakFrzwyp/255.svg","code": "colorPalette = parula -- try: viridis, sinebow, turbo, cividis\nfns =\n [(\"curveS\", curveS 2)\n ,(\"bellS\", bellS 2)\n ,(\"constantS\", constantS 0.7)\n ,(\"oscillateS\", oscillateS)\n ,(\"powerS\", powerS 2)\n ,(\"reverseS\", reverseS)\n ,(\"id\", id)\n ]\n\nanimation :: Animation\nanimation = docEnv $ pauseAtEnd 1 $ scene $ do\n newSpriteSVG_ $ mkBackground \"white\"\n play $ signalA (curveS 2) $ animate $ \\t -> partialSvg t grid\n newSpriteSVG_ grid\n wait 1\n flip mapM_ (zip [0..] fns) $ \\(nth, (txt, fn)) -> do\n let color = promotePixel $ colorPalette (nth / fromIntegral (length fns-1))\n showEasing nth txt fn color\n {- showEasing 3 \"oscillateS\" oscillateS\n showEasing 4 \"powerS\" (powerS 2)\n showEasing 5 \"reverseS\" reverseS\n showEasing 6 \"id\" id -}\n\ngridOffset = -2\ngridHeight = 5\ngridWidth = 8\n\ngrid :: SVG\ngrid = translate gridOffset 0 $\n withStrokeWidth defaultStrokeWidth $\n withStrokeColor \"grey\" $ mkGroup\n [ mkPath $ concat\n [[ SVG.MoveTo SVG.OriginAbsolute [V2 (-gridWidth/2) (gridHeight/2-n)]\n ,SVG.HorizontalTo SVG.OriginRelative [gridWidth] ]\n | n <- [1..gridHeight-1]\n ]\n , mkPath \n [ SVG.MoveTo SVG.OriginAbsolute [V2 (-gridWidth/2) (gridHeight/2)]\n , SVG.VerticalTo SVG.OriginRelative [-gridHeight]\n , SVG.HorizontalTo SVG.OriginRelative [gridWidth]\n , SVG.VerticalTo SVG.OriginRelative [gridHeight]\n , SVG.EndPath\n ]\n ]\n\nshowEasing nth txt fn color = do\n let steps = 100\n slope = withStrokeColorPixel color $\n translate gridOffset 0 $ mkLinePath\n [ ((x/steps-0.5)*gridWidth, (y-0.5)*gridHeight)\n | x <- [0..steps]\n , let y = fn (x/steps) ]\n s <- newSpriteSVG $\n withFillColorPixel color $\n translate (gridWidth/2+gridOffset+0.5) (gridHeight/2-nth) $\n label txt\n spriteE s $ overBeginning 0.2 fadeInE\n play $ animate $ \\t -> partialSvg t slope\n newSpriteSVG_ slope\n wait 1\n \nlabel txt = withStrokeColor \"black\" $\n withStrokeWidth (defaultStrokeWidth*2) $\n withFillOpacity 1 $\n latex txt\n"} ,{"title": "Object Positions","url": "https://reanimate.clozecards.com/LRZe4V6frOI/195.svg","code": "env =\n addStatic (mkBackground \"white\") .\n mapA (withStrokeColor \"black\")\n\nanimation :: Animation\nanimation = env $\n scene $ do\n -- Configure objects\n txt <- newText \"Center\"\n top <- newText \"Top\"\n oModifyS top $ \n oTopY .= screenTop\n topR <- newText \"Top right\"\n oModifyS topR $ do\n oTopY .= screenTop\n oRightX .= screenRight\n botR <- newText \"Bottom right\"\n oModifyS botR $ do\n oTranslateY .= screenBottom+0.5\n oRightX .= screenRight\n botL <- newText \"Bottom left\"\n oModifyS botL $ do\n oTranslateY .= screenBottom+0.5\n oLeftX .= screenLeft\n topL <- newText \"Top left\"\n oModifyS topL $ do\n oTopY .= screenTop\n oLeftX .= screenLeft\n -- Show objects\n oShow txt\n wait 1\n switchTo txt top\n switchTo top topR\n switchTo topR botR\n switchTo botR botL\n switchTo botL topL\n switchTo topL txt\n\nswitchTo src dst = do\n fork $ oHideWith src oFadeOut\n oShowWith dst oFadeIn\n wait 1\n\nnewText txt =\n newObject $ scale 1.5 $ centerX $ latex txt\n"} ,{"title": "Camera","url": "https://reanimate.clozecards.com/JlWlOpJvDds/150.svg","code": "animation :: Animation\nanimation = docEnv $ mapA (withFillOpacity 1) $ scene $ do\n cam <- newObject Camera\n\n txt <- newObject $ center $ latex \"Fixed (non-cam)\"\n oModifyS txt $ do\n oTopY .= screenTop \n oZIndex .= 2\n\n circle <- newObject $ withFillColor \"blue\" $ mkCircle 1\n cameraAttach cam circle\n circleRight <- oRead circle oRightX\n\n box <- newObject $ withFillColor \"green\" $ mkRect 2 2\n cameraAttach cam box\n oModify box $ oLeftX .~ circleRight\n boxCenter <- oRead box oCenterXY\n\n small <- newObject $ center $ latex \"This text is very small\"\n cameraAttach cam small\n oModifyS small $ do\n oCenterXY .= boxCenter\n oScale .= 0.1\n \n oShow txt\n oShow small\n oShow circle\n oShow box\n\n wait 1\n\n cameraFocus cam boxCenter\n waitOn $ do\n fork $ cameraPan cam 3 boxCenter\n fork $ cameraZoom cam 3 15\n \n wait 2\n cameraZoom cam 3 1\n cameraPan cam 1 (V2 0 0)\n"} ]; -const playgroundVersion = "2020-09-20 (37aa9)"; +const playgroundVersion = "2020-09-20 (0aca2)"; diff --git a/reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear.hs.html b/reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear.hs.html index b70cf26..488d9e5 100644 --- a/reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear.hs.html +++ b/reanimate-1.0.0.0-inplace/Geom2D.CubicBezier.Linear.hs.html @@ -17,349 +17,347 @@ span.spaces { background: white } never executed always true always false 
-    1 {-# LANGUAGE DeriveFoldable         #-}
-    2 {-# LANGUAGE DeriveFunctor          #-}
-    3 {-# LANGUAGE DeriveTraversable      #-}
-    4 {-# LANGUAGE FunctionalDependencies #-}
-    5 {-# LANGUAGE UndecidableInstances   #-}
-    6 {-|
-    7 Module      : Geom2D.CubicBezier.Linear
-    8 Copyright   : Written by David Himmelstrup
-    9 License     : Unlicense
-   10 Maintainer  : lemmih@gmail.com
-   11 Stability   : experimental
-   12 Portability : POSIX
+    1 {-# LANGUAGE DeriveTraversable      #-}
+    2 {-# LANGUAGE FunctionalDependencies #-}
+    3 {-# LANGUAGE UndecidableInstances   #-}
+    4 {-|
+    5 Module      : Geom2D.CubicBezier.Linear
+    6 Copyright   : Written by David Himmelstrup
+    7 License     : Unlicense
+    8 Maintainer  : lemmih@gmail.com
+    9 Stability   : experimental
+   10 Portability : POSIX
+   11 
+   12 Convenience wrapper around 'Geom2D.CubicBezier'
    13 
-   14 Convenience wrapper around 'Geom2D.CubicBezier'
-   15 
-   16 -}
-   17 module Geom2D.CubicBezier.Linear
-   18   ( AnyBezier(..)
-   19   , CubicBezier(..)
-   20   , QuadBezier(..)
-   21   , OpenPath(..)
-   22   , ClosedPath(..)
-   23   , PathJoin(..)
-   24   , ClosedMetaPath(..)
-   25   , OpenMetaPath(..)
-   26   , MetaJoin(..)
-   27   , MetaNodeType(..)
-   28   , FillRule(..)
-   29   , Tension(..)
-   30   , quadToCubic
-   31   , arcLength
-   32   , arcLengthParam
-   33   , C.splitBezier
-   34   , colinear
-   35   , evalBezier
-   36   , evalBezierDeriv
-   37   , bezierHoriz
-   38   , bezierVert
-   39   , C.bezierSubsegment
-   40   , C.reorient
-   41   , closedPathCurves
-   42   , openPathCurves
-   43   , curvesToClosed
-   44   , closest
-   45   , unmetaOpen
-   46   , unmetaClosed
-   47   , union
-   48   , bezierIntersection
-   49   , interpolateVector
-   50   , vectorDistance
-   51   , findBezierInflection
-   52   , findBezierCusp
-   53   ) where
-   54 
-   55 import qualified Data.Vector.Unboxed as V
-   56 import qualified Geom2D.CubicBezier  as C
-   57 import           Graphics.SvgTree    (FillRule (..))
-   58 import           Linear.V2
-   59 
-   60 ------------------------------------------------------------
-   61 -- Data types
-   62 
-   63 -- | A bezier curve of any degree.
-   64 newtype AnyBezier a = AnyBezier (V.Vector (V2 a))
-   65 
-   66 -- | A cubic bezier curve.
-   67 data CubicBezier a = CubicBezier
-   68   { cubicC0 :: !(V2 a)
-   69   , cubicC1 :: !(V2 a)
-   70   , cubicC2 :: !(V2 a)
-   71   , cubicC3 :: !(V2 a)
-   72   } deriving (Show, Eq)
-   73 
-   74 -- | A quadratic bezier curve.
-   75 data QuadBezier a = QuadBezier
-   76   { quadC0 :: !(V2 a)
-   77   , quadC1 :: !(V2 a)
-   78   , quadC2 :: !(V2 a)
-   79   } deriving (Show, Eq)
-   80 
-   81 -- | Open cubicbezier path.
-   82 data OpenPath a = OpenPath [(V2 a, PathJoin a)] (V2 a)
-   83   deriving (Show, Eq)
-   84 
-   85 -- | Closed cubicbezier path.
-   86 newtype ClosedPath a = ClosedPath [(V2 a, PathJoin a)]
-   87   deriving (Show, Eq)
-   88 
-   89 -- | Join two points with either a straight line or a bezier
-   90 --   curve with two control points.
-   91 data PathJoin a
-   92   = JoinLine
-   93   | JoinCurve (V2 a) (V2 a)
-   94   deriving (Show, Eq)
-   95 
-   96 -- | Closed meta path.
-   97 newtype ClosedMetaPath a = ClosedMetaPath [(V2 a, MetaJoin a)]
-   98   deriving (Show, Eq)
-   99 
-  100 -- | Open meta path
-  101 data OpenMetaPath a = OpenMetaPath [(V2 a, MetaJoin a)] (V2 a)
-  102   deriving (Show, Eq)
-  103 
-  104 -- | The tension value specifies how /tense/ the curve is.
-  105 --   A higher value means the curve approaches a line segment,
-  106 --   while a lower value means the curve is more round. Metafont
-  107 --   doesn't allow values below 3/4.
-  108 data Tension a
-  109   = Tension
-  110     { tensionValue :: a }
-  111   | TensionAtLeast -- ^ Like Tension, but keep the segment inside the
-  112                    --   bounding triangle defined by the control points,
-  113                    --   if there is one.
-  114     { tensionValue :: a }
-  115   deriving (Functor, Foldable, Traversable, Eq, Show)
-  116 
-  117 -- | Join two meta points with either a bezier curve or tension
-  118 --   contraints.
-  119 data MetaJoin a
-  120   = MetaJoin
-  121   { metaTypeL :: MetaNodeType a
-  122   , tensionL  :: Tension a
-  123   , tensionR  :: Tension a
-  124   , metaTypeR :: MetaNodeType a
-  125   }
-  126   | Controls (V2 a) (V2 a)
-  127   deriving (Show, Eq)
-  128 
-  129 -- | Node constraint type.
-  130 data MetaNodeType a
-  131   = Open
-  132   | Curl { curlgamma :: a }
-  133   | Direction { nodedir :: V2 a }
-  134   deriving (Show, Eq)
-  135 
-  136 ------------------------------------------------------------
-  137 -- Methods
-  138 
-  139 -- | Convert a quadratic bezier to a cubic bezier.
-  140 quadToCubic :: Fractional a => QuadBezier a -> CubicBezier a
-  141 quadToCubic = upCast . C.quadToCubic . downCast
-  142 
-  143 -- | @arcLength c t tol@ finds the arclength of the bezier @c@ at @t@,
-  144 --   within given tolerance @tol@.
-  145 arcLength :: CubicBezier Double -> Double -> Double -> Double
-  146 arcLength bezier = C.arcLength (downCast bezier)
-  147 
-  148 -- | @arcLengthParam c len tol@ finds the parameter where the curve @c@
-  149 --   has the arclength @len@, within tolerance @tol@.
-  150 arcLengthParam :: CubicBezier Double -> Double -> Double -> Double
-  151 arcLengthParam bezier = C.arcLengthParam (downCast bezier)
-  152 
-  153 -- | Return @False@ if some points fall outside a line with a thickness of the given tolerance.
-  154 colinear :: CubicBezier Double -> Double -> Bool
-  155 colinear bezier = C.colinear (downCast bezier)
-  156 
-  157 -- | Calculate a value on the bezier curve.
-  158 evalBezier :: (C.GenericBezier b, V.Unbox a, Fractional a) => b a -> a -> V2 a
-  159 evalBezier c p = upCast $ C.evalBezier c p
-  160 
-  161 -- | Calculate a value and the first derivative on the curve.
-  162 evalBezierDeriv :: (V.Unbox a, Fractional a,C.GenericBezier b) => b a -> a -> (V2 a, V2 a)
-  163 evalBezierDeriv c p = upCast $ C.evalBezierDeriv c p
-  164 
-  165 -- | Find the parameter where the bezier curve is horizontal.
-  166 bezierHoriz :: CubicBezier Double -> [Double]
-  167 bezierHoriz = C.bezierHoriz . downCast
-  168 
-  169 -- | Find the parameter where the bezier curve is vertical.
-  170 bezierVert :: CubicBezier Double -> [Double]
-  171 bezierVert = C.bezierVert . downCast
-  172 
-  173 -- | Create a normal path from a metapath.
-  174 unmetaOpen :: OpenMetaPath Double -> OpenPath Double
-  175 unmetaOpen = upCast . C.unmetaOpen . downCast
-  176 
-  177 -- | Create a normal path from a metapath.
-  178 unmetaClosed :: ClosedMetaPath Double -> ClosedPath Double
-  179 unmetaClosed = upCast . C.unmetaClosed . downCast
-  180 
-  181 -- | `O((n+m)*log(n+m))`, for n segments and m intersections.
-  182 --   Union of paths, removing overlap and rounding to the given tolerance.
-  183 union :: [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
-  184 union p fill tol = upCast (C.union (downCast p) (downCast fill) tol)
-  185 
-  186 -- | Find the intersections between two Bezier curves, using the Bezier Clip algorithm.
-  187 --   Returns the parameters for both curves.
-  188 bezierIntersection :: CubicBezier Double -> CubicBezier Double -> Double -> [(Double, Double)]
-  189 bezierIntersection a b = C.bezierIntersection (downCast a) (downCast b)
-  190 
-  191 -- | Find the closest value on the bezier to the given point, within tolerance.
-  192 --   Return the first value found.
-  193 closest :: CubicBezier Double -> V2 Double -> Double -> Double
-  194 closest c p = C.closest (downCast c) (downCast p)
-  195 
-  196 -- | Return the closed path as a list of curves.
-  197 closedPathCurves :: Fractional a => ClosedPath a -> [CubicBezier a]
-  198 closedPathCurves = upCast . C.closedPathCurves . downCast
-  199 
-  200 -- | Return the open path as a list of curves.
-  201 openPathCurves :: Fractional a => OpenPath a -> [CubicBezier a]
-  202 openPathCurves = upCast . C.openPathCurves . downCast
-  203 
-  204 -- | Make an open path from a list of curves. The last control point of each curve is ignored.
-  205 curvesToClosed :: [CubicBezier a] -> ClosedPath a
-  206 curvesToClosed = upCast . C.curvesToClosed . downCast
-  207 
-  208 -- | Interpolate between two vectors.
-  209 interpolateVector :: Num a => V2 a -> V2 a -> a -> V2 a
-  210 interpolateVector a b p = upCast $ C.interpolateVector (downCast a) (downCast b) p
-  211 
-  212 -- | Distance between two vectors.
-  213 vectorDistance :: Floating a => V2 a -> V2 a -> a
-  214 vectorDistance a b = C.vectorDistance (downCast a) (downCast b)
-  215 
-  216 -- | Find inflection points on the curve.
-  217 findBezierInflection :: CubicBezier Double -> [Double]
-  218 findBezierInflection = C.findBezierInflection . downCast
-  219 
-  220 -- | Find the cusps of a bezier.
-  221 findBezierCusp :: CubicBezier Double -> [Double]
-  222 findBezierCusp = C.findBezierCusp . downCast
-  223 
-  224 ------------------------------------------------------------
-  225 -- Instances
-  226 
-  227 instance C.GenericBezier QuadBezier where
-  228   degree = C.degree . downCast
-  229   toVector = C.toVector . downCast
-  230   unsafeFromVector = upCast . C.unsafeFromVector
-  231 
-  232 instance C.GenericBezier CubicBezier where
-  233   degree = C.degree . downCast
-  234   toVector = C.toVector . downCast
-  235   unsafeFromVector = upCast . C.unsafeFromVector
-  236 
-  237 instance C.GenericBezier AnyBezier where
-  238   degree = C.degree . downCast
-  239   toVector = C.toVector . downCast
-  240   unsafeFromVector = upCast . C.unsafeFromVector
-  241 
-  242 ------------------------------------------------------------
-  243 -- Casting
-  244 
-  245 class Cast a b | a -> b, b -> a where
-  246   downCast :: a -> b
-  247   upCast   :: b -> a
-  248 
-  249 instance Cast a b => Cast [a] [b] where
-  250   downCast = map downCast
-  251   upCast = map upCast
-  252 
-  253 instance (Cast a a', Cast b b') => Cast (a,b) (a',b') where
-  254   downCast (a, b) = (downCast a, downCast b)
-  255   upCast (a, b) = (upCast a, upCast b)
-  256 
-  257 instance Cast (V2 a) (C.Point a) where
-  258   downCast (V2 a b) = C.Point a b
-  259   upCast (C.Point a b) = V2 a b
-  260 
-  261 instance Cast FillRule C.FillRule where
-  262   downCast FillEvenOdd = C.EvenOdd
-  263   downCast FillNonZero = C.NonZero
-  264   upCast C.EvenOdd = FillEvenOdd
-  265   upCast C.NonZero = FillNonZero
-  266 
-  267 instance Cast (CubicBezier a) (C.CubicBezier a) where
-  268   downCast (CubicBezier a b c d) = C.CubicBezier
-  269     (downCast a) (downCast b) (downCast c) (downCast d)
-  270   upCast (C.CubicBezier a b c d) = CubicBezier
-  271     (upCast a) (upCast b) (upCast c) (upCast d)
-  272 
-  273 instance Cast (QuadBezier a) (C.QuadBezier a) where
-  274   downCast (QuadBezier a b c) = C.QuadBezier
-  275     (downCast a) (downCast b) (downCast c)
-  276   upCast (C.QuadBezier a b c)= QuadBezier
-  277     (upCast a) (upCast b) (upCast c)
-  278 
-  279 instance V.Unbox a => Cast (AnyBezier a) (C.AnyBezier a) where
-  280   downCast (AnyBezier arr) = C.AnyBezier $
-  281     V.map (\(V2 a b) -> (a,b)) arr
-  282   upCast (C.AnyBezier arr) = AnyBezier $
-  283     V.map (uncurry V2) arr
-  284 
-  285 instance Cast (MetaNodeType a) (C.MetaNodeType a) where
-  286   downCast Open            = C.Open
-  287   downCast (Curl gamma)    = C.Curl gamma
-  288   downCast (Direction dir) = C.Direction (downCast dir)
-  289   upCast C.Open            = Open
-  290   upCast (C.Curl gamma)    = Curl gamma
-  291   upCast (C.Direction dir) = Direction (upCast dir)
-  292 
-  293 instance Cast (Tension a) (C.Tension a) where
-  294   downCast (Tension v)        = C.Tension v
-  295   downCast (TensionAtLeast v) = C.TensionAtLeast v
-  296   upCast (C.Tension v)        = Tension v
-  297   upCast (C.TensionAtLeast v) = TensionAtLeast v
-  298 
-  299 instance Cast (MetaJoin a) (C.MetaJoin a) where
-  300   downCast (MetaJoin tyL tL tR tyR) =
-  301     C.MetaJoin (downCast tyL) (downCast tL) (downCast tR) (downCast tyR)
-  302   downCast (Controls p1 p2) = C.Controls (downCast p1) (downCast p2)
-  303   upCast (C.MetaJoin tyL tL tR tyR) =
-  304     MetaJoin (upCast tyL) (upCast tL) (upCast tR) (upCast tyR)
-  305   upCast (C.Controls p1 p2)         = Controls (upCast p1) (upCast p2)
-  306 
-  307 instance Cast (PathJoin a) (C.PathJoin a) where
-  308   downCast JoinLine        = C.JoinLine
-  309   downCast (JoinCurve a b) = C.JoinCurve (downCast a) (downCast b)
-  310   upCast C.JoinLine        = JoinLine
-  311   upCast (C.JoinCurve a b) = JoinCurve (upCast a) (upCast b)
-  312 
-  313 instance Cast (OpenMetaPath a) (C.OpenMetaPath a) where
-  314   downCast (OpenMetaPath lst end) = C.OpenMetaPath
-  315     [ (downCast p, downCast j)
-  316     | (p, j) <- lst ] (downCast end)
-  317   upCast (C.OpenMetaPath lst end) = OpenMetaPath
-  318     [ (upCast p, upCast j)
-  319     | (p, j) <- lst ] (upCast end)
-  320 
-  321 instance Cast (ClosedMetaPath a) (C.ClosedMetaPath a) where
-  322   downCast (ClosedMetaPath lst) = C.ClosedMetaPath
-  323     [ (downCast p, downCast j)
-  324     | (p, j) <- lst ]
-  325   upCast (C.ClosedMetaPath lst) = ClosedMetaPath
-  326     [ (upCast p, upCast j)
-  327     | (p, j) <- lst ]
-  328 
-  329 instance Cast (OpenPath a) (C.OpenPath a) where
-  330   downCast (OpenPath lst end) = C.OpenPath
-  331     [ (downCast p, downCast j)
-  332     | (p, j) <- lst ] (downCast end)
-  333   upCast (C.OpenPath lst end) = OpenPath
-  334     [ (upCast p, upCast j)
-  335     | (p, j) <- lst ] (upCast end)
-  336 
-  337 instance Cast (ClosedPath a) (C.ClosedPath a) where
-  338   downCast (ClosedPath lst) = C.ClosedPath
-  339     [ (downCast p, downCast j)
-  340     | (p, j) <- lst ]
-  341   upCast (C.ClosedPath lst) = ClosedPath
-  342     [ (upCast p, upCast j)
-  343     | (p, j) <- lst ]
+   14 -}
+   15 module Geom2D.CubicBezier.Linear
+   16   ( AnyBezier(..)
+   17   , CubicBezier(..)
+   18   , QuadBezier(..)
+   19   , OpenPath(..)
+   20   , ClosedPath(..)
+   21   , PathJoin(..)
+   22   , ClosedMetaPath(..)
+   23   , OpenMetaPath(..)
+   24   , MetaJoin(..)
+   25   , MetaNodeType(..)
+   26   , FillRule(..)
+   27   , Tension(..)
+   28   , quadToCubic
+   29   , arcLength
+   30   , arcLengthParam
+   31   , C.splitBezier
+   32   , colinear
+   33   , evalBezier
+   34   , evalBezierDeriv
+   35   , bezierHoriz
+   36   , bezierVert
+   37   , C.bezierSubsegment
+   38   , C.reorient
+   39   , closedPathCurves
+   40   , openPathCurves
+   41   , curvesToClosed
+   42   , closest
+   43   , unmetaOpen
+   44   , unmetaClosed
+   45   , union
+   46   , bezierIntersection
+   47   , interpolateVector
+   48   , vectorDistance
+   49   , findBezierInflection
+   50   , findBezierCusp
+   51   ) where
+   52 
+   53 import qualified Data.Vector.Unboxed as V
+   54 import qualified Geom2D.CubicBezier  as C
+   55 import           Graphics.SvgTree    (FillRule (..))
+   56 import           Linear.V2
+   57 
+   58 ------------------------------------------------------------
+   59 -- Data types
+   60 
+   61 -- | A bezier curve of any degree.
+   62 newtype AnyBezier a = AnyBezier (V.Vector (V2 a))
+   63 
+   64 -- | A cubic bezier curve.
+   65 data CubicBezier a = CubicBezier
+   66   { cubicC0 :: !(V2 a)
+   67   , cubicC1 :: !(V2 a)
+   68   , cubicC2 :: !(V2 a)
+   69   , cubicC3 :: !(V2 a)
+   70   } deriving (Show, Eq)
+   71 
+   72 -- | A quadratic bezier curve.
+   73 data QuadBezier a = QuadBezier
+   74   { quadC0 :: !(V2 a)
+   75   , quadC1 :: !(V2 a)
+   76   , quadC2 :: !(V2 a)
+   77   } deriving (Show, Eq)
+   78 
+   79 -- | Open cubicbezier path.
+   80 data OpenPath a = OpenPath [(V2 a, PathJoin a)] (V2 a)
+   81   deriving (Show, Eq)
+   82 
+   83 -- | Closed cubicbezier path.
+   84 newtype ClosedPath a = ClosedPath [(V2 a, PathJoin a)]
+   85   deriving (Show, Eq)
+   86 
+   87 -- | Join two points with either a straight line or a bezier
+   88 --   curve with two control points.
+   89 data PathJoin a
+   90   = JoinLine
+   91   | JoinCurve (V2 a) (V2 a)
+   92   deriving (Show, Eq)
+   93 
+   94 -- | Closed meta path.
+   95 newtype ClosedMetaPath a = ClosedMetaPath [(V2 a, MetaJoin a)]
+   96   deriving (Show, Eq)
+   97 
+   98 -- | Open meta path
+   99 data OpenMetaPath a = OpenMetaPath [(V2 a, MetaJoin a)] (V2 a)
+  100   deriving (Show, Eq)
+  101 
+  102 -- | The tension value specifies how /tense/ the curve is.
+  103 --   A higher value means the curve approaches a line segment,
+  104 --   while a lower value means the curve is more round. Metafont
+  105 --   doesn't allow values below 3/4.
+  106 data Tension a
+  107   = Tension
+  108     { tensionValue :: a }
+  109   | TensionAtLeast -- ^ Like Tension, but keep the segment inside the
+  110                    --   bounding triangle defined by the control points,
+  111                    --   if there is one.
+  112     { tensionValue :: a }
+  113   deriving (Functor, Foldable, Traversable, Eq, Show)
+  114 
+  115 -- | Join two meta points with either a bezier curve or tension
+  116 --   contraints.
+  117 data MetaJoin a
+  118   = MetaJoin
+  119   { metaTypeL :: MetaNodeType a
+  120   , tensionL  :: Tension a
+  121   , tensionR  :: Tension a
+  122   , metaTypeR :: MetaNodeType a
+  123   }
+  124   | Controls (V2 a) (V2 a)
+  125   deriving (Show, Eq)
+  126 
+  127 -- | Node constraint type.
+  128 data MetaNodeType a
+  129   = Open
+  130   | Curl { curlgamma :: a }
+  131   | Direction { nodedir :: V2 a }
+  132   deriving (Show, Eq)
+  133 
+  134 ------------------------------------------------------------
+  135 -- Methods
+  136 
+  137 -- | Convert a quadratic bezier to a cubic bezier.
+  138 quadToCubic :: Fractional a => QuadBezier a -> CubicBezier a
+  139 quadToCubic = upCast . C.quadToCubic . downCast
+  140 
+  141 -- | @arcLength c t tol@ finds the arclength of the bezier @c@ at @t@,
+  142 --   within given tolerance @tol@.
+  143 arcLength :: CubicBezier Double -> Double -> Double -> Double
+  144 arcLength bezier = C.arcLength (downCast bezier)
+  145 
+  146 -- | @arcLengthParam c len tol@ finds the parameter where the curve @c@
+  147 --   has the arclength @len@, within tolerance @tol@.
+  148 arcLengthParam :: CubicBezier Double -> Double -> Double -> Double
+  149 arcLengthParam bezier = C.arcLengthParam (downCast bezier)
+  150 
+  151 -- | Return @False@ if some points fall outside a line with a thickness of the given tolerance.
+  152 colinear :: CubicBezier Double -> Double -> Bool
+  153 colinear bezier = C.colinear (downCast bezier)
+  154 
+  155 -- | Calculate a value on the bezier curve.
+  156 evalBezier :: (C.GenericBezier b, V.Unbox a, Fractional a) => b a -> a -> V2 a
+  157 evalBezier c p = upCast $ C.evalBezier c p
+  158 
+  159 -- | Calculate a value and the first derivative on the curve.
+  160 evalBezierDeriv :: (V.Unbox a, Fractional a,C.GenericBezier b) => b a -> a -> (V2 a, V2 a)
+  161 evalBezierDeriv c p = upCast $ C.evalBezierDeriv c p
+  162 
+  163 -- | Find the parameter where the bezier curve is horizontal.
+  164 bezierHoriz :: CubicBezier Double -> [Double]
+  165 bezierHoriz = C.bezierHoriz . downCast
+  166 
+  167 -- | Find the parameter where the bezier curve is vertical.
+  168 bezierVert :: CubicBezier Double -> [Double]
+  169 bezierVert = C.bezierVert . downCast
+  170 
+  171 -- | Create a normal path from a metapath.
+  172 unmetaOpen :: OpenMetaPath Double -> OpenPath Double
+  173 unmetaOpen = upCast . C.unmetaOpen . downCast
+  174 
+  175 -- | Create a normal path from a metapath.
+  176 unmetaClosed :: ClosedMetaPath Double -> ClosedPath Double
+  177 unmetaClosed = upCast . C.unmetaClosed . downCast
+  178 
+  179 -- | `O((n+m)*log(n+m))`, for n segments and m intersections.
+  180 --   Union of paths, removing overlap and rounding to the given tolerance.
+  181 union :: [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
+  182 union p fill tol = upCast (C.union (downCast p) (downCast fill) tol)
+  183 
+  184 -- | Find the intersections between two Bezier curves, using the Bezier Clip algorithm.
+  185 --   Returns the parameters for both curves.
+  186 bezierIntersection :: CubicBezier Double -> CubicBezier Double -> Double -> [(Double, Double)]
+  187 bezierIntersection a b = C.bezierIntersection (downCast a) (downCast b)
+  188 
+  189 -- | Find the closest value on the bezier to the given point, within tolerance.
+  190 --   Return the first value found.
+  191 closest :: CubicBezier Double -> V2 Double -> Double -> Double
+  192 closest c p = C.closest (downCast c) (downCast p)
+  193 
+  194 -- | Return the closed path as a list of curves.
+  195 closedPathCurves :: Fractional a => ClosedPath a -> [CubicBezier a]
+  196 closedPathCurves = upCast . C.closedPathCurves . downCast
+  197 
+  198 -- | Return the open path as a list of curves.
+  199 openPathCurves :: Fractional a => OpenPath a -> [CubicBezier a]
+  200 openPathCurves = upCast . C.openPathCurves . downCast
+  201 
+  202 -- | Make an open path from a list of curves. The last control point of each curve is ignored.
+  203 curvesToClosed :: [CubicBezier a] -> ClosedPath a
+  204 curvesToClosed = upCast . C.curvesToClosed . downCast
+  205 
+  206 -- | Interpolate between two vectors.
+  207 interpolateVector :: Num a => V2 a -> V2 a -> a -> V2 a
+  208 interpolateVector a b p = upCast $ C.interpolateVector (downCast a) (downCast b) p
+  209 
+  210 -- | Distance between two vectors.
+  211 vectorDistance :: Floating a => V2 a -> V2 a -> a
+  212 vectorDistance a b = C.vectorDistance (downCast a) (downCast b)
+  213 
+  214 -- | Find inflection points on the curve.
+  215 findBezierInflection :: CubicBezier Double -> [Double]
+  216 findBezierInflection = C.findBezierInflection . downCast
+  217 
+  218 -- | Find the cusps of a bezier.
+  219 findBezierCusp :: CubicBezier Double -> [Double]
+  220 findBezierCusp = C.findBezierCusp . downCast
+  221 
+  222 ------------------------------------------------------------
+  223 -- Instances
+  224 
+  225 instance C.GenericBezier QuadBezier where
+  226   degree = C.degree . downCast
+  227   toVector = C.toVector . downCast
+  228   unsafeFromVector = upCast . C.unsafeFromVector
+  229 
+  230 instance C.GenericBezier CubicBezier where
+  231   degree = C.degree . downCast
+  232   toVector = C.toVector . downCast
+  233   unsafeFromVector = upCast . C.unsafeFromVector
+  234 
+  235 instance C.GenericBezier AnyBezier where
+  236   degree = C.degree . downCast
+  237   toVector = C.toVector . downCast
+  238   unsafeFromVector = upCast . C.unsafeFromVector
+  239 
+  240 ------------------------------------------------------------
+  241 -- Casting
+  242 
+  243 class Cast a b | a -> b, b -> a where
+  244   downCast :: a -> b
+  245   upCast   :: b -> a
+  246 
+  247 instance Cast a b => Cast [a] [b] where
+  248   downCast = map downCast
+  249   upCast = map upCast
+  250 
+  251 instance (Cast a a', Cast b b') => Cast (a,b) (a',b') where
+  252   downCast (a, b) = (downCast a, downCast b)
+  253   upCast (a, b) = (upCast a, upCast b)
+  254 
+  255 instance Cast (V2 a) (C.Point a) where
+  256   downCast (V2 a b) = C.Point a b
+  257   upCast (C.Point a b) = V2 a b
+  258 
+  259 instance Cast FillRule C.FillRule where
+  260   downCast FillEvenOdd = C.EvenOdd
+  261   downCast FillNonZero = C.NonZero
+  262   upCast C.EvenOdd = FillEvenOdd
+  263   upCast C.NonZero = FillNonZero
+  264 
+  265 instance Cast (CubicBezier a) (C.CubicBezier a) where
+  266   downCast (CubicBezier a b c d) = C.CubicBezier
+  267     (downCast a) (downCast b) (downCast c) (downCast d)
+  268   upCast (C.CubicBezier a b c d) = CubicBezier
+  269     (upCast a) (upCast b) (upCast c) (upCast d)
+  270 
+  271 instance Cast (QuadBezier a) (C.QuadBezier a) where
+  272   downCast (QuadBezier a b c) = C.QuadBezier
+  273     (downCast a) (downCast b) (downCast c)
+  274   upCast (C.QuadBezier a b c)= QuadBezier
+  275     (upCast a) (upCast b) (upCast c)
+  276 
+  277 instance V.Unbox a => Cast (AnyBezier a) (C.AnyBezier a) where
+  278   downCast (AnyBezier arr) = C.AnyBezier $
+  279     V.map (\(V2 a b) -> (a,b)) arr
+  280   upCast (C.AnyBezier arr) = AnyBezier $
+  281     V.map (uncurry V2) arr
+  282 
+  283 instance Cast (MetaNodeType a) (C.MetaNodeType a) where
+  284   downCast Open            = C.Open
+  285   downCast (Curl gamma)    = C.Curl gamma
+  286   downCast (Direction dir) = C.Direction (downCast dir)
+  287   upCast C.Open            = Open
+  288   upCast (C.Curl gamma)    = Curl gamma
+  289   upCast (C.Direction dir) = Direction (upCast dir)
+  290 
+  291 instance Cast (Tension a) (C.Tension a) where
+  292   downCast (Tension v)        = C.Tension v
+  293   downCast (TensionAtLeast v) = C.TensionAtLeast v
+  294   upCast (C.Tension v)        = Tension v
+  295   upCast (C.TensionAtLeast v) = TensionAtLeast v
+  296 
+  297 instance Cast (MetaJoin a) (C.MetaJoin a) where
+  298   downCast (MetaJoin tyL tL tR tyR) =
+  299     C.MetaJoin (downCast tyL) (downCast tL) (downCast tR) (downCast tyR)
+  300   downCast (Controls p1 p2) = C.Controls (downCast p1) (downCast p2)
+  301   upCast (C.MetaJoin tyL tL tR tyR) =
+  302     MetaJoin (upCast tyL) (upCast tL) (upCast tR) (upCast tyR)
+  303   upCast (C.Controls p1 p2)         = Controls (upCast p1) (upCast p2)
+  304 
+  305 instance Cast (PathJoin a) (C.PathJoin a) where
+  306   downCast JoinLine        = C.JoinLine
+  307   downCast (JoinCurve a b) = C.JoinCurve (downCast a) (downCast b)
+  308   upCast C.JoinLine        = JoinLine
+  309   upCast (C.JoinCurve a b) = JoinCurve (upCast a) (upCast b)
+  310 
+  311 instance Cast (OpenMetaPath a) (C.OpenMetaPath a) where
+  312   downCast (OpenMetaPath lst end) = C.OpenMetaPath
+  313     [ (downCast p, downCast j)
+  314     | (p, j) <- lst ] (downCast end)
+  315   upCast (C.OpenMetaPath lst end) = OpenMetaPath
+  316     [ (upCast p, upCast j)
+  317     | (p, j) <- lst ] (upCast end)
+  318 
+  319 instance Cast (ClosedMetaPath a) (C.ClosedMetaPath a) where
+  320   downCast (ClosedMetaPath lst) = C.ClosedMetaPath
+  321     [ (downCast p, downCast j)
+  322     | (p, j) <- lst ]
+  323   upCast (C.ClosedMetaPath lst) = ClosedMetaPath
+  324     [ (upCast p, upCast j)
+  325     | (p, j) <- lst ]
+  326 
+  327 instance Cast (OpenPath a) (C.OpenPath a) where
+  328   downCast (OpenPath lst end) = C.OpenPath
+  329     [ (downCast p, downCast j)
+  330     | (p, j) <- lst ] (downCast end)
+  331   upCast (C.OpenPath lst end) = OpenPath
+  332     [ (upCast p, upCast j)
+  333     | (p, j) <- lst ] (upCast end)
+  334 
+  335 instance Cast (ClosedPath a) (C.ClosedPath a) where
+  336   downCast (ClosedPath lst) = C.ClosedPath
+  337     [ (downCast p, downCast j)
+  338     | (p, j) <- lst ]
+  339   upCast (C.ClosedPath lst) = ClosedPath
+  340     [ (upCast p, upCast j)
+  341     | (p, j) <- lst ]
diff --git a/reanimate-1.0.0.0-inplace/Reanimate.Driver.hs.html b/reanimate-1.0.0.0-inplace/Reanimate.Driver.hs.html index 9146644..c9b140e 100644 --- a/reanimate-1.0.0.0-inplace/Reanimate.Driver.hs.html +++ b/reanimate-1.0.0.0-inplace/Reanimate.Driver.hs.html @@ -17,229 +17,228 @@ span.spaces { background: white } never executed always true always false 
-    1 {-# LANGUAGE MultiWayIf      #-}
-    2 {-# LANGUAGE RecordWildCards #-}
-    3 module Reanimate.Driver
-    4   ( reanimate
-    5   )
-    6 where
-    7 
-    8 import           Control.Applicative      ((<|>))
-    9 import           Control.Monad
-   10 import           Data.Maybe
-   11 import           Data.Either
-   12 import           Reanimate.Animation      (Animation)
-   13 import           Reanimate.Driver.Check
-   14 import           Reanimate.Driver.CLI
-   15 import           Reanimate.Driver.Compile
-   16 import           Reanimate.Driver.Server
-   17 import           Reanimate.Parameters
-   18 import           Reanimate.Render         (render, renderSnippets, renderSvgs,
-   19                                            selectRaster)
-   20 import           System.Directory
-   21 import           System.Exit
-   22 import           System.FilePath
-   23 import           System.IO
-   24 import           Text.Printf
-   25 
-   26 presetFormat :: Preset -> Format
-   27 presetFormat Youtube    = RenderMp4
-   28 presetFormat ExampleGif = RenderGif
-   29 presetFormat Quick      = RenderMp4
-   30 presetFormat MediumQ    = RenderMp4
-   31 presetFormat HighQ      = RenderMp4
-   32 presetFormat LowFPS     = RenderMp4
-   33 
-   34 presetFPS :: Preset -> FPS
-   35 presetFPS Youtube    = 60
-   36 presetFPS ExampleGif = 25
-   37 presetFPS Quick      = 15
-   38 presetFPS MediumQ    = 30
-   39 presetFPS HighQ      = 30
-   40 presetFPS LowFPS     = 10
-   41 
-   42 presetWidth :: Preset -> Width
-   43 presetWidth Youtube    = 2560
-   44 presetWidth ExampleGif = 320
-   45 presetWidth Quick      = 320
-   46 presetWidth MediumQ    = 800
-   47 presetWidth HighQ      = 1920
-   48 presetWidth LowFPS     = presetWidth HighQ
-   49 
-   50 presetHeight :: Preset -> Height
-   51 presetHeight preset = presetWidth preset * 9 `div` 16
-   52 
-   53 formatFPS :: Format -> FPS
-   54 formatFPS RenderMp4  = 60
-   55 formatFPS RenderGif  = 25
-   56 formatFPS RenderWebm = 60
-   57 
-   58 formatWidth :: Format -> Width
-   59 formatWidth RenderMp4  = 2560
-   60 formatWidth RenderGif  = 320
-   61 formatWidth RenderWebm = 2560
-   62 
-   63 formatHeight :: Format -> Height
-   64 formatHeight RenderMp4  = 1440
-   65 formatHeight RenderGif  = 180
-   66 formatHeight RenderWebm = 1440
-   67 
-   68 formatExtension :: Format -> String
-   69 formatExtension RenderMp4  = "mp4"
-   70 formatExtension RenderGif  = "gif"
-   71 formatExtension RenderWebm = "webm"
-   72 
-   73 {-|
-   74 Main entry-point for accessing an animation. Creates a program that takes the
-   75 following command-line arguments:
-   76 
-   77 > Usage: PROG [COMMAND]
-   78 >   This program contains an animation which can either be viewed in a web-browser
-   79 >   or rendered to disk.
-   80 >
-   81 > Available options:
-   82 >   -h,--help                Show this help text
-   83 >
-   84 > Available commands:
-   85 >   check                    Run a system's diagnostic and report any missing
-   86 >                            external dependencies.
-   87 >   view                     Play animation in browser window.
-   88 >   render                   Render animation to file.
-   89 
-   90 Neither the \'check\' nor the \'view\' command take any additional arguments.
-   91 Rendering animation can be controlled with these arguments:
-   92 
-   93 > Usage: PROG render [-o|--target FILE] [--fps FPS] [-w|--width PIXELS]
-   94 >                    [-h|--height PIXELS] [--compile] [--format FMT]
-   95 >                    [--preset TYPE]
-   96 >   Render animation to file.
-   97 >
-   98 > Available options:
-   99 >   -o,--target FILE         Write output to FILE
-  100 >   --fps FPS                Set frames per second.
-  101 >   -w,--width PIXELS        Set video width.
-  102 >   -h,--height PIXELS       Set video height.
-  103 >   --compile                Compile source code before rendering.
-  104 >   --format FMT             Video format: mp4, gif, webm
-  105 >   --preset TYPE            Parameter presets: youtube, gif, quick
-  106 >   -h,--help                Show this help text
-  107 -}
-  108 reanimate :: Animation -> IO ()
-  109 reanimate animation = do
-  110   Options {..} <- getDriverOptions
-  111   case optsCommand of
-  112     Raw {..} -> do
-  113       setFPS 60
-  114       renderSvgs rawOutputFolder rawFrameOffset rawPrettyPrint animation
-  115     Test -> do
-  116       setNoExternals True
-  117       -- hSetBinaryMode stdout True
-  118       renderSnippets animation
-  119     Check       -> checkEnvironment
-  120     View {..}   -> serve viewVerbose viewGHCPath viewGHCOpts viewOrigin
-  121     Render {..} -> do
-  122       let fmt =
-  123             guessParameter renderFormat (fmap presetFormat renderPreset)
-  124               $ case renderTarget of
-  125                   -- Format guessed from output
-  126                   Just target -> case takeExtension target of
-  127                     ".mp4"  -> RenderMp4
-  128                     ".gif"  -> RenderGif
-  129                     ".webm" -> RenderWebm
-  130                     _       -> RenderMp4
-  131                   -- Default to mp4 rendering.
-  132                   Nothing -> RenderMp4
-  133 
-  134       target <- case renderTarget of
-  135         Nothing -> do
-  136           mbSelf <- findOwnSource
-  137           let ext = formatExtension fmt
-  138               self = fromMaybe "output" mbSelf
-  139           pure $ replaceExtension self ext
-  140         Just target -> makeAbsolute target
-  141 
-  142       let
-  143         fps =
-  144           guessParameter renderFPS (fmap presetFPS renderPreset) $ formatFPS fmt
-  145         (width, height) = fromMaybe
-  146           ( maybe (formatWidth fmt)  presetWidth  renderPreset
-  147           , maybe (formatHeight fmt) presetHeight renderPreset
-  148           )
-  149           (userPreferredDimensions renderWidth renderHeight)
-  150 
-  151       raster <-
-  152         if renderRaster == RasterNone || renderRaster == RasterAuto  then do
-  153           svgSupport <- hasFFmpegRSvg
-  154           if isRight svgSupport
-  155             then selectRaster renderRaster
-  156             else do
-  157               raster <- selectRaster RasterAuto
-  158               when (raster == RasterNone) $ do
-  159                 hPutStrLn stderr
-  160                   "Error: your FFmpeg was built without SVG support and no raster engines \
-  161                   \are available. Please install either inkscape, imagemagick, or rsvg."
-  162                 exitWith (ExitFailure 1)
-  163               return raster
-  164         else selectRaster renderRaster
-  165 
-  166       if renderCompile
-  167         then compile $
-  168           [ "render"
-  169           , "--fps"
-  170           , show fps
-  171           , "--width"
-  172           , show width
-  173           , "--height"
-  174           , show height
-  175           , "--format"
-  176           , showFormat fmt
-  177           , "--raster"
-  178           , showRaster raster
-  179           , "--target"
-  180           , target
-  181           , "+RTS"
-  182           , "-N"
-  183           , "-RTS"
-  184           ] ++ [ "--partial" | renderPartial ]
-  185         else do
-  186           setRaster raster
-  187           setFPS fps
-  188           setWidth width
-  189           setHeight height
-  190           printf
-  191             "Animation options:\n\
-  192                  \  fps:    %d\n\
-  193                  \  width:  %d\n\
-  194                  \  height: %d\n\
-  195                  \  fmt:    %s\n\
-  196                  \  target: %s\n\
-  197                  \  raster: %s\n"
-  198             fps
-  199             width
-  200             height
-  201             (showFormat fmt)
-  202             target
-  203             (show raster)
-  204 
-  205           render animation target raster fmt width height fps renderPartial
-  206 
-  207 guessParameter :: Maybe a -> Maybe a -> a -> a
-  208 guessParameter a b def = fromMaybe def (a <|> b)
+    1 {-# LANGUAGE RecordWildCards #-}
+    2 module Reanimate.Driver
+    3   ( reanimate
+    4   )
+    5 where
+    6 
+    7 import           Control.Applicative      ((<|>))
+    8 import           Control.Monad
+    9 import           Data.Maybe
+   10 import           Data.Either
+   11 import           Reanimate.Animation      (Animation)
+   12 import           Reanimate.Driver.Check
+   13 import           Reanimate.Driver.CLI
+   14 import           Reanimate.Driver.Compile
+   15 import           Reanimate.Driver.Server
+   16 import           Reanimate.Parameters
+   17 import           Reanimate.Render         (render, renderSnippets, renderSvgs,
+   18                                            selectRaster)
+   19 import           System.Directory
+   20 import           System.Exit
+   21 import           System.FilePath
+   22 import           System.IO
+   23 import           Text.Printf
+   24 
+   25 presetFormat :: Preset -> Format
+   26 presetFormat Youtube    = RenderMp4
+   27 presetFormat ExampleGif = RenderGif
+   28 presetFormat Quick      = RenderMp4
+   29 presetFormat MediumQ    = RenderMp4
+   30 presetFormat HighQ      = RenderMp4
+   31 presetFormat LowFPS     = RenderMp4
+   32 
+   33 presetFPS :: Preset -> FPS
+   34 presetFPS Youtube    = 60
+   35 presetFPS ExampleGif = 25
+   36 presetFPS Quick      = 15
+   37 presetFPS MediumQ    = 30
+   38 presetFPS HighQ      = 30
+   39 presetFPS LowFPS     = 10
+   40 
+   41 presetWidth :: Preset -> Width
+   42 presetWidth Youtube    = 2560
+   43 presetWidth ExampleGif = 320
+   44 presetWidth Quick      = 320
+   45 presetWidth MediumQ    = 800
+   46 presetWidth HighQ      = 1920
+   47 presetWidth LowFPS     = presetWidth HighQ
+   48 
+   49 presetHeight :: Preset -> Height
+   50 presetHeight preset = presetWidth preset * 9 `div` 16
+   51 
+   52 formatFPS :: Format -> FPS
+   53 formatFPS RenderMp4  = 60
+   54 formatFPS RenderGif  = 25
+   55 formatFPS RenderWebm = 60
+   56 
+   57 formatWidth :: Format -> Width
+   58 formatWidth RenderMp4  = 2560
+   59 formatWidth RenderGif  = 320
+   60 formatWidth RenderWebm = 2560
+   61 
+   62 formatHeight :: Format -> Height
+   63 formatHeight RenderMp4  = 1440
+   64 formatHeight RenderGif  = 180
+   65 formatHeight RenderWebm = 1440
+   66 
+   67 formatExtension :: Format -> String
+   68 formatExtension RenderMp4  = "mp4"
+   69 formatExtension RenderGif  = "gif"
+   70 formatExtension RenderWebm = "webm"
+   71 
+   72 {-|
+   73 Main entry-point for accessing an animation. Creates a program that takes the
+   74 following command-line arguments:
+   75 
+   76 > Usage: PROG [COMMAND]
+   77 >   This program contains an animation which can either be viewed in a web-browser
+   78 >   or rendered to disk.
+   79 >
+   80 > Available options:
+   81 >   -h,--help                Show this help text
+   82 >
+   83 > Available commands:
+   84 >   check                    Run a system's diagnostic and report any missing
+   85 >                            external dependencies.
+   86 >   view                     Play animation in browser window.
+   87 >   render                   Render animation to file.
+   88 
+   89 Neither the \'check\' nor the \'view\' command take any additional arguments.
+   90 Rendering animation can be controlled with these arguments:
+   91 
+   92 > Usage: PROG render [-o|--target FILE] [--fps FPS] [-w|--width PIXELS]
+   93 >                    [-h|--height PIXELS] [--compile] [--format FMT]
+   94 >                    [--preset TYPE]
+   95 >   Render animation to file.
+   96 >
+   97 > Available options:
+   98 >   -o,--target FILE         Write output to FILE
+   99 >   --fps FPS                Set frames per second.
+  100 >   -w,--width PIXELS        Set video width.
+  101 >   -h,--height PIXELS       Set video height.
+  102 >   --compile                Compile source code before rendering.
+  103 >   --format FMT             Video format: mp4, gif, webm
+  104 >   --preset TYPE            Parameter presets: youtube, gif, quick
+  105 >   -h,--help                Show this help text
+  106 -}
+  107 reanimate :: Animation -> IO ()
+  108 reanimate animation = do
+  109   Options {..} <- getDriverOptions
+  110   case optsCommand of
+  111     Raw {..} -> do
+  112       setFPS 60
+  113       renderSvgs rawOutputFolder rawFrameOffset rawPrettyPrint animation
+  114     Test -> do
+  115       setNoExternals True
+  116       -- hSetBinaryMode stdout True
+  117       renderSnippets animation
+  118     Check       -> checkEnvironment
+  119     View {..}   -> serve viewVerbose viewGHCPath viewGHCOpts viewOrigin
+  120     Render {..} -> do
+  121       let fmt =
+  122             guessParameter renderFormat (fmap presetFormat renderPreset)
+  123               $ case renderTarget of
+  124                   -- Format guessed from output
+  125                   Just target -> case takeExtension target of
+  126                     ".mp4"  -> RenderMp4
+  127                     ".gif"  -> RenderGif
+  128                     ".webm" -> RenderWebm
+  129                     _       -> RenderMp4
+  130                   -- Default to mp4 rendering.
+  131                   Nothing -> RenderMp4
+  132 
+  133       target <- case renderTarget of
+  134         Nothing -> do
+  135           mbSelf <- findOwnSource
+  136           let ext = formatExtension fmt
+  137               self = fromMaybe "output" mbSelf
+  138           pure $ replaceExtension self ext
+  139         Just target -> makeAbsolute target
+  140 
+  141       let
+  142         fps =
+  143           guessParameter renderFPS (fmap presetFPS renderPreset) $ formatFPS fmt
+  144         (width, height) = fromMaybe
+  145           ( maybe (formatWidth fmt)  presetWidth  renderPreset
+  146           , maybe (formatHeight fmt) presetHeight renderPreset
+  147           )
+  148           (userPreferredDimensions renderWidth renderHeight)
+  149 
+  150       raster <-
+  151         if renderRaster == RasterNone || renderRaster == RasterAuto  then do
+  152           svgSupport <- hasFFmpegRSvg
+  153           if isRight svgSupport
+  154             then selectRaster renderRaster
+  155             else do
+  156               raster <- selectRaster RasterAuto
+  157               when (raster == RasterNone) $ do
+  158                 hPutStrLn stderr
+  159                   "Error: your FFmpeg was built without SVG support and no raster engines \
+  160                   \are available. Please install either inkscape, imagemagick, or rsvg."
+  161                 exitWith (ExitFailure 1)
+  162               return raster
+  163         else selectRaster renderRaster
+  164 
+  165       if renderCompile
+  166         then compile $
+  167           [ "render"
+  168           , "--fps"
+  169           , show fps
+  170           , "--width"
+  171           , show width
+  172           , "--height"
+  173           , show height
+  174           , "--format"
+  175           , showFormat fmt
+  176           , "--raster"
+  177           , showRaster raster
+  178           , "--target"
+  179           , target
+  180           , "+RTS"
+  181           , "-N"
+  182           , "-RTS"
+  183           ] ++ [ "--partial" | renderPartial ]
+  184         else do
+  185           setRaster raster
+  186           setFPS fps
+  187           setWidth width
+  188           setHeight height
+  189           printf
+  190             "Animation options:\n\
+  191                  \  fps:    %d\n\
+  192                  \  width:  %d\n\
+  193                  \  height: %d\n\
+  194                  \  fmt:    %s\n\
+  195                  \  target: %s\n\
+  196                  \  raster: %s\n"
+  197             fps
+  198             width
+  199             height
+  200             (showFormat fmt)
+  201             target
+  202             (show raster)
+  203 
+  204           render animation target raster fmt width height fps renderPartial
+  205 
+  206 guessParameter :: Maybe a -> Maybe a -> a -> a
+  207 guessParameter a b def = fromMaybe def (a <|> b)
+  208 
   209 
-  210 
-  211 -- If user specifies exactly one dimension explicitly, calculate the other
-  212 userPreferredDimensions :: Maybe Width -> Maybe Height -> Maybe (Width, Height)
-  213 userPreferredDimensions (Just width) (Just height) = Just (width, height)
-  214 userPreferredDimensions (Just width) Nothing =
-  215   Just (width, makeEven $ width * 9 `div` 16)
-  216 userPreferredDimensions Nothing (Just height) =
-  217   Just (makeEven $ height * 16 `div` 9, height)
-  218 userPreferredDimensions Nothing Nothing = Nothing
-  219 
-  220 -- Avoid ffmpeg failures "height not divisible by 2"
-  221 makeEven :: Int -> Int
-  222 makeEven x | even x    = x
-  223            | otherwise = x - 1
+  210 -- If user specifies exactly one dimension explicitly, calculate the other
+  211 userPreferredDimensions :: Maybe Width -> Maybe Height -> Maybe (Width, Height)
+  212 userPreferredDimensions (Just width) (Just height) = Just (width, height)
+  213 userPreferredDimensions (Just width) Nothing =
+  214   Just (width, makeEven $ width * 9 `div` 16)
+  215 userPreferredDimensions Nothing (Just height) =
+  216   Just (makeEven $ height * 16 `div` 9, height)
+  217 userPreferredDimensions Nothing Nothing = Nothing
+  218 
+  219 -- Avoid ffmpeg failures "height not divisible by 2"
+  220 makeEven :: Int -> Int
+  221 makeEven x | even x    = x
+  222            | otherwise = x - 1