Deploying to gh-pages from @ 0aca2333e2 🚀

This commit is contained in:
Lemmih 2020-09-20 15:03:31 +00:00
commit 75f357f8ca
3 changed files with 564 additions and 567 deletions

View file

@ -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)";

View file

@ -17,349 +17,347 @@ span.spaces { background: white }
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
</pre>
<pre>
<span class="lineno"> 1 </span>{-# LANGUAGE DeriveFoldable #-}
<span class="lineno"> 2 </span>{-# LANGUAGE DeriveFunctor #-}
<span class="lineno"> 3 </span>{-# LANGUAGE DeriveTraversable #-}
<span class="lineno"> 4 </span>{-# LANGUAGE FunctionalDependencies #-}
<span class="lineno"> 5 </span>{-# LANGUAGE UndecidableInstances #-}
<span class="lineno"> 6 </span>{-|
<span class="lineno"> 7 </span>Module : Geom2D.CubicBezier.Linear
<span class="lineno"> 8 </span>Copyright : Written by David Himmelstrup
<span class="lineno"> 9 </span>License : Unlicense
<span class="lineno"> 10 </span>Maintainer : lemmih@gmail.com
<span class="lineno"> 11 </span>Stability : experimental
<span class="lineno"> 12 </span>Portability : POSIX
<span class="lineno"> 1 </span>{-# LANGUAGE DeriveTraversable #-}
<span class="lineno"> 2 </span>{-# LANGUAGE FunctionalDependencies #-}
<span class="lineno"> 3 </span>{-# LANGUAGE UndecidableInstances #-}
<span class="lineno"> 4 </span>{-|
<span class="lineno"> 5 </span>Module : Geom2D.CubicBezier.Linear
<span class="lineno"> 6 </span>Copyright : Written by David Himmelstrup
<span class="lineno"> 7 </span>License : Unlicense
<span class="lineno"> 8 </span>Maintainer : lemmih@gmail.com
<span class="lineno"> 9 </span>Stability : experimental
<span class="lineno"> 10 </span>Portability : POSIX
<span class="lineno"> 11 </span>
<span class="lineno"> 12 </span>Convenience wrapper around 'Geom2D.CubicBezier'
<span class="lineno"> 13 </span>
<span class="lineno"> 14 </span>Convenience wrapper around 'Geom2D.CubicBezier'
<span class="lineno"> 15 </span>
<span class="lineno"> 16 </span>-}
<span class="lineno"> 17 </span>module Geom2D.CubicBezier.Linear
<span class="lineno"> 18 </span> ( AnyBezier(..)
<span class="lineno"> 19 </span> , CubicBezier(..)
<span class="lineno"> 20 </span> , QuadBezier(..)
<span class="lineno"> 21 </span> , OpenPath(..)
<span class="lineno"> 22 </span> , ClosedPath(..)
<span class="lineno"> 23 </span> , PathJoin(..)
<span class="lineno"> 24 </span> , ClosedMetaPath(..)
<span class="lineno"> 25 </span> , OpenMetaPath(..)
<span class="lineno"> 26 </span> , MetaJoin(..)
<span class="lineno"> 27 </span> , MetaNodeType(..)
<span class="lineno"> 28 </span> , FillRule(..)
<span class="lineno"> 29 </span> , Tension(..)
<span class="lineno"> 30 </span> , quadToCubic
<span class="lineno"> 31 </span> , arcLength
<span class="lineno"> 32 </span> , arcLengthParam
<span class="lineno"> 33 </span> , C.splitBezier
<span class="lineno"> 34 </span> , colinear
<span class="lineno"> 35 </span> , evalBezier
<span class="lineno"> 36 </span> , evalBezierDeriv
<span class="lineno"> 37 </span> , bezierHoriz
<span class="lineno"> 38 </span> , bezierVert
<span class="lineno"> 39 </span> , C.bezierSubsegment
<span class="lineno"> 40 </span> , C.reorient
<span class="lineno"> 41 </span> , closedPathCurves
<span class="lineno"> 42 </span> , openPathCurves
<span class="lineno"> 43 </span> , curvesToClosed
<span class="lineno"> 44 </span> , closest
<span class="lineno"> 45 </span> , unmetaOpen
<span class="lineno"> 46 </span> , unmetaClosed
<span class="lineno"> 47 </span> , union
<span class="lineno"> 48 </span> , bezierIntersection
<span class="lineno"> 49 </span> , interpolateVector
<span class="lineno"> 50 </span> , vectorDistance
<span class="lineno"> 51 </span> , findBezierInflection
<span class="lineno"> 52 </span> , findBezierCusp
<span class="lineno"> 53 </span> ) where
<span class="lineno"> 54 </span>
<span class="lineno"> 55 </span>import qualified Data.Vector.Unboxed as V
<span class="lineno"> 56 </span>import qualified Geom2D.CubicBezier as C
<span class="lineno"> 57 </span>import Graphics.SvgTree (FillRule (..))
<span class="lineno"> 58 </span>import Linear.V2
<span class="lineno"> 59 </span>
<span class="lineno"> 60 </span>------------------------------------------------------------
<span class="lineno"> 61 </span>-- Data types
<span class="lineno"> 62 </span>
<span class="lineno"> 63 </span>-- | A bezier curve of any degree.
<span class="lineno"> 64 </span>newtype AnyBezier a = AnyBezier (V.Vector (V2 a))
<span class="lineno"> 65 </span>
<span class="lineno"> 66 </span>-- | A cubic bezier curve.
<span class="lineno"> 67 </span>data CubicBezier a = CubicBezier
<span class="lineno"> 68 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC0</span></span></span> :: !(V2 a)
<span class="lineno"> 69 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC1</span></span></span> :: !(V2 a)
<span class="lineno"> 70 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC2</span></span></span> :: !(V2 a)
<span class="lineno"> 71 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC3</span></span></span> :: !(V2 a)
<span class="lineno"> 72 </span> } deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 73 </span>
<span class="lineno"> 74 </span>-- | A quadratic bezier curve.
<span class="lineno"> 75 </span>data QuadBezier a = QuadBezier
<span class="lineno"> 76 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">quadC0</span></span></span> :: !(V2 a)
<span class="lineno"> 77 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">quadC1</span></span></span> :: !(V2 a)
<span class="lineno"> 78 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">quadC2</span></span></span> :: !(V2 a)
<span class="lineno"> 79 </span> } deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 80 </span>
<span class="lineno"> 81 </span>-- | Open cubicbezier path.
<span class="lineno"> 82 </span>data OpenPath a = OpenPath [(V2 a, PathJoin a)] (V2 a)
<span class="lineno"> 83 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 84 </span>
<span class="lineno"> 85 </span>-- | Closed cubicbezier path.
<span class="lineno"> 86 </span>newtype ClosedPath a = ClosedPath [(V2 a, PathJoin a)]
<span class="lineno"> 87 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Eq</span></span></span></span>)
<span class="lineno"> 88 </span>
<span class="lineno"> 89 </span>-- | Join two points with either a straight line or a bezier
<span class="lineno"> 90 </span>-- curve with two control points.
<span class="lineno"> 91 </span>data PathJoin a
<span class="lineno"> 92 </span> = JoinLine
<span class="lineno"> 93 </span> | JoinCurve (V2 a) (V2 a)
<span class="lineno"> 94 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 95 </span>
<span class="lineno"> 96 </span>-- | Closed meta path.
<span class="lineno"> 97 </span>newtype ClosedMetaPath a = ClosedMetaPath [(V2 a, MetaJoin a)]
<span class="lineno"> 98 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Eq</span></span></span></span>)
<span class="lineno"> 99 </span>
<span class="lineno"> 100 </span>-- | Open meta path
<span class="lineno"> 101 </span>data OpenMetaPath a = OpenMetaPath [(V2 a, MetaJoin a)] (V2 a)
<span class="lineno"> 102 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 103 </span>
<span class="lineno"> 104 </span>-- | The tension value specifies how /tense/ the curve is.
<span class="lineno"> 105 </span>-- A higher value means the curve approaches a line segment,
<span class="lineno"> 106 </span>-- while a lower value means the curve is more round. Metafont
<span class="lineno"> 107 </span>-- doesn't allow values below 3/4.
<span class="lineno"> 108 </span>data Tension a
<span class="lineno"> 109 </span> = Tension
<span class="lineno"> 110 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">tensionValue</span></span></span> :: a }
<span class="lineno"> 111 </span> | TensionAtLeast -- ^ Like Tension, but keep the segment inside the
<span class="lineno"> 112 </span> -- bounding triangle defined by the control points,
<span class="lineno"> 113 </span> -- if there is one.
<span class="lineno"> 114 </span> { tensionValue :: a }
<span class="lineno"> 115 </span> deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Functor</span></span></span></span>, <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Foldable</span></span></span></span></span></span>, <span class="decl"><span class="nottickedoff">Traversable</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>, <span class="decl"><span class="nottickedoff">Show</span></span>)
<span class="lineno"> 116 </span>
<span class="lineno"> 117 </span>-- | Join two meta points with either a bezier curve or tension
<span class="lineno"> 118 </span>-- contraints.
<span class="lineno"> 119 </span>data MetaJoin a
<span class="lineno"> 120 </span> = MetaJoin
<span class="lineno"> 121 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">metaTypeL</span></span></span> :: MetaNodeType a
<span class="lineno"> 122 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">tensionL</span></span></span> :: Tension a
<span class="lineno"> 123 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">tensionR</span></span></span> :: Tension a
<span class="lineno"> 124 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">metaTypeR</span></span></span> :: MetaNodeType a
<span class="lineno"> 125 </span> }
<span class="lineno"> 126 </span> | Controls (V2 a) (V2 a)
<span class="lineno"> 127 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 128 </span>
<span class="lineno"> 129 </span>-- | Node constraint type.
<span class="lineno"> 130 </span>data MetaNodeType a
<span class="lineno"> 131 </span> = Open
<span class="lineno"> 132 </span> | Curl { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">curlgamma</span></span></span> :: a }
<span class="lineno"> 133 </span> | Direction { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">nodedir</span></span></span> :: V2 a }
<span class="lineno"> 134 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 135 </span>
<span class="lineno"> 136 </span>------------------------------------------------------------
<span class="lineno"> 137 </span>-- Methods
<span class="lineno"> 138 </span>
<span class="lineno"> 139 </span>-- | Convert a quadratic bezier to a cubic bezier.
<span class="lineno"> 140 </span>quadToCubic :: Fractional a =&gt; QuadBezier a -&gt; CubicBezier a
<span class="lineno"> 141 </span><span class="decl"><span class="istickedoff">quadToCubic = upCast . C.quadToCubic . downCast</span></span>
<span class="lineno"> 142 </span>
<span class="lineno"> 143 </span>-- | @arcLength c t tol@ finds the arclength of the bezier @c@ at @t@,
<span class="lineno"> 144 </span>-- within given tolerance @tol@.
<span class="lineno"> 145 </span>arcLength :: CubicBezier Double -&gt; Double -&gt; Double -&gt; Double
<span class="lineno"> 146 </span><span class="decl"><span class="istickedoff">arcLength bezier = C.arcLength (downCast bezier)</span></span>
<span class="lineno"> 147 </span>
<span class="lineno"> 148 </span>-- | @arcLengthParam c len tol@ finds the parameter where the curve @c@
<span class="lineno"> 149 </span>-- has the arclength @len@, within tolerance @tol@.
<span class="lineno"> 150 </span>arcLengthParam :: CubicBezier Double -&gt; Double -&gt; Double -&gt; Double
<span class="lineno"> 151 </span><span class="decl"><span class="nottickedoff">arcLengthParam bezier = C.arcLengthParam (downCast bezier)</span></span>
<span class="lineno"> 152 </span>
<span class="lineno"> 153 </span>-- | Return @False@ if some points fall outside a line with a thickness of the given tolerance.
<span class="lineno"> 154 </span>colinear :: CubicBezier Double -&gt; Double -&gt; Bool
<span class="lineno"> 155 </span><span class="decl"><span class="istickedoff">colinear bezier = C.colinear (downCast bezier)</span></span>
<span class="lineno"> 156 </span>
<span class="lineno"> 157 </span>-- | Calculate a value on the bezier curve.
<span class="lineno"> 158 </span>evalBezier :: (C.GenericBezier b, V.Unbox a, Fractional a) =&gt; b a -&gt; a -&gt; V2 a
<span class="lineno"> 159 </span><span class="decl"><span class="istickedoff">evalBezier c p = upCast $ C.evalBezier c p</span></span>
<span class="lineno"> 160 </span>
<span class="lineno"> 161 </span>-- | Calculate a value and the first derivative on the curve.
<span class="lineno"> 162 </span>evalBezierDeriv :: (V.Unbox a, Fractional a,C.GenericBezier b) =&gt; b a -&gt; a -&gt; (V2 a, V2 a)
<span class="lineno"> 163 </span><span class="decl"><span class="nottickedoff">evalBezierDeriv c p = upCast $ C.evalBezierDeriv c p</span></span>
<span class="lineno"> 164 </span>
<span class="lineno"> 165 </span>-- | Find the parameter where the bezier curve is horizontal.
<span class="lineno"> 166 </span>bezierHoriz :: CubicBezier Double -&gt; [Double]
<span class="lineno"> 167 </span><span class="decl"><span class="nottickedoff">bezierHoriz = C.bezierHoriz . downCast</span></span>
<span class="lineno"> 168 </span>
<span class="lineno"> 169 </span>-- | Find the parameter where the bezier curve is vertical.
<span class="lineno"> 170 </span>bezierVert :: CubicBezier Double -&gt; [Double]
<span class="lineno"> 171 </span><span class="decl"><span class="nottickedoff">bezierVert = C.bezierVert . downCast</span></span>
<span class="lineno"> 172 </span>
<span class="lineno"> 173 </span>-- | Create a normal path from a metapath.
<span class="lineno"> 174 </span>unmetaOpen :: OpenMetaPath Double -&gt; OpenPath Double
<span class="lineno"> 175 </span><span class="decl"><span class="nottickedoff">unmetaOpen = upCast . C.unmetaOpen . downCast</span></span>
<span class="lineno"> 176 </span>
<span class="lineno"> 177 </span>-- | Create a normal path from a metapath.
<span class="lineno"> 178 </span>unmetaClosed :: ClosedMetaPath Double -&gt; ClosedPath Double
<span class="lineno"> 179 </span><span class="decl"><span class="nottickedoff">unmetaClosed = upCast . C.unmetaClosed . downCast</span></span>
<span class="lineno"> 180 </span>
<span class="lineno"> 181 </span>-- | `O((n+m)*log(n+m))`, for n segments and m intersections.
<span class="lineno"> 182 </span>-- Union of paths, removing overlap and rounding to the given tolerance.
<span class="lineno"> 183 </span>union :: [ClosedPath Double] -&gt; FillRule -&gt; Double -&gt; [ClosedPath Double]
<span class="lineno"> 184 </span><span class="decl"><span class="nottickedoff">union p fill tol = upCast (C.union (downCast p) (downCast fill) tol)</span></span>
<span class="lineno"> 185 </span>
<span class="lineno"> 186 </span>-- | Find the intersections between two Bezier curves, using the Bezier Clip algorithm.
<span class="lineno"> 187 </span>-- Returns the parameters for both curves.
<span class="lineno"> 188 </span>bezierIntersection :: CubicBezier Double -&gt; CubicBezier Double -&gt; Double -&gt; [(Double, Double)]
<span class="lineno"> 189 </span><span class="decl"><span class="nottickedoff">bezierIntersection a b = C.bezierIntersection (downCast a) (downCast b)</span></span>
<span class="lineno"> 190 </span>
<span class="lineno"> 191 </span>-- | Find the closest value on the bezier to the given point, within tolerance.
<span class="lineno"> 192 </span>-- Return the first value found.
<span class="lineno"> 193 </span>closest :: CubicBezier Double -&gt; V2 Double -&gt; Double -&gt; Double
<span class="lineno"> 194 </span><span class="decl"><span class="nottickedoff">closest c p = C.closest (downCast c) (downCast p)</span></span>
<span class="lineno"> 195 </span>
<span class="lineno"> 196 </span>-- | Return the closed path as a list of curves.
<span class="lineno"> 197 </span>closedPathCurves :: Fractional a =&gt; ClosedPath a -&gt; [CubicBezier a]
<span class="lineno"> 198 </span><span class="decl"><span class="istickedoff">closedPathCurves = upCast . C.closedPathCurves . downCast</span></span>
<span class="lineno"> 199 </span>
<span class="lineno"> 200 </span>-- | Return the open path as a list of curves.
<span class="lineno"> 201 </span>openPathCurves :: Fractional a =&gt; OpenPath a -&gt; [CubicBezier a]
<span class="lineno"> 202 </span><span class="decl"><span class="nottickedoff">openPathCurves = upCast . C.openPathCurves . downCast</span></span>
<span class="lineno"> 203 </span>
<span class="lineno"> 204 </span>-- | Make an open path from a list of curves. The last control point of each curve is ignored.
<span class="lineno"> 205 </span>curvesToClosed :: [CubicBezier a] -&gt; ClosedPath a
<span class="lineno"> 206 </span><span class="decl"><span class="nottickedoff">curvesToClosed = upCast . C.curvesToClosed . downCast</span></span>
<span class="lineno"> 207 </span>
<span class="lineno"> 208 </span>-- | Interpolate between two vectors.
<span class="lineno"> 209 </span>interpolateVector :: Num a =&gt; V2 a -&gt; V2 a -&gt; a -&gt; V2 a
<span class="lineno"> 210 </span><span class="decl"><span class="nottickedoff">interpolateVector a b p = upCast $ C.interpolateVector (downCast a) (downCast b) p</span></span>
<span class="lineno"> 211 </span>
<span class="lineno"> 212 </span>-- | Distance between two vectors.
<span class="lineno"> 213 </span>vectorDistance :: Floating a =&gt; V2 a -&gt; V2 a -&gt; a
<span class="lineno"> 214 </span><span class="decl"><span class="nottickedoff">vectorDistance a b = C.vectorDistance (downCast a) (downCast b)</span></span>
<span class="lineno"> 215 </span>
<span class="lineno"> 216 </span>-- | Find inflection points on the curve.
<span class="lineno"> 217 </span>findBezierInflection :: CubicBezier Double -&gt; [Double]
<span class="lineno"> 218 </span><span class="decl"><span class="nottickedoff">findBezierInflection = C.findBezierInflection . downCast</span></span>
<span class="lineno"> 219 </span>
<span class="lineno"> 220 </span>-- | Find the cusps of a bezier.
<span class="lineno"> 221 </span>findBezierCusp :: CubicBezier Double -&gt; [Double]
<span class="lineno"> 222 </span><span class="decl"><span class="nottickedoff">findBezierCusp = C.findBezierCusp . downCast</span></span>
<span class="lineno"> 223 </span>
<span class="lineno"> 224 </span>------------------------------------------------------------
<span class="lineno"> 225 </span>-- Instances
<span class="lineno"> 226 </span>
<span class="lineno"> 227 </span>instance C.GenericBezier QuadBezier where
<span class="lineno"> 228 </span> <span class="decl"><span class="nottickedoff">degree = C.degree . downCast</span></span>
<span class="lineno"> 229 </span> <span class="decl"><span class="istickedoff">toVector = C.toVector . downCast</span></span>
<span class="lineno"> 230 </span> <span class="decl"><span class="nottickedoff">unsafeFromVector = upCast . C.unsafeFromVector</span></span>
<span class="lineno"> 231 </span>
<span class="lineno"> 232 </span>instance C.GenericBezier CubicBezier where
<span class="lineno"> 233 </span> <span class="decl"><span class="nottickedoff">degree = C.degree . downCast</span></span>
<span class="lineno"> 234 </span> <span class="decl"><span class="istickedoff">toVector = C.toVector . downCast</span></span>
<span class="lineno"> 235 </span> <span class="decl"><span class="istickedoff">unsafeFromVector = upCast . C.unsafeFromVector</span></span>
<span class="lineno"> 236 </span>
<span class="lineno"> 237 </span>instance C.GenericBezier AnyBezier where
<span class="lineno"> 238 </span> <span class="decl"><span class="nottickedoff">degree = C.degree . downCast</span></span>
<span class="lineno"> 239 </span> <span class="decl"><span class="istickedoff">toVector = C.toVector . downCast</span></span>
<span class="lineno"> 240 </span> <span class="decl"><span class="istickedoff">unsafeFromVector = upCast . C.unsafeFromVector</span></span>
<span class="lineno"> 241 </span>
<span class="lineno"> 242 </span>------------------------------------------------------------
<span class="lineno"> 243 </span>-- Casting
<span class="lineno"> 244 </span>
<span class="lineno"> 245 </span>class Cast a b | a -&gt; b, b -&gt; a where
<span class="lineno"> 246 </span> downCast :: a -&gt; b
<span class="lineno"> 247 </span> upCast :: b -&gt; a
<span class="lineno"> 248 </span>
<span class="lineno"> 249 </span>instance Cast a b =&gt; Cast [a] [b] where
<span class="lineno"> 250 </span> <span class="decl"><span class="nottickedoff">downCast = map downCast</span></span>
<span class="lineno"> 251 </span> <span class="decl"><span class="istickedoff">upCast = map upCast</span></span>
<span class="lineno"> 252 </span>
<span class="lineno"> 253 </span>instance (Cast a a', Cast b b') =&gt; Cast (a,b) (a',b') where
<span class="lineno"> 254 </span> <span class="decl"><span class="nottickedoff">downCast (a, b) = (downCast a, downCast b)</span></span>
<span class="lineno"> 255 </span> <span class="decl"><span class="nottickedoff">upCast (a, b) = (upCast a, upCast b)</span></span>
<span class="lineno"> 256 </span>
<span class="lineno"> 257 </span>instance Cast (V2 a) (C.Point a) where
<span class="lineno"> 258 </span> <span class="decl"><span class="istickedoff">downCast (V2 a b) = C.Point a b</span></span>
<span class="lineno"> 259 </span> <span class="decl"><span class="istickedoff">upCast (C.Point a b) = V2 a b</span></span>
<span class="lineno"> 260 </span>
<span class="lineno"> 261 </span>instance Cast FillRule C.FillRule where
<span class="lineno"> 262 </span> <span class="decl"><span class="nottickedoff">downCast FillEvenOdd = C.EvenOdd</span>
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="nottickedoff">downCast FillNonZero = C.NonZero</span></span>
<span class="lineno"> 264 </span> <span class="decl"><span class="nottickedoff">upCast C.EvenOdd = FillEvenOdd</span>
<span class="lineno"> 265 </span><span class="spaces"> </span><span class="nottickedoff">upCast C.NonZero = FillNonZero</span></span>
<span class="lineno"> 266 </span>
<span class="lineno"> 267 </span>instance Cast (CubicBezier a) (C.CubicBezier a) where
<span class="lineno"> 268 </span> <span class="decl"><span class="istickedoff">downCast (CubicBezier a b c d) = C.CubicBezier</span>
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="istickedoff">(downCast a) (downCast b) (downCast c) (downCast d)</span></span>
<span class="lineno"> 270 </span> <span class="decl"><span class="istickedoff">upCast (C.CubicBezier a b c d) = CubicBezier</span>
<span class="lineno"> 271 </span><span class="spaces"> </span><span class="istickedoff">(upCast a) (upCast b) (upCast c) (upCast d)</span></span>
<span class="lineno"> 272 </span>
<span class="lineno"> 273 </span>instance Cast (QuadBezier a) (C.QuadBezier a) where
<span class="lineno"> 274 </span> <span class="decl"><span class="istickedoff">downCast (QuadBezier a b c) = C.QuadBezier</span>
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="istickedoff">(downCast a) (downCast b) (downCast c)</span></span>
<span class="lineno"> 276 </span> <span class="decl"><span class="nottickedoff">upCast (C.QuadBezier a b c)= QuadBezier</span>
<span class="lineno"> 277 </span><span class="spaces"> </span><span class="nottickedoff">(upCast a) (upCast b) (upCast c)</span></span>
<span class="lineno"> 278 </span>
<span class="lineno"> 279 </span>instance V.Unbox a =&gt; Cast (AnyBezier a) (C.AnyBezier a) where
<span class="lineno"> 280 </span> <span class="decl"><span class="istickedoff">downCast (AnyBezier arr) = C.AnyBezier $</span>
<span class="lineno"> 281 </span><span class="spaces"> </span><span class="istickedoff">V.map (\(V2 a b) -&gt; (a,b)) arr</span></span>
<span class="lineno"> 282 </span> <span class="decl"><span class="istickedoff">upCast (C.AnyBezier arr) = AnyBezier $</span>
<span class="lineno"> 283 </span><span class="spaces"> </span><span class="istickedoff">V.map (uncurry V2) arr</span></span>
<span class="lineno"> 284 </span>
<span class="lineno"> 285 </span>instance Cast (MetaNodeType a) (C.MetaNodeType a) where
<span class="lineno"> 286 </span> <span class="decl"><span class="nottickedoff">downCast Open = C.Open</span>
<span class="lineno"> 287 </span><span class="spaces"> </span><span class="nottickedoff">downCast (Curl gamma) = C.Curl gamma</span>
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="nottickedoff">downCast (Direction dir) = C.Direction (downCast dir)</span></span>
<span class="lineno"> 289 </span> <span class="decl"><span class="nottickedoff">upCast C.Open = Open</span>
<span class="lineno"> 290 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.Curl gamma) = Curl gamma</span>
<span class="lineno"> 291 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.Direction dir) = Direction (upCast dir)</span></span>
<span class="lineno"> 292 </span>
<span class="lineno"> 293 </span>instance Cast (Tension a) (C.Tension a) where
<span class="lineno"> 294 </span> <span class="decl"><span class="nottickedoff">downCast (Tension v) = C.Tension v</span>
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="nottickedoff">downCast (TensionAtLeast v) = C.TensionAtLeast v</span></span>
<span class="lineno"> 296 </span> <span class="decl"><span class="nottickedoff">upCast (C.Tension v) = Tension v</span>
<span class="lineno"> 297 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.TensionAtLeast v) = TensionAtLeast v</span></span>
<span class="lineno"> 298 </span>
<span class="lineno"> 299 </span>instance Cast (MetaJoin a) (C.MetaJoin a) where
<span class="lineno"> 300 </span> <span class="decl"><span class="nottickedoff">downCast (MetaJoin tyL tL tR tyR) =</span>
<span class="lineno"> 301 </span><span class="spaces"> </span><span class="nottickedoff">C.MetaJoin (downCast tyL) (downCast tL) (downCast tR) (downCast tyR)</span>
<span class="lineno"> 302 </span><span class="spaces"> </span><span class="nottickedoff">downCast (Controls p1 p2) = C.Controls (downCast p1) (downCast p2)</span></span>
<span class="lineno"> 303 </span> <span class="decl"><span class="nottickedoff">upCast (C.MetaJoin tyL tL tR tyR) =</span>
<span class="lineno"> 304 </span><span class="spaces"> </span><span class="nottickedoff">MetaJoin (upCast tyL) (upCast tL) (upCast tR) (upCast tyR)</span>
<span class="lineno"> 305 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.Controls p1 p2) = Controls (upCast p1) (upCast p2)</span></span>
<span class="lineno"> 306 </span>
<span class="lineno"> 307 </span>instance Cast (PathJoin a) (C.PathJoin a) where
<span class="lineno"> 308 </span> <span class="decl"><span class="istickedoff">downCast JoinLine = C.JoinLine</span>
<span class="lineno"> 309 </span><span class="spaces"> </span><span class="istickedoff">downCast (JoinCurve a b) = C.JoinCurve (downCast a) (downCast b)</span></span>
<span class="lineno"> 310 </span> <span class="decl"><span class="nottickedoff">upCast C.JoinLine = JoinLine</span>
<span class="lineno"> 311 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.JoinCurve a b) = JoinCurve (upCast a) (upCast b)</span></span>
<span class="lineno"> 312 </span>
<span class="lineno"> 313 </span>instance Cast (OpenMetaPath a) (C.OpenMetaPath a) where
<span class="lineno"> 314 </span> <span class="decl"><span class="nottickedoff">downCast (OpenMetaPath lst end) = C.OpenMetaPath</span>
<span class="lineno"> 315 </span><span class="spaces"> </span><span class="nottickedoff">[ (downCast p, downCast j)</span>
<span class="lineno"> 316 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ] (downCast end)</span></span>
<span class="lineno"> 317 </span> <span class="decl"><span class="nottickedoff">upCast (C.OpenMetaPath lst end) = OpenMetaPath</span>
<span class="lineno"> 318 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
<span class="lineno"> 319 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ] (upCast end)</span></span>
<span class="lineno"> 320 </span>
<span class="lineno"> 321 </span>instance Cast (ClosedMetaPath a) (C.ClosedMetaPath a) where
<span class="lineno"> 322 </span> <span class="decl"><span class="nottickedoff">downCast (ClosedMetaPath lst) = C.ClosedMetaPath</span>
<span class="lineno"> 323 </span><span class="spaces"> </span><span class="nottickedoff">[ (downCast p, downCast j)</span>
<span class="lineno"> 324 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ]</span></span>
<span class="lineno"> 325 </span> <span class="decl"><span class="nottickedoff">upCast (C.ClosedMetaPath lst) = ClosedMetaPath</span>
<span class="lineno"> 326 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
<span class="lineno"> 327 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ]</span></span>
<span class="lineno"> 328 </span>
<span class="lineno"> 329 </span>instance Cast (OpenPath a) (C.OpenPath a) where
<span class="lineno"> 330 </span> <span class="decl"><span class="nottickedoff">downCast (OpenPath lst end) = C.OpenPath</span>
<span class="lineno"> 331 </span><span class="spaces"> </span><span class="nottickedoff">[ (downCast p, downCast j)</span>
<span class="lineno"> 332 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ] (downCast end)</span></span>
<span class="lineno"> 333 </span> <span class="decl"><span class="nottickedoff">upCast (C.OpenPath lst end) = OpenPath</span>
<span class="lineno"> 334 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
<span class="lineno"> 335 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ] (upCast end)</span></span>
<span class="lineno"> 336 </span>
<span class="lineno"> 337 </span>instance Cast (ClosedPath a) (C.ClosedPath a) where
<span class="lineno"> 338 </span> <span class="decl"><span class="istickedoff">downCast (ClosedPath lst) = C.ClosedPath</span>
<span class="lineno"> 339 </span><span class="spaces"> </span><span class="istickedoff">[ (downCast p, downCast j)</span>
<span class="lineno"> 340 </span><span class="spaces"> </span><span class="istickedoff">| (p, j) &lt;- lst ]</span></span>
<span class="lineno"> 341 </span> <span class="decl"><span class="nottickedoff">upCast (C.ClosedPath lst) = ClosedPath</span>
<span class="lineno"> 342 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
<span class="lineno"> 343 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ]</span></span>
<span class="lineno"> 14 </span>-}
<span class="lineno"> 15 </span>module Geom2D.CubicBezier.Linear
<span class="lineno"> 16 </span> ( AnyBezier(..)
<span class="lineno"> 17 </span> , CubicBezier(..)
<span class="lineno"> 18 </span> , QuadBezier(..)
<span class="lineno"> 19 </span> , OpenPath(..)
<span class="lineno"> 20 </span> , ClosedPath(..)
<span class="lineno"> 21 </span> , PathJoin(..)
<span class="lineno"> 22 </span> , ClosedMetaPath(..)
<span class="lineno"> 23 </span> , OpenMetaPath(..)
<span class="lineno"> 24 </span> , MetaJoin(..)
<span class="lineno"> 25 </span> , MetaNodeType(..)
<span class="lineno"> 26 </span> , FillRule(..)
<span class="lineno"> 27 </span> , Tension(..)
<span class="lineno"> 28 </span> , quadToCubic
<span class="lineno"> 29 </span> , arcLength
<span class="lineno"> 30 </span> , arcLengthParam
<span class="lineno"> 31 </span> , C.splitBezier
<span class="lineno"> 32 </span> , colinear
<span class="lineno"> 33 </span> , evalBezier
<span class="lineno"> 34 </span> , evalBezierDeriv
<span class="lineno"> 35 </span> , bezierHoriz
<span class="lineno"> 36 </span> , bezierVert
<span class="lineno"> 37 </span> , C.bezierSubsegment
<span class="lineno"> 38 </span> , C.reorient
<span class="lineno"> 39 </span> , closedPathCurves
<span class="lineno"> 40 </span> , openPathCurves
<span class="lineno"> 41 </span> , curvesToClosed
<span class="lineno"> 42 </span> , closest
<span class="lineno"> 43 </span> , unmetaOpen
<span class="lineno"> 44 </span> , unmetaClosed
<span class="lineno"> 45 </span> , union
<span class="lineno"> 46 </span> , bezierIntersection
<span class="lineno"> 47 </span> , interpolateVector
<span class="lineno"> 48 </span> , vectorDistance
<span class="lineno"> 49 </span> , findBezierInflection
<span class="lineno"> 50 </span> , findBezierCusp
<span class="lineno"> 51 </span> ) where
<span class="lineno"> 52 </span>
<span class="lineno"> 53 </span>import qualified Data.Vector.Unboxed as V
<span class="lineno"> 54 </span>import qualified Geom2D.CubicBezier as C
<span class="lineno"> 55 </span>import Graphics.SvgTree (FillRule (..))
<span class="lineno"> 56 </span>import Linear.V2
<span class="lineno"> 57 </span>
<span class="lineno"> 58 </span>------------------------------------------------------------
<span class="lineno"> 59 </span>-- Data types
<span class="lineno"> 60 </span>
<span class="lineno"> 61 </span>-- | A bezier curve of any degree.
<span class="lineno"> 62 </span>newtype AnyBezier a = AnyBezier (V.Vector (V2 a))
<span class="lineno"> 63 </span>
<span class="lineno"> 64 </span>-- | A cubic bezier curve.
<span class="lineno"> 65 </span>data CubicBezier a = CubicBezier
<span class="lineno"> 66 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC0</span></span></span> :: !(V2 a)
<span class="lineno"> 67 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC1</span></span></span> :: !(V2 a)
<span class="lineno"> 68 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC2</span></span></span> :: !(V2 a)
<span class="lineno"> 69 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">cubicC3</span></span></span> :: !(V2 a)
<span class="lineno"> 70 </span> } deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 71 </span>
<span class="lineno"> 72 </span>-- | A quadratic bezier curve.
<span class="lineno"> 73 </span>data QuadBezier a = QuadBezier
<span class="lineno"> 74 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">quadC0</span></span></span> :: !(V2 a)
<span class="lineno"> 75 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">quadC1</span></span></span> :: !(V2 a)
<span class="lineno"> 76 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">quadC2</span></span></span> :: !(V2 a)
<span class="lineno"> 77 </span> } deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 78 </span>
<span class="lineno"> 79 </span>-- | Open cubicbezier path.
<span class="lineno"> 80 </span>data OpenPath a = OpenPath [(V2 a, PathJoin a)] (V2 a)
<span class="lineno"> 81 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 82 </span>
<span class="lineno"> 83 </span>-- | Closed cubicbezier path.
<span class="lineno"> 84 </span>newtype ClosedPath a = ClosedPath [(V2 a, PathJoin a)]
<span class="lineno"> 85 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Eq</span></span></span></span>)
<span class="lineno"> 86 </span>
<span class="lineno"> 87 </span>-- | Join two points with either a straight line or a bezier
<span class="lineno"> 88 </span>-- curve with two control points.
<span class="lineno"> 89 </span>data PathJoin a
<span class="lineno"> 90 </span> = JoinLine
<span class="lineno"> 91 </span> | JoinCurve (V2 a) (V2 a)
<span class="lineno"> 92 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 93 </span>
<span class="lineno"> 94 </span>-- | Closed meta path.
<span class="lineno"> 95 </span>newtype ClosedMetaPath a = ClosedMetaPath [(V2 a, MetaJoin a)]
<span class="lineno"> 96 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Eq</span></span></span></span>)
<span class="lineno"> 97 </span>
<span class="lineno"> 98 </span>-- | Open meta path
<span class="lineno"> 99 </span>data OpenMetaPath a = OpenMetaPath [(V2 a, MetaJoin a)] (V2 a)
<span class="lineno"> 100 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 101 </span>
<span class="lineno"> 102 </span>-- | The tension value specifies how /tense/ the curve is.
<span class="lineno"> 103 </span>-- A higher value means the curve approaches a line segment,
<span class="lineno"> 104 </span>-- while a lower value means the curve is more round. Metafont
<span class="lineno"> 105 </span>-- doesn't allow values below 3/4.
<span class="lineno"> 106 </span>data Tension a
<span class="lineno"> 107 </span> = Tension
<span class="lineno"> 108 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">tensionValue</span></span></span> :: a }
<span class="lineno"> 109 </span> | TensionAtLeast -- ^ Like Tension, but keep the segment inside the
<span class="lineno"> 110 </span> -- bounding triangle defined by the control points,
<span class="lineno"> 111 </span> -- if there is one.
<span class="lineno"> 112 </span> { tensionValue :: a }
<span class="lineno"> 113 </span> deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Functor</span></span></span></span>, <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Foldable</span></span></span></span></span></span>, <span class="decl"><span class="nottickedoff">Traversable</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>, <span class="decl"><span class="nottickedoff">Show</span></span>)
<span class="lineno"> 114 </span>
<span class="lineno"> 115 </span>-- | Join two meta points with either a bezier curve or tension
<span class="lineno"> 116 </span>-- contraints.
<span class="lineno"> 117 </span>data MetaJoin a
<span class="lineno"> 118 </span> = MetaJoin
<span class="lineno"> 119 </span> { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">metaTypeL</span></span></span> :: MetaNodeType a
<span class="lineno"> 120 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">tensionL</span></span></span> :: Tension a
<span class="lineno"> 121 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">tensionR</span></span></span> :: Tension a
<span class="lineno"> 122 </span> , <span class="nottickedoff"><span class="decl"><span class="nottickedoff">metaTypeR</span></span></span> :: MetaNodeType a
<span class="lineno"> 123 </span> }
<span class="lineno"> 124 </span> | Controls (V2 a) (V2 a)
<span class="lineno"> 125 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 126 </span>
<span class="lineno"> 127 </span>-- | Node constraint type.
<span class="lineno"> 128 </span>data MetaNodeType a
<span class="lineno"> 129 </span> = Open
<span class="lineno"> 130 </span> | Curl { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">curlgamma</span></span></span> :: a }
<span class="lineno"> 131 </span> | Direction { <span class="nottickedoff"><span class="decl"><span class="nottickedoff">nodedir</span></span></span> :: V2 a }
<span class="lineno"> 132 </span> deriving (<span class="decl"><span class="nottickedoff">Show</span></span>, <span class="decl"><span class="nottickedoff">Eq</span></span>)
<span class="lineno"> 133 </span>
<span class="lineno"> 134 </span>------------------------------------------------------------
<span class="lineno"> 135 </span>-- Methods
<span class="lineno"> 136 </span>
<span class="lineno"> 137 </span>-- | Convert a quadratic bezier to a cubic bezier.
<span class="lineno"> 138 </span>quadToCubic :: Fractional a =&gt; QuadBezier a -&gt; CubicBezier a
<span class="lineno"> 139 </span><span class="decl"><span class="istickedoff">quadToCubic = upCast . C.quadToCubic . downCast</span></span>
<span class="lineno"> 140 </span>
<span class="lineno"> 141 </span>-- | @arcLength c t tol@ finds the arclength of the bezier @c@ at @t@,
<span class="lineno"> 142 </span>-- within given tolerance @tol@.
<span class="lineno"> 143 </span>arcLength :: CubicBezier Double -&gt; Double -&gt; Double -&gt; Double
<span class="lineno"> 144 </span><span class="decl"><span class="istickedoff">arcLength bezier = C.arcLength (downCast bezier)</span></span>
<span class="lineno"> 145 </span>
<span class="lineno"> 146 </span>-- | @arcLengthParam c len tol@ finds the parameter where the curve @c@
<span class="lineno"> 147 </span>-- has the arclength @len@, within tolerance @tol@.
<span class="lineno"> 148 </span>arcLengthParam :: CubicBezier Double -&gt; Double -&gt; Double -&gt; Double
<span class="lineno"> 149 </span><span class="decl"><span class="nottickedoff">arcLengthParam bezier = C.arcLengthParam (downCast bezier)</span></span>
<span class="lineno"> 150 </span>
<span class="lineno"> 151 </span>-- | Return @False@ if some points fall outside a line with a thickness of the given tolerance.
<span class="lineno"> 152 </span>colinear :: CubicBezier Double -&gt; Double -&gt; Bool
<span class="lineno"> 153 </span><span class="decl"><span class="istickedoff">colinear bezier = C.colinear (downCast bezier)</span></span>
<span class="lineno"> 154 </span>
<span class="lineno"> 155 </span>-- | Calculate a value on the bezier curve.
<span class="lineno"> 156 </span>evalBezier :: (C.GenericBezier b, V.Unbox a, Fractional a) =&gt; b a -&gt; a -&gt; V2 a
<span class="lineno"> 157 </span><span class="decl"><span class="istickedoff">evalBezier c p = upCast $ C.evalBezier c p</span></span>
<span class="lineno"> 158 </span>
<span class="lineno"> 159 </span>-- | Calculate a value and the first derivative on the curve.
<span class="lineno"> 160 </span>evalBezierDeriv :: (V.Unbox a, Fractional a,C.GenericBezier b) =&gt; b a -&gt; a -&gt; (V2 a, V2 a)
<span class="lineno"> 161 </span><span class="decl"><span class="nottickedoff">evalBezierDeriv c p = upCast $ C.evalBezierDeriv c p</span></span>
<span class="lineno"> 162 </span>
<span class="lineno"> 163 </span>-- | Find the parameter where the bezier curve is horizontal.
<span class="lineno"> 164 </span>bezierHoriz :: CubicBezier Double -&gt; [Double]
<span class="lineno"> 165 </span><span class="decl"><span class="nottickedoff">bezierHoriz = C.bezierHoriz . downCast</span></span>
<span class="lineno"> 166 </span>
<span class="lineno"> 167 </span>-- | Find the parameter where the bezier curve is vertical.
<span class="lineno"> 168 </span>bezierVert :: CubicBezier Double -&gt; [Double]
<span class="lineno"> 169 </span><span class="decl"><span class="nottickedoff">bezierVert = C.bezierVert . downCast</span></span>
<span class="lineno"> 170 </span>
<span class="lineno"> 171 </span>-- | Create a normal path from a metapath.
<span class="lineno"> 172 </span>unmetaOpen :: OpenMetaPath Double -&gt; OpenPath Double
<span class="lineno"> 173 </span><span class="decl"><span class="nottickedoff">unmetaOpen = upCast . C.unmetaOpen . downCast</span></span>
<span class="lineno"> 174 </span>
<span class="lineno"> 175 </span>-- | Create a normal path from a metapath.
<span class="lineno"> 176 </span>unmetaClosed :: ClosedMetaPath Double -&gt; ClosedPath Double
<span class="lineno"> 177 </span><span class="decl"><span class="nottickedoff">unmetaClosed = upCast . C.unmetaClosed . downCast</span></span>
<span class="lineno"> 178 </span>
<span class="lineno"> 179 </span>-- | `O((n+m)*log(n+m))`, for n segments and m intersections.
<span class="lineno"> 180 </span>-- Union of paths, removing overlap and rounding to the given tolerance.
<span class="lineno"> 181 </span>union :: [ClosedPath Double] -&gt; FillRule -&gt; Double -&gt; [ClosedPath Double]
<span class="lineno"> 182 </span><span class="decl"><span class="nottickedoff">union p fill tol = upCast (C.union (downCast p) (downCast fill) tol)</span></span>
<span class="lineno"> 183 </span>
<span class="lineno"> 184 </span>-- | Find the intersections between two Bezier curves, using the Bezier Clip algorithm.
<span class="lineno"> 185 </span>-- Returns the parameters for both curves.
<span class="lineno"> 186 </span>bezierIntersection :: CubicBezier Double -&gt; CubicBezier Double -&gt; Double -&gt; [(Double, Double)]
<span class="lineno"> 187 </span><span class="decl"><span class="nottickedoff">bezierIntersection a b = C.bezierIntersection (downCast a) (downCast b)</span></span>
<span class="lineno"> 188 </span>
<span class="lineno"> 189 </span>-- | Find the closest value on the bezier to the given point, within tolerance.
<span class="lineno"> 190 </span>-- Return the first value found.
<span class="lineno"> 191 </span>closest :: CubicBezier Double -&gt; V2 Double -&gt; Double -&gt; Double
<span class="lineno"> 192 </span><span class="decl"><span class="nottickedoff">closest c p = C.closest (downCast c) (downCast p)</span></span>
<span class="lineno"> 193 </span>
<span class="lineno"> 194 </span>-- | Return the closed path as a list of curves.
<span class="lineno"> 195 </span>closedPathCurves :: Fractional a =&gt; ClosedPath a -&gt; [CubicBezier a]
<span class="lineno"> 196 </span><span class="decl"><span class="istickedoff">closedPathCurves = upCast . C.closedPathCurves . downCast</span></span>
<span class="lineno"> 197 </span>
<span class="lineno"> 198 </span>-- | Return the open path as a list of curves.
<span class="lineno"> 199 </span>openPathCurves :: Fractional a =&gt; OpenPath a -&gt; [CubicBezier a]
<span class="lineno"> 200 </span><span class="decl"><span class="nottickedoff">openPathCurves = upCast . C.openPathCurves . downCast</span></span>
<span class="lineno"> 201 </span>
<span class="lineno"> 202 </span>-- | Make an open path from a list of curves. The last control point of each curve is ignored.
<span class="lineno"> 203 </span>curvesToClosed :: [CubicBezier a] -&gt; ClosedPath a
<span class="lineno"> 204 </span><span class="decl"><span class="nottickedoff">curvesToClosed = upCast . C.curvesToClosed . downCast</span></span>
<span class="lineno"> 205 </span>
<span class="lineno"> 206 </span>-- | Interpolate between two vectors.
<span class="lineno"> 207 </span>interpolateVector :: Num a =&gt; V2 a -&gt; V2 a -&gt; a -&gt; V2 a
<span class="lineno"> 208 </span><span class="decl"><span class="nottickedoff">interpolateVector a b p = upCast $ C.interpolateVector (downCast a) (downCast b) p</span></span>
<span class="lineno"> 209 </span>
<span class="lineno"> 210 </span>-- | Distance between two vectors.
<span class="lineno"> 211 </span>vectorDistance :: Floating a =&gt; V2 a -&gt; V2 a -&gt; a
<span class="lineno"> 212 </span><span class="decl"><span class="nottickedoff">vectorDistance a b = C.vectorDistance (downCast a) (downCast b)</span></span>
<span class="lineno"> 213 </span>
<span class="lineno"> 214 </span>-- | Find inflection points on the curve.
<span class="lineno"> 215 </span>findBezierInflection :: CubicBezier Double -&gt; [Double]
<span class="lineno"> 216 </span><span class="decl"><span class="nottickedoff">findBezierInflection = C.findBezierInflection . downCast</span></span>
<span class="lineno"> 217 </span>
<span class="lineno"> 218 </span>-- | Find the cusps of a bezier.
<span class="lineno"> 219 </span>findBezierCusp :: CubicBezier Double -&gt; [Double]
<span class="lineno"> 220 </span><span class="decl"><span class="nottickedoff">findBezierCusp = C.findBezierCusp . downCast</span></span>
<span class="lineno"> 221 </span>
<span class="lineno"> 222 </span>------------------------------------------------------------
<span class="lineno"> 223 </span>-- Instances
<span class="lineno"> 224 </span>
<span class="lineno"> 225 </span>instance C.GenericBezier QuadBezier where
<span class="lineno"> 226 </span> <span class="decl"><span class="nottickedoff">degree = C.degree . downCast</span></span>
<span class="lineno"> 227 </span> <span class="decl"><span class="istickedoff">toVector = C.toVector . downCast</span></span>
<span class="lineno"> 228 </span> <span class="decl"><span class="nottickedoff">unsafeFromVector = upCast . C.unsafeFromVector</span></span>
<span class="lineno"> 229 </span>
<span class="lineno"> 230 </span>instance C.GenericBezier CubicBezier where
<span class="lineno"> 231 </span> <span class="decl"><span class="nottickedoff">degree = C.degree . downCast</span></span>
<span class="lineno"> 232 </span> <span class="decl"><span class="istickedoff">toVector = C.toVector . downCast</span></span>
<span class="lineno"> 233 </span> <span class="decl"><span class="istickedoff">unsafeFromVector = upCast . C.unsafeFromVector</span></span>
<span class="lineno"> 234 </span>
<span class="lineno"> 235 </span>instance C.GenericBezier AnyBezier where
<span class="lineno"> 236 </span> <span class="decl"><span class="nottickedoff">degree = C.degree . downCast</span></span>
<span class="lineno"> 237 </span> <span class="decl"><span class="istickedoff">toVector = C.toVector . downCast</span></span>
<span class="lineno"> 238 </span> <span class="decl"><span class="istickedoff">unsafeFromVector = upCast . C.unsafeFromVector</span></span>
<span class="lineno"> 239 </span>
<span class="lineno"> 240 </span>------------------------------------------------------------
<span class="lineno"> 241 </span>-- Casting
<span class="lineno"> 242 </span>
<span class="lineno"> 243 </span>class Cast a b | a -&gt; b, b -&gt; a where
<span class="lineno"> 244 </span> downCast :: a -&gt; b
<span class="lineno"> 245 </span> upCast :: b -&gt; a
<span class="lineno"> 246 </span>
<span class="lineno"> 247 </span>instance Cast a b =&gt; Cast [a] [b] where
<span class="lineno"> 248 </span> <span class="decl"><span class="nottickedoff">downCast = map downCast</span></span>
<span class="lineno"> 249 </span> <span class="decl"><span class="istickedoff">upCast = map upCast</span></span>
<span class="lineno"> 250 </span>
<span class="lineno"> 251 </span>instance (Cast a a', Cast b b') =&gt; Cast (a,b) (a',b') where
<span class="lineno"> 252 </span> <span class="decl"><span class="nottickedoff">downCast (a, b) = (downCast a, downCast b)</span></span>
<span class="lineno"> 253 </span> <span class="decl"><span class="nottickedoff">upCast (a, b) = (upCast a, upCast b)</span></span>
<span class="lineno"> 254 </span>
<span class="lineno"> 255 </span>instance Cast (V2 a) (C.Point a) where
<span class="lineno"> 256 </span> <span class="decl"><span class="istickedoff">downCast (V2 a b) = C.Point a b</span></span>
<span class="lineno"> 257 </span> <span class="decl"><span class="istickedoff">upCast (C.Point a b) = V2 a b</span></span>
<span class="lineno"> 258 </span>
<span class="lineno"> 259 </span>instance Cast FillRule C.FillRule where
<span class="lineno"> 260 </span> <span class="decl"><span class="nottickedoff">downCast FillEvenOdd = C.EvenOdd</span>
<span class="lineno"> 261 </span><span class="spaces"> </span><span class="nottickedoff">downCast FillNonZero = C.NonZero</span></span>
<span class="lineno"> 262 </span> <span class="decl"><span class="nottickedoff">upCast C.EvenOdd = FillEvenOdd</span>
<span class="lineno"> 263 </span><span class="spaces"> </span><span class="nottickedoff">upCast C.NonZero = FillNonZero</span></span>
<span class="lineno"> 264 </span>
<span class="lineno"> 265 </span>instance Cast (CubicBezier a) (C.CubicBezier a) where
<span class="lineno"> 266 </span> <span class="decl"><span class="istickedoff">downCast (CubicBezier a b c d) = C.CubicBezier</span>
<span class="lineno"> 267 </span><span class="spaces"> </span><span class="istickedoff">(downCast a) (downCast b) (downCast c) (downCast d)</span></span>
<span class="lineno"> 268 </span> <span class="decl"><span class="istickedoff">upCast (C.CubicBezier a b c d) = CubicBezier</span>
<span class="lineno"> 269 </span><span class="spaces"> </span><span class="istickedoff">(upCast a) (upCast b) (upCast c) (upCast d)</span></span>
<span class="lineno"> 270 </span>
<span class="lineno"> 271 </span>instance Cast (QuadBezier a) (C.QuadBezier a) where
<span class="lineno"> 272 </span> <span class="decl"><span class="istickedoff">downCast (QuadBezier a b c) = C.QuadBezier</span>
<span class="lineno"> 273 </span><span class="spaces"> </span><span class="istickedoff">(downCast a) (downCast b) (downCast c)</span></span>
<span class="lineno"> 274 </span> <span class="decl"><span class="nottickedoff">upCast (C.QuadBezier a b c)= QuadBezier</span>
<span class="lineno"> 275 </span><span class="spaces"> </span><span class="nottickedoff">(upCast a) (upCast b) (upCast c)</span></span>
<span class="lineno"> 276 </span>
<span class="lineno"> 277 </span>instance V.Unbox a =&gt; Cast (AnyBezier a) (C.AnyBezier a) where
<span class="lineno"> 278 </span> <span class="decl"><span class="istickedoff">downCast (AnyBezier arr) = C.AnyBezier $</span>
<span class="lineno"> 279 </span><span class="spaces"> </span><span class="istickedoff">V.map (\(V2 a b) -&gt; (a,b)) arr</span></span>
<span class="lineno"> 280 </span> <span class="decl"><span class="istickedoff">upCast (C.AnyBezier arr) = AnyBezier $</span>
<span class="lineno"> 281 </span><span class="spaces"> </span><span class="istickedoff">V.map (uncurry V2) arr</span></span>
<span class="lineno"> 282 </span>
<span class="lineno"> 283 </span>instance Cast (MetaNodeType a) (C.MetaNodeType a) where
<span class="lineno"> 284 </span> <span class="decl"><span class="nottickedoff">downCast Open = C.Open</span>
<span class="lineno"> 285 </span><span class="spaces"> </span><span class="nottickedoff">downCast (Curl gamma) = C.Curl gamma</span>
<span class="lineno"> 286 </span><span class="spaces"> </span><span class="nottickedoff">downCast (Direction dir) = C.Direction (downCast dir)</span></span>
<span class="lineno"> 287 </span> <span class="decl"><span class="nottickedoff">upCast C.Open = Open</span>
<span class="lineno"> 288 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.Curl gamma) = Curl gamma</span>
<span class="lineno"> 289 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.Direction dir) = Direction (upCast dir)</span></span>
<span class="lineno"> 290 </span>
<span class="lineno"> 291 </span>instance Cast (Tension a) (C.Tension a) where
<span class="lineno"> 292 </span> <span class="decl"><span class="nottickedoff">downCast (Tension v) = C.Tension v</span>
<span class="lineno"> 293 </span><span class="spaces"> </span><span class="nottickedoff">downCast (TensionAtLeast v) = C.TensionAtLeast v</span></span>
<span class="lineno"> 294 </span> <span class="decl"><span class="nottickedoff">upCast (C.Tension v) = Tension v</span>
<span class="lineno"> 295 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.TensionAtLeast v) = TensionAtLeast v</span></span>
<span class="lineno"> 296 </span>
<span class="lineno"> 297 </span>instance Cast (MetaJoin a) (C.MetaJoin a) where
<span class="lineno"> 298 </span> <span class="decl"><span class="nottickedoff">downCast (MetaJoin tyL tL tR tyR) =</span>
<span class="lineno"> 299 </span><span class="spaces"> </span><span class="nottickedoff">C.MetaJoin (downCast tyL) (downCast tL) (downCast tR) (downCast tyR)</span>
<span class="lineno"> 300 </span><span class="spaces"> </span><span class="nottickedoff">downCast (Controls p1 p2) = C.Controls (downCast p1) (downCast p2)</span></span>
<span class="lineno"> 301 </span> <span class="decl"><span class="nottickedoff">upCast (C.MetaJoin tyL tL tR tyR) =</span>
<span class="lineno"> 302 </span><span class="spaces"> </span><span class="nottickedoff">MetaJoin (upCast tyL) (upCast tL) (upCast tR) (upCast tyR)</span>
<span class="lineno"> 303 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.Controls p1 p2) = Controls (upCast p1) (upCast p2)</span></span>
<span class="lineno"> 304 </span>
<span class="lineno"> 305 </span>instance Cast (PathJoin a) (C.PathJoin a) where
<span class="lineno"> 306 </span> <span class="decl"><span class="istickedoff">downCast JoinLine = C.JoinLine</span>
<span class="lineno"> 307 </span><span class="spaces"> </span><span class="istickedoff">downCast (JoinCurve a b) = C.JoinCurve (downCast a) (downCast b)</span></span>
<span class="lineno"> 308 </span> <span class="decl"><span class="nottickedoff">upCast C.JoinLine = JoinLine</span>
<span class="lineno"> 309 </span><span class="spaces"> </span><span class="nottickedoff">upCast (C.JoinCurve a b) = JoinCurve (upCast a) (upCast b)</span></span>
<span class="lineno"> 310 </span>
<span class="lineno"> 311 </span>instance Cast (OpenMetaPath a) (C.OpenMetaPath a) where
<span class="lineno"> 312 </span> <span class="decl"><span class="nottickedoff">downCast (OpenMetaPath lst end) = C.OpenMetaPath</span>
<span class="lineno"> 313 </span><span class="spaces"> </span><span class="nottickedoff">[ (downCast p, downCast j)</span>
<span class="lineno"> 314 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ] (downCast end)</span></span>
<span class="lineno"> 315 </span> <span class="decl"><span class="nottickedoff">upCast (C.OpenMetaPath lst end) = OpenMetaPath</span>
<span class="lineno"> 316 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
<span class="lineno"> 317 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ] (upCast end)</span></span>
<span class="lineno"> 318 </span>
<span class="lineno"> 319 </span>instance Cast (ClosedMetaPath a) (C.ClosedMetaPath a) where
<span class="lineno"> 320 </span> <span class="decl"><span class="nottickedoff">downCast (ClosedMetaPath lst) = C.ClosedMetaPath</span>
<span class="lineno"> 321 </span><span class="spaces"> </span><span class="nottickedoff">[ (downCast p, downCast j)</span>
<span class="lineno"> 322 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ]</span></span>
<span class="lineno"> 323 </span> <span class="decl"><span class="nottickedoff">upCast (C.ClosedMetaPath lst) = ClosedMetaPath</span>
<span class="lineno"> 324 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
<span class="lineno"> 325 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ]</span></span>
<span class="lineno"> 326 </span>
<span class="lineno"> 327 </span>instance Cast (OpenPath a) (C.OpenPath a) where
<span class="lineno"> 328 </span> <span class="decl"><span class="nottickedoff">downCast (OpenPath lst end) = C.OpenPath</span>
<span class="lineno"> 329 </span><span class="spaces"> </span><span class="nottickedoff">[ (downCast p, downCast j)</span>
<span class="lineno"> 330 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ] (downCast end)</span></span>
<span class="lineno"> 331 </span> <span class="decl"><span class="nottickedoff">upCast (C.OpenPath lst end) = OpenPath</span>
<span class="lineno"> 332 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
<span class="lineno"> 333 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ] (upCast end)</span></span>
<span class="lineno"> 334 </span>
<span class="lineno"> 335 </span>instance Cast (ClosedPath a) (C.ClosedPath a) where
<span class="lineno"> 336 </span> <span class="decl"><span class="istickedoff">downCast (ClosedPath lst) = C.ClosedPath</span>
<span class="lineno"> 337 </span><span class="spaces"> </span><span class="istickedoff">[ (downCast p, downCast j)</span>
<span class="lineno"> 338 </span><span class="spaces"> </span><span class="istickedoff">| (p, j) &lt;- lst ]</span></span>
<span class="lineno"> 339 </span> <span class="decl"><span class="nottickedoff">upCast (C.ClosedPath lst) = ClosedPath</span>
<span class="lineno"> 340 </span><span class="spaces"> </span><span class="nottickedoff">[ (upCast p, upCast j)</span>
<span class="lineno"> 341 </span><span class="spaces"> </span><span class="nottickedoff">| (p, j) &lt;- lst ]</span></span>
</pre>
</body>

View file

@ -17,229 +17,228 @@ span.spaces { background: white }
<span class="decl"><span class="nottickedoff">never executed</span> <span class="tickonlytrue">always true</span> <span class="tickonlyfalse">always false</span></span>
</pre>
<pre>
<span class="lineno"> 1 </span>{-# LANGUAGE MultiWayIf #-}
<span class="lineno"> 2 </span>{-# LANGUAGE RecordWildCards #-}
<span class="lineno"> 3 </span>module Reanimate.Driver
<span class="lineno"> 4 </span> ( reanimate
<span class="lineno"> 5 </span> )
<span class="lineno"> 6 </span>where
<span class="lineno"> 7 </span>
<span class="lineno"> 8 </span>import Control.Applicative ((&lt;|&gt;))
<span class="lineno"> 9 </span>import Control.Monad
<span class="lineno"> 10 </span>import Data.Maybe
<span class="lineno"> 11 </span>import Data.Either
<span class="lineno"> 12 </span>import Reanimate.Animation (Animation)
<span class="lineno"> 13 </span>import Reanimate.Driver.Check
<span class="lineno"> 14 </span>import Reanimate.Driver.CLI
<span class="lineno"> 15 </span>import Reanimate.Driver.Compile
<span class="lineno"> 16 </span>import Reanimate.Driver.Server
<span class="lineno"> 17 </span>import Reanimate.Parameters
<span class="lineno"> 18 </span>import Reanimate.Render (render, renderSnippets, renderSvgs,
<span class="lineno"> 19 </span> selectRaster)
<span class="lineno"> 20 </span>import System.Directory
<span class="lineno"> 21 </span>import System.Exit
<span class="lineno"> 22 </span>import System.FilePath
<span class="lineno"> 23 </span>import System.IO
<span class="lineno"> 24 </span>import Text.Printf
<span class="lineno"> 25 </span>
<span class="lineno"> 26 </span>presetFormat :: Preset -&gt; Format
<span class="lineno"> 27 </span><span class="decl"><span class="nottickedoff">presetFormat Youtube = RenderMp4</span>
<span class="lineno"> 28 </span><span class="spaces"></span><span class="nottickedoff">presetFormat ExampleGif = RenderGif</span>
<span class="lineno"> 29 </span><span class="spaces"></span><span class="nottickedoff">presetFormat Quick = RenderMp4</span>
<span class="lineno"> 30 </span><span class="spaces"></span><span class="nottickedoff">presetFormat MediumQ = RenderMp4</span>
<span class="lineno"> 31 </span><span class="spaces"></span><span class="nottickedoff">presetFormat HighQ = RenderMp4</span>
<span class="lineno"> 32 </span><span class="spaces"></span><span class="nottickedoff">presetFormat LowFPS = RenderMp4</span></span>
<span class="lineno"> 33 </span>
<span class="lineno"> 34 </span>presetFPS :: Preset -&gt; FPS
<span class="lineno"> 35 </span><span class="decl"><span class="nottickedoff">presetFPS Youtube = 60</span>
<span class="lineno"> 36 </span><span class="spaces"></span><span class="nottickedoff">presetFPS ExampleGif = 25</span>
<span class="lineno"> 37 </span><span class="spaces"></span><span class="nottickedoff">presetFPS Quick = 15</span>
<span class="lineno"> 38 </span><span class="spaces"></span><span class="nottickedoff">presetFPS MediumQ = 30</span>
<span class="lineno"> 39 </span><span class="spaces"></span><span class="nottickedoff">presetFPS HighQ = 30</span>
<span class="lineno"> 40 </span><span class="spaces"></span><span class="nottickedoff">presetFPS LowFPS = 10</span></span>
<span class="lineno"> 41 </span>
<span class="lineno"> 42 </span>presetWidth :: Preset -&gt; Width
<span class="lineno"> 43 </span><span class="decl"><span class="nottickedoff">presetWidth Youtube = 2560</span>
<span class="lineno"> 44 </span><span class="spaces"></span><span class="nottickedoff">presetWidth ExampleGif = 320</span>
<span class="lineno"> 45 </span><span class="spaces"></span><span class="nottickedoff">presetWidth Quick = 320</span>
<span class="lineno"> 46 </span><span class="spaces"></span><span class="nottickedoff">presetWidth MediumQ = 800</span>
<span class="lineno"> 47 </span><span class="spaces"></span><span class="nottickedoff">presetWidth HighQ = 1920</span>
<span class="lineno"> 48 </span><span class="spaces"></span><span class="nottickedoff">presetWidth LowFPS = presetWidth HighQ</span></span>
<span class="lineno"> 49 </span>
<span class="lineno"> 50 </span>presetHeight :: Preset -&gt; Height
<span class="lineno"> 51 </span><span class="decl"><span class="nottickedoff">presetHeight preset = presetWidth preset * 9 `div` 16</span></span>
<span class="lineno"> 52 </span>
<span class="lineno"> 53 </span>formatFPS :: Format -&gt; FPS
<span class="lineno"> 54 </span><span class="decl"><span class="nottickedoff">formatFPS RenderMp4 = 60</span>
<span class="lineno"> 55 </span><span class="spaces"></span><span class="nottickedoff">formatFPS RenderGif = 25</span>
<span class="lineno"> 56 </span><span class="spaces"></span><span class="nottickedoff">formatFPS RenderWebm = 60</span></span>
<span class="lineno"> 57 </span>
<span class="lineno"> 58 </span>formatWidth :: Format -&gt; Width
<span class="lineno"> 59 </span><span class="decl"><span class="nottickedoff">formatWidth RenderMp4 = 2560</span>
<span class="lineno"> 60 </span><span class="spaces"></span><span class="nottickedoff">formatWidth RenderGif = 320</span>
<span class="lineno"> 61 </span><span class="spaces"></span><span class="nottickedoff">formatWidth RenderWebm = 2560</span></span>
<span class="lineno"> 62 </span>
<span class="lineno"> 63 </span>formatHeight :: Format -&gt; Height
<span class="lineno"> 64 </span><span class="decl"><span class="nottickedoff">formatHeight RenderMp4 = 1440</span>
<span class="lineno"> 65 </span><span class="spaces"></span><span class="nottickedoff">formatHeight RenderGif = 180</span>
<span class="lineno"> 66 </span><span class="spaces"></span><span class="nottickedoff">formatHeight RenderWebm = 1440</span></span>
<span class="lineno"> 67 </span>
<span class="lineno"> 68 </span>formatExtension :: Format -&gt; String
<span class="lineno"> 69 </span><span class="decl"><span class="nottickedoff">formatExtension RenderMp4 = &quot;mp4&quot;</span>
<span class="lineno"> 70 </span><span class="spaces"></span><span class="nottickedoff">formatExtension RenderGif = &quot;gif&quot;</span>
<span class="lineno"> 71 </span><span class="spaces"></span><span class="nottickedoff">formatExtension RenderWebm = &quot;webm&quot;</span></span>
<span class="lineno"> 72 </span>
<span class="lineno"> 73 </span>{-|
<span class="lineno"> 74 </span>Main entry-point for accessing an animation. Creates a program that takes the
<span class="lineno"> 75 </span>following command-line arguments:
<span class="lineno"> 76 </span>
<span class="lineno"> 77 </span>&gt; Usage: PROG [COMMAND]
<span class="lineno"> 78 </span>&gt; This program contains an animation which can either be viewed in a web-browser
<span class="lineno"> 79 </span>&gt; or rendered to disk.
<span class="lineno"> 80 </span>&gt;
<span class="lineno"> 81 </span>&gt; Available options:
<span class="lineno"> 82 </span>&gt; -h,--help Show this help text
<span class="lineno"> 83 </span>&gt;
<span class="lineno"> 84 </span>&gt; Available commands:
<span class="lineno"> 85 </span>&gt; check Run a system's diagnostic and report any missing
<span class="lineno"> 86 </span>&gt; external dependencies.
<span class="lineno"> 87 </span>&gt; view Play animation in browser window.
<span class="lineno"> 88 </span>&gt; render Render animation to file.
<span class="lineno"> 89 </span>
<span class="lineno"> 90 </span>Neither the \'check\' nor the \'view\' command take any additional arguments.
<span class="lineno"> 91 </span>Rendering animation can be controlled with these arguments:
<span class="lineno"> 92 </span>
<span class="lineno"> 93 </span>&gt; Usage: PROG render [-o|--target FILE] [--fps FPS] [-w|--width PIXELS]
<span class="lineno"> 94 </span>&gt; [-h|--height PIXELS] [--compile] [--format FMT]
<span class="lineno"> 95 </span>&gt; [--preset TYPE]
<span class="lineno"> 96 </span>&gt; Render animation to file.
<span class="lineno"> 97 </span>&gt;
<span class="lineno"> 98 </span>&gt; Available options:
<span class="lineno"> 99 </span>&gt; -o,--target FILE Write output to FILE
<span class="lineno"> 100 </span>&gt; --fps FPS Set frames per second.
<span class="lineno"> 101 </span>&gt; -w,--width PIXELS Set video width.
<span class="lineno"> 102 </span>&gt; -h,--height PIXELS Set video height.
<span class="lineno"> 103 </span>&gt; --compile Compile source code before rendering.
<span class="lineno"> 104 </span>&gt; --format FMT Video format: mp4, gif, webm
<span class="lineno"> 105 </span>&gt; --preset TYPE Parameter presets: youtube, gif, quick
<span class="lineno"> 106 </span>&gt; -h,--help Show this help text
<span class="lineno"> 107 </span>-}
<span class="lineno"> 108 </span>reanimate :: Animation -&gt; IO ()
<span class="lineno"> 109 </span><span class="decl"><span class="istickedoff">reanimate animation = do</span>
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="istickedoff">Options {..} &lt;- getDriverOptions</span>
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff">case optsCommand of</span>
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff">Raw {..} -&gt; <span class="nottickedoff">do</span></span>
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setFPS 60</span></span>
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">renderSvgs rawOutputFolder rawFrameOffset rawPrettyPrint animation</span></span>
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff">Test -&gt; do</span>
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff">setNoExternals True</span>
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">-- hSetBinaryMode stdout True</span>
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">renderSnippets animation</span>
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff">Check -&gt; <span class="nottickedoff">checkEnvironment</span></span>
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="istickedoff">View {..} -&gt; <span class="nottickedoff">serve viewVerbose viewGHCPath viewGHCOpts viewOrigin</span></span>
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="istickedoff">Render {..} -&gt; <span class="nottickedoff">do</span></span>
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let fmt =</span></span>
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">guessParameter renderFormat (fmap presetFormat renderPreset)</span></span>
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">$ case renderTarget of</span></span>
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- Format guessed from output</span></span>
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Just target -&gt; case takeExtension target of</span></span>
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">&quot;.mp4&quot; -&gt; RenderMp4</span></span>
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">&quot;.gif&quot; -&gt; RenderGif</span></span>
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">&quot;.webm&quot; -&gt; RenderWebm</span></span>
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -&gt; RenderMp4</span></span>
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- Default to mp4 rendering.</span></span>
<span class="lineno"> 132 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Nothing -&gt; RenderMp4</span></span>
<span class="lineno"> 133 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">target &lt;- case renderTarget of</span></span>
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Nothing -&gt; do</span></span>
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mbSelf &lt;- findOwnSource</span></span>
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let ext = formatExtension fmt</span></span>
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">self = fromMaybe &quot;output&quot; mbSelf</span></span>
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pure $ replaceExtension self ext</span></span>
<span class="lineno"> 140 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Just target -&gt; makeAbsolute target</span></span>
<span class="lineno"> 141 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let</span></span>
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">fps =</span></span>
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">guessParameter renderFPS (fmap presetFPS renderPreset) $ formatFPS fmt</span></span>
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(width, height) = fromMaybe</span></span>
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">( maybe (formatWidth fmt) presetWidth renderPreset</span></span>
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, maybe (formatHeight fmt) presetHeight renderPreset</span></span>
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">)</span></span>
<span class="lineno"> 149 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(userPreferredDimensions renderWidth renderHeight)</span></span>
<span class="lineno"> 150 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">raster &lt;-</span></span>
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">if renderRaster == RasterNone || renderRaster == RasterAuto then do</span></span>
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">svgSupport &lt;- hasFFmpegRSvg</span></span>
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">if isRight svgSupport</span></span>
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">then selectRaster renderRaster</span></span>
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">else do</span></span>
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">raster &lt;- selectRaster RasterAuto</span></span>
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">when (raster == RasterNone) $ do</span></span>
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">hPutStrLn stderr</span></span>
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">&quot;Error: your FFmpeg was built without SVG support and no raster engines \</span></span>
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\are available. Please install either inkscape, imagemagick, or rsvg.&quot;</span></span>
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">exitWith (ExitFailure 1)</span></span>
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">return raster</span></span>
<span class="lineno"> 164 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">else selectRaster renderRaster</span></span>
<span class="lineno"> 165 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">if renderCompile</span></span>
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">then compile $</span></span>
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[ &quot;render&quot;</span></span>
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--fps&quot;</span></span>
<span class="lineno"> 170 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, show fps</span></span>
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--width&quot;</span></span>
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, show width</span></span>
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--height&quot;</span></span>
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, show height</span></span>
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--format&quot;</span></span>
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, showFormat fmt</span></span>
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--raster&quot;</span></span>
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, showRaster raster</span></span>
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--target&quot;</span></span>
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, target</span></span>
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;+RTS&quot;</span></span>
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;-N&quot;</span></span>
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;-RTS&quot;</span></span>
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">] ++ [ &quot;--partial&quot; | renderPartial ]</span></span>
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">else do</span></span>
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setRaster raster</span></span>
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setFPS fps</span></span>
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setWidth width</span></span>
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setHeight height</span></span>
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">printf</span></span>
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">&quot;Animation options:\n\</span></span>
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ fps: %d\n\</span></span>
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ width: %d\n\</span></span>
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ height: %d\n\</span></span>
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ fmt: %s\n\</span></span>
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ target: %s\n\</span></span>
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ raster: %s\n&quot;</span></span>
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">fps</span></span>
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">width</span></span>
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">height</span></span>
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(showFormat fmt)</span></span>
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">target</span></span>
<span class="lineno"> 203 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(show raster)</span></span>
<span class="lineno"> 204 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
<span class="lineno"> 205 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">render animation target raster fmt width height fps renderPartial</span></span></span>
<span class="lineno"> 206 </span>
<span class="lineno"> 207 </span>guessParameter :: Maybe a -&gt; Maybe a -&gt; a -&gt; a
<span class="lineno"> 208 </span><span class="decl"><span class="nottickedoff">guessParameter a b def = fromMaybe def (a &lt;|&gt; b)</span></span>
<span class="lineno"> 1 </span>{-# LANGUAGE RecordWildCards #-}
<span class="lineno"> 2 </span>module Reanimate.Driver
<span class="lineno"> 3 </span> ( reanimate
<span class="lineno"> 4 </span> )
<span class="lineno"> 5 </span>where
<span class="lineno"> 6 </span>
<span class="lineno"> 7 </span>import Control.Applicative ((&lt;|&gt;))
<span class="lineno"> 8 </span>import Control.Monad
<span class="lineno"> 9 </span>import Data.Maybe
<span class="lineno"> 10 </span>import Data.Either
<span class="lineno"> 11 </span>import Reanimate.Animation (Animation)
<span class="lineno"> 12 </span>import Reanimate.Driver.Check
<span class="lineno"> 13 </span>import Reanimate.Driver.CLI
<span class="lineno"> 14 </span>import Reanimate.Driver.Compile
<span class="lineno"> 15 </span>import Reanimate.Driver.Server
<span class="lineno"> 16 </span>import Reanimate.Parameters
<span class="lineno"> 17 </span>import Reanimate.Render (render, renderSnippets, renderSvgs,
<span class="lineno"> 18 </span> selectRaster)
<span class="lineno"> 19 </span>import System.Directory
<span class="lineno"> 20 </span>import System.Exit
<span class="lineno"> 21 </span>import System.FilePath
<span class="lineno"> 22 </span>import System.IO
<span class="lineno"> 23 </span>import Text.Printf
<span class="lineno"> 24 </span>
<span class="lineno"> 25 </span>presetFormat :: Preset -&gt; Format
<span class="lineno"> 26 </span><span class="decl"><span class="nottickedoff">presetFormat Youtube = RenderMp4</span>
<span class="lineno"> 27 </span><span class="spaces"></span><span class="nottickedoff">presetFormat ExampleGif = RenderGif</span>
<span class="lineno"> 28 </span><span class="spaces"></span><span class="nottickedoff">presetFormat Quick = RenderMp4</span>
<span class="lineno"> 29 </span><span class="spaces"></span><span class="nottickedoff">presetFormat MediumQ = RenderMp4</span>
<span class="lineno"> 30 </span><span class="spaces"></span><span class="nottickedoff">presetFormat HighQ = RenderMp4</span>
<span class="lineno"> 31 </span><span class="spaces"></span><span class="nottickedoff">presetFormat LowFPS = RenderMp4</span></span>
<span class="lineno"> 32 </span>
<span class="lineno"> 33 </span>presetFPS :: Preset -&gt; FPS
<span class="lineno"> 34 </span><span class="decl"><span class="nottickedoff">presetFPS Youtube = 60</span>
<span class="lineno"> 35 </span><span class="spaces"></span><span class="nottickedoff">presetFPS ExampleGif = 25</span>
<span class="lineno"> 36 </span><span class="spaces"></span><span class="nottickedoff">presetFPS Quick = 15</span>
<span class="lineno"> 37 </span><span class="spaces"></span><span class="nottickedoff">presetFPS MediumQ = 30</span>
<span class="lineno"> 38 </span><span class="spaces"></span><span class="nottickedoff">presetFPS HighQ = 30</span>
<span class="lineno"> 39 </span><span class="spaces"></span><span class="nottickedoff">presetFPS LowFPS = 10</span></span>
<span class="lineno"> 40 </span>
<span class="lineno"> 41 </span>presetWidth :: Preset -&gt; Width
<span class="lineno"> 42 </span><span class="decl"><span class="nottickedoff">presetWidth Youtube = 2560</span>
<span class="lineno"> 43 </span><span class="spaces"></span><span class="nottickedoff">presetWidth ExampleGif = 320</span>
<span class="lineno"> 44 </span><span class="spaces"></span><span class="nottickedoff">presetWidth Quick = 320</span>
<span class="lineno"> 45 </span><span class="spaces"></span><span class="nottickedoff">presetWidth MediumQ = 800</span>
<span class="lineno"> 46 </span><span class="spaces"></span><span class="nottickedoff">presetWidth HighQ = 1920</span>
<span class="lineno"> 47 </span><span class="spaces"></span><span class="nottickedoff">presetWidth LowFPS = presetWidth HighQ</span></span>
<span class="lineno"> 48 </span>
<span class="lineno"> 49 </span>presetHeight :: Preset -&gt; Height
<span class="lineno"> 50 </span><span class="decl"><span class="nottickedoff">presetHeight preset = presetWidth preset * 9 `div` 16</span></span>
<span class="lineno"> 51 </span>
<span class="lineno"> 52 </span>formatFPS :: Format -&gt; FPS
<span class="lineno"> 53 </span><span class="decl"><span class="nottickedoff">formatFPS RenderMp4 = 60</span>
<span class="lineno"> 54 </span><span class="spaces"></span><span class="nottickedoff">formatFPS RenderGif = 25</span>
<span class="lineno"> 55 </span><span class="spaces"></span><span class="nottickedoff">formatFPS RenderWebm = 60</span></span>
<span class="lineno"> 56 </span>
<span class="lineno"> 57 </span>formatWidth :: Format -&gt; Width
<span class="lineno"> 58 </span><span class="decl"><span class="nottickedoff">formatWidth RenderMp4 = 2560</span>
<span class="lineno"> 59 </span><span class="spaces"></span><span class="nottickedoff">formatWidth RenderGif = 320</span>
<span class="lineno"> 60 </span><span class="spaces"></span><span class="nottickedoff">formatWidth RenderWebm = 2560</span></span>
<span class="lineno"> 61 </span>
<span class="lineno"> 62 </span>formatHeight :: Format -&gt; Height
<span class="lineno"> 63 </span><span class="decl"><span class="nottickedoff">formatHeight RenderMp4 = 1440</span>
<span class="lineno"> 64 </span><span class="spaces"></span><span class="nottickedoff">formatHeight RenderGif = 180</span>
<span class="lineno"> 65 </span><span class="spaces"></span><span class="nottickedoff">formatHeight RenderWebm = 1440</span></span>
<span class="lineno"> 66 </span>
<span class="lineno"> 67 </span>formatExtension :: Format -&gt; String
<span class="lineno"> 68 </span><span class="decl"><span class="nottickedoff">formatExtension RenderMp4 = &quot;mp4&quot;</span>
<span class="lineno"> 69 </span><span class="spaces"></span><span class="nottickedoff">formatExtension RenderGif = &quot;gif&quot;</span>
<span class="lineno"> 70 </span><span class="spaces"></span><span class="nottickedoff">formatExtension RenderWebm = &quot;webm&quot;</span></span>
<span class="lineno"> 71 </span>
<span class="lineno"> 72 </span>{-|
<span class="lineno"> 73 </span>Main entry-point for accessing an animation. Creates a program that takes the
<span class="lineno"> 74 </span>following command-line arguments:
<span class="lineno"> 75 </span>
<span class="lineno"> 76 </span>&gt; Usage: PROG [COMMAND]
<span class="lineno"> 77 </span>&gt; This program contains an animation which can either be viewed in a web-browser
<span class="lineno"> 78 </span>&gt; or rendered to disk.
<span class="lineno"> 79 </span>&gt;
<span class="lineno"> 80 </span>&gt; Available options:
<span class="lineno"> 81 </span>&gt; -h,--help Show this help text
<span class="lineno"> 82 </span>&gt;
<span class="lineno"> 83 </span>&gt; Available commands:
<span class="lineno"> 84 </span>&gt; check Run a system's diagnostic and report any missing
<span class="lineno"> 85 </span>&gt; external dependencies.
<span class="lineno"> 86 </span>&gt; view Play animation in browser window.
<span class="lineno"> 87 </span>&gt; render Render animation to file.
<span class="lineno"> 88 </span>
<span class="lineno"> 89 </span>Neither the \'check\' nor the \'view\' command take any additional arguments.
<span class="lineno"> 90 </span>Rendering animation can be controlled with these arguments:
<span class="lineno"> 91 </span>
<span class="lineno"> 92 </span>&gt; Usage: PROG render [-o|--target FILE] [--fps FPS] [-w|--width PIXELS]
<span class="lineno"> 93 </span>&gt; [-h|--height PIXELS] [--compile] [--format FMT]
<span class="lineno"> 94 </span>&gt; [--preset TYPE]
<span class="lineno"> 95 </span>&gt; Render animation to file.
<span class="lineno"> 96 </span>&gt;
<span class="lineno"> 97 </span>&gt; Available options:
<span class="lineno"> 98 </span>&gt; -o,--target FILE Write output to FILE
<span class="lineno"> 99 </span>&gt; --fps FPS Set frames per second.
<span class="lineno"> 100 </span>&gt; -w,--width PIXELS Set video width.
<span class="lineno"> 101 </span>&gt; -h,--height PIXELS Set video height.
<span class="lineno"> 102 </span>&gt; --compile Compile source code before rendering.
<span class="lineno"> 103 </span>&gt; --format FMT Video format: mp4, gif, webm
<span class="lineno"> 104 </span>&gt; --preset TYPE Parameter presets: youtube, gif, quick
<span class="lineno"> 105 </span>&gt; -h,--help Show this help text
<span class="lineno"> 106 </span>-}
<span class="lineno"> 107 </span>reanimate :: Animation -&gt; IO ()
<span class="lineno"> 108 </span><span class="decl"><span class="istickedoff">reanimate animation = do</span>
<span class="lineno"> 109 </span><span class="spaces"> </span><span class="istickedoff">Options {..} &lt;- getDriverOptions</span>
<span class="lineno"> 110 </span><span class="spaces"> </span><span class="istickedoff">case optsCommand of</span>
<span class="lineno"> 111 </span><span class="spaces"> </span><span class="istickedoff">Raw {..} -&gt; <span class="nottickedoff">do</span></span>
<span class="lineno"> 112 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setFPS 60</span></span>
<span class="lineno"> 113 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">renderSvgs rawOutputFolder rawFrameOffset rawPrettyPrint animation</span></span>
<span class="lineno"> 114 </span><span class="spaces"> </span><span class="istickedoff">Test -&gt; do</span>
<span class="lineno"> 115 </span><span class="spaces"> </span><span class="istickedoff">setNoExternals True</span>
<span class="lineno"> 116 </span><span class="spaces"> </span><span class="istickedoff">-- hSetBinaryMode stdout True</span>
<span class="lineno"> 117 </span><span class="spaces"> </span><span class="istickedoff">renderSnippets animation</span>
<span class="lineno"> 118 </span><span class="spaces"> </span><span class="istickedoff">Check -&gt; <span class="nottickedoff">checkEnvironment</span></span>
<span class="lineno"> 119 </span><span class="spaces"> </span><span class="istickedoff">View {..} -&gt; <span class="nottickedoff">serve viewVerbose viewGHCPath viewGHCOpts viewOrigin</span></span>
<span class="lineno"> 120 </span><span class="spaces"> </span><span class="istickedoff">Render {..} -&gt; <span class="nottickedoff">do</span></span>
<span class="lineno"> 121 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let fmt =</span></span>
<span class="lineno"> 122 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">guessParameter renderFormat (fmap presetFormat renderPreset)</span></span>
<span class="lineno"> 123 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">$ case renderTarget of</span></span>
<span class="lineno"> 124 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- Format guessed from output</span></span>
<span class="lineno"> 125 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Just target -&gt; case takeExtension target of</span></span>
<span class="lineno"> 126 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">&quot;.mp4&quot; -&gt; RenderMp4</span></span>
<span class="lineno"> 127 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">&quot;.gif&quot; -&gt; RenderGif</span></span>
<span class="lineno"> 128 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">&quot;.webm&quot; -&gt; RenderWebm</span></span>
<span class="lineno"> 129 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">_ -&gt; RenderMp4</span></span>
<span class="lineno"> 130 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">-- Default to mp4 rendering.</span></span>
<span class="lineno"> 131 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Nothing -&gt; RenderMp4</span></span>
<span class="lineno"> 132 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
<span class="lineno"> 133 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">target &lt;- case renderTarget of</span></span>
<span class="lineno"> 134 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Nothing -&gt; do</span></span>
<span class="lineno"> 135 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">mbSelf &lt;- findOwnSource</span></span>
<span class="lineno"> 136 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let ext = formatExtension fmt</span></span>
<span class="lineno"> 137 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">self = fromMaybe &quot;output&quot; mbSelf</span></span>
<span class="lineno"> 138 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">pure $ replaceExtension self ext</span></span>
<span class="lineno"> 139 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">Just target -&gt; makeAbsolute target</span></span>
<span class="lineno"> 140 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
<span class="lineno"> 141 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">let</span></span>
<span class="lineno"> 142 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">fps =</span></span>
<span class="lineno"> 143 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">guessParameter renderFPS (fmap presetFPS renderPreset) $ formatFPS fmt</span></span>
<span class="lineno"> 144 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(width, height) = fromMaybe</span></span>
<span class="lineno"> 145 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">( maybe (formatWidth fmt) presetWidth renderPreset</span></span>
<span class="lineno"> 146 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, maybe (formatHeight fmt) presetHeight renderPreset</span></span>
<span class="lineno"> 147 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">)</span></span>
<span class="lineno"> 148 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(userPreferredDimensions renderWidth renderHeight)</span></span>
<span class="lineno"> 149 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
<span class="lineno"> 150 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">raster &lt;-</span></span>
<span class="lineno"> 151 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">if renderRaster == RasterNone || renderRaster == RasterAuto then do</span></span>
<span class="lineno"> 152 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">svgSupport &lt;- hasFFmpegRSvg</span></span>
<span class="lineno"> 153 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">if isRight svgSupport</span></span>
<span class="lineno"> 154 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">then selectRaster renderRaster</span></span>
<span class="lineno"> 155 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">else do</span></span>
<span class="lineno"> 156 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">raster &lt;- selectRaster RasterAuto</span></span>
<span class="lineno"> 157 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">when (raster == RasterNone) $ do</span></span>
<span class="lineno"> 158 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">hPutStrLn stderr</span></span>
<span class="lineno"> 159 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">&quot;Error: your FFmpeg was built without SVG support and no raster engines \</span></span>
<span class="lineno"> 160 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\are available. Please install either inkscape, imagemagick, or rsvg.&quot;</span></span>
<span class="lineno"> 161 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">exitWith (ExitFailure 1)</span></span>
<span class="lineno"> 162 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">return raster</span></span>
<span class="lineno"> 163 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">else selectRaster renderRaster</span></span>
<span class="lineno"> 164 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
<span class="lineno"> 165 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">if renderCompile</span></span>
<span class="lineno"> 166 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">then compile $</span></span>
<span class="lineno"> 167 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">[ &quot;render&quot;</span></span>
<span class="lineno"> 168 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--fps&quot;</span></span>
<span class="lineno"> 169 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, show fps</span></span>
<span class="lineno"> 170 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--width&quot;</span></span>
<span class="lineno"> 171 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, show width</span></span>
<span class="lineno"> 172 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--height&quot;</span></span>
<span class="lineno"> 173 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, show height</span></span>
<span class="lineno"> 174 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--format&quot;</span></span>
<span class="lineno"> 175 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, showFormat fmt</span></span>
<span class="lineno"> 176 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--raster&quot;</span></span>
<span class="lineno"> 177 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, showRaster raster</span></span>
<span class="lineno"> 178 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;--target&quot;</span></span>
<span class="lineno"> 179 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, target</span></span>
<span class="lineno"> 180 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;+RTS&quot;</span></span>
<span class="lineno"> 181 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;-N&quot;</span></span>
<span class="lineno"> 182 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">, &quot;-RTS&quot;</span></span>
<span class="lineno"> 183 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">] ++ [ &quot;--partial&quot; | renderPartial ]</span></span>
<span class="lineno"> 184 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">else do</span></span>
<span class="lineno"> 185 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setRaster raster</span></span>
<span class="lineno"> 186 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setFPS fps</span></span>
<span class="lineno"> 187 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setWidth width</span></span>
<span class="lineno"> 188 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">setHeight height</span></span>
<span class="lineno"> 189 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">printf</span></span>
<span class="lineno"> 190 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">&quot;Animation options:\n\</span></span>
<span class="lineno"> 191 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ fps: %d\n\</span></span>
<span class="lineno"> 192 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ width: %d\n\</span></span>
<span class="lineno"> 193 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ height: %d\n\</span></span>
<span class="lineno"> 194 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ fmt: %s\n\</span></span>
<span class="lineno"> 195 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ target: %s\n\</span></span>
<span class="lineno"> 196 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">\ raster: %s\n&quot;</span></span>
<span class="lineno"> 197 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">fps</span></span>
<span class="lineno"> 198 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">width</span></span>
<span class="lineno"> 199 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">height</span></span>
<span class="lineno"> 200 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(showFormat fmt)</span></span>
<span class="lineno"> 201 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">target</span></span>
<span class="lineno"> 202 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">(show raster)</span></span>
<span class="lineno"> 203 </span><span class="spaces"></span><span class="istickedoff"><span class="nottickedoff"></span></span>
<span class="lineno"> 204 </span><span class="spaces"> </span><span class="istickedoff"><span class="nottickedoff">render animation target raster fmt width height fps renderPartial</span></span></span>
<span class="lineno"> 205 </span>
<span class="lineno"> 206 </span>guessParameter :: Maybe a -&gt; Maybe a -&gt; a -&gt; a
<span class="lineno"> 207 </span><span class="decl"><span class="nottickedoff">guessParameter a b def = fromMaybe def (a &lt;|&gt; b)</span></span>
<span class="lineno"> 208 </span>
<span class="lineno"> 209 </span>
<span class="lineno"> 210 </span>
<span class="lineno"> 211 </span>-- If user specifies exactly one dimension explicitly, calculate the other
<span class="lineno"> 212 </span>userPreferredDimensions :: Maybe Width -&gt; Maybe Height -&gt; Maybe (Width, Height)
<span class="lineno"> 213 </span><span class="decl"><span class="nottickedoff">userPreferredDimensions (Just width) (Just height) = Just (width, height)</span>
<span class="lineno"> 214 </span><span class="spaces"></span><span class="nottickedoff">userPreferredDimensions (Just width) Nothing =</span>
<span class="lineno"> 215 </span><span class="spaces"> </span><span class="nottickedoff">Just (width, makeEven $ width * 9 `div` 16)</span>
<span class="lineno"> 216 </span><span class="spaces"></span><span class="nottickedoff">userPreferredDimensions Nothing (Just height) =</span>
<span class="lineno"> 217 </span><span class="spaces"> </span><span class="nottickedoff">Just (makeEven $ height * 16 `div` 9, height)</span>
<span class="lineno"> 218 </span><span class="spaces"></span><span class="nottickedoff">userPreferredDimensions Nothing Nothing = Nothing</span></span>
<span class="lineno"> 219 </span>
<span class="lineno"> 220 </span>-- Avoid ffmpeg failures &quot;height not divisible by 2&quot;
<span class="lineno"> 221 </span>makeEven :: Int -&gt; Int
<span class="lineno"> 222 </span><span class="decl"><span class="nottickedoff">makeEven x | even x = x</span>
<span class="lineno"> 223 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = x - 1</span></span>
<span class="lineno"> 210 </span>-- If user specifies exactly one dimension explicitly, calculate the other
<span class="lineno"> 211 </span>userPreferredDimensions :: Maybe Width -&gt; Maybe Height -&gt; Maybe (Width, Height)
<span class="lineno"> 212 </span><span class="decl"><span class="nottickedoff">userPreferredDimensions (Just width) (Just height) = Just (width, height)</span>
<span class="lineno"> 213 </span><span class="spaces"></span><span class="nottickedoff">userPreferredDimensions (Just width) Nothing =</span>
<span class="lineno"> 214 </span><span class="spaces"> </span><span class="nottickedoff">Just (width, makeEven $ width * 9 `div` 16)</span>
<span class="lineno"> 215 </span><span class="spaces"></span><span class="nottickedoff">userPreferredDimensions Nothing (Just height) =</span>
<span class="lineno"> 216 </span><span class="spaces"> </span><span class="nottickedoff">Just (makeEven $ height * 16 `div` 9, height)</span>
<span class="lineno"> 217 </span><span class="spaces"></span><span class="nottickedoff">userPreferredDimensions Nothing Nothing = Nothing</span></span>
<span class="lineno"> 218 </span>
<span class="lineno"> 219 </span>-- Avoid ffmpeg failures &quot;height not divisible by 2&quot;
<span class="lineno"> 220 </span>makeEven :: Int -&gt; Int
<span class="lineno"> 221 </span><span class="decl"><span class="nottickedoff">makeEven x | even x = x</span>
<span class="lineno"> 222 </span><span class="spaces"> </span><span class="nottickedoff">| otherwise = x - 1</span></span>
</pre>
</body>