diff --git a/hpc_index.html b/hpc_index.html
new file mode 100644
index 0000000..e334dd1
--- /dev/null
+++ b/hpc_index.html
@@ -0,0 +1,81 @@
+
+
diff --git a/hpc_index_alt.html b/hpc_index_alt.html
new file mode 100644
index 0000000..2ee58fa
--- /dev/null
+++ b/hpc_index_alt.html
@@ -0,0 +1,81 @@
+
+
diff --git a/hpc_index_exp.html b/hpc_index_exp.html
new file mode 100644
index 0000000..e90689d
--- /dev/null
+++ b/hpc_index_exp.html
@@ -0,0 +1,81 @@
+
+
diff --git a/hpc_index_fun.html b/hpc_index_fun.html
new file mode 100644
index 0000000..61699c2
--- /dev/null
+++ b/hpc_index_fun.html
@@ -0,0 +1,81 @@
+
+
diff --git a/reanimate-0.4.1.0-inplace/Paths_reanimate.hs.html b/reanimate-0.4.1.0-inplace/Paths_reanimate.hs.html
new file mode 100644
index 0000000..143708b
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Paths_reanimate.hs.html
@@ -0,0 +1,73 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 {-# LANGUAGE CPP #-}
+ 2 {-# LANGUAGE NoRebindableSyntax #-}
+ 3 {-# OPTIONS_GHC -fno-warn-missing-import-lists #-}
+ 4 module Paths_reanimate (
+ 5 version,
+ 6 getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,
+ 7 getDataFileName, getSysconfDir
+ 8 ) where
+ 9
+ 10 import qualified Control.Exception as Exception
+ 11 import Data.Version (Version(..))
+ 12 import System.Environment (getEnv)
+ 13 import Prelude
+ 14
+ 15 #if defined(VERSION_base)
+ 16
+ 17 #if MIN_VERSION_base(4,0,0)
+ 18 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
+ 19 #else
+ 20 catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a
+ 21 #endif
+ 22
+ 23 #else
+ 24 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
+ 25 #endif
+ 26 catchIO = Exception.catch
+ 27
+ 28 version :: Version
+ 29 version = Version [0,4,1,0] []
+ 30 bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath
+ 31
+ 32 bindir = "/home/runner/.cabal/bin"
+ 33 libdir = "/home/runner/.cabal/lib/x86_64-linux-ghc-8.8.2/reanimate-0.4.1.0-inplace"
+ 34 dynlibdir = "/home/runner/.cabal/lib/x86_64-linux-ghc-8.8.2"
+ 35 datadir = "/home/runner/.cabal/share/x86_64-linux-ghc-8.8.2/reanimate-0.4.1.0"
+ 36 libexecdir = "/home/runner/.cabal/libexec/x86_64-linux-ghc-8.8.2/reanimate-0.4.1.0"
+ 37 sysconfdir = "/home/runner/.cabal/etc"
+ 38
+ 39 getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath
+ 40 getBinDir = catchIO (getEnv "reanimate_bindir") (\_ -> return bindir)
+ 41 getLibDir = catchIO (getEnv "reanimate_libdir") (\_ -> return libdir)
+ 42 getDynLibDir = catchIO (getEnv "reanimate_dynlibdir") (\_ -> return dynlibdir)
+ 43 getDataDir = catchIO (getEnv "reanimate_datadir") (\_ -> return datadir)
+ 44 getLibexecDir = catchIO (getEnv "reanimate_libexecdir") (\_ -> return libexecdir)
+ 45 getSysconfDir = catchIO (getEnv "reanimate_sysconfdir") (\_ -> return sysconfdir)
+ 46
+ 47 getDataFileName :: FilePath -> IO FilePath
+ 48 getDataFileName name = do
+ 49 dir <- getDataDir
+ 50 return (dir ++ "/" ++ name)
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Animation.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Animation.hs.html
new file mode 100644
index 0000000..85083ea
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Animation.hs.html
@@ -0,0 +1,405 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Animation
+ 2 ( Duration
+ 3 , Time
+ 4 , SVG
+ 5 , Animation(..) -- TODO should this be exposed? The constructor is used directly in Effect.hs
+ 6 -- * Creating animations
+ 7 , mkAnimation
+ 8 , animate
+ 9 , staticFrame
+ 10 , pause
+ 11 -- * Querying animations
+ 12 , duration
+ 13 , frameAt
+ 14 -- * Composing animations
+ 15 , seqA
+ 16 , andThen
+ 17 , parA
+ 18 , parLoopA
+ 19 , parDropA
+ 20 -- * Modifying animations
+ 21 , setDuration
+ 22 , adjustDuration
+ 23 , mapA
+ 24 , takeA
+ 25 , dropA
+ 26 , lastA
+ 27 , pauseAtEnd
+ 28 , pauseAtBeginning
+ 29 , pauseAround
+ 30 , pauseUntil
+ 31 , repeatA
+ 32 , reverseA
+ 33 , playThenReverseA
+ 34 , signalA
+ 35 , freezeAtPercentage
+ 36 , addStatic
+ 37 -- * Misc
+ 38 , (#)
+ 39 , getAnimationFrame
+ 40 , Sync(..)
+ 41 -- * Rendering
+ 42 , renderTree
+ 43 , renderSvg
+ 44 ) where
+ 45
+ 46 import Control.Arrow ()
+ 47 import Data.Fixed (mod')
+ 48 import Graphics.SvgTree (Alignment (..), Document (..),
+ 49 Number (..),
+ 50 PreserveAspectRatio (..),
+ 51 Tree (..), xmlOfTree)
+ 52 import Graphics.SvgTree.Printer
+ 53 import Reanimate.Constants
+ 54 import Reanimate.Ease
+ 55 import Reanimate.Svg.Constructors
+ 56 import Text.XML.Light.Output
+ 57
+ 58 -- | Duration of an animation or effect. Usually measured in seconds.
+ 59 type Duration = Double
+ 60 -- | Time signal. Goes from 0 to 1, inclusive.
+ 61 type Time = Double
+ 62
+ 63 type SVG = Tree
+ 64
+ 65 -- | Animations are SVGs over a finite time.
+ 66 data Animation = Animation Duration (Time -> SVG)
+ 67
+ 68 mkAnimation :: Duration -> (Time -> SVG) -> Animation
+ 69 mkAnimation = Animation
+ 70
+ 71 -- | Construct an animation with a duration of @1@.
+ 72 animate :: (Time -> SVG) -> Animation
+ 73 animate = Animation 1
+ 74
+ 75 -- | Create an animation with provided @duration@, which consists of stationary frame displayed for its entire duration.
+ 76 staticFrame :: Duration -> SVG -> Animation
+ 77 staticFrame d svg = Animation d (const svg)
+ 78
+ 79 -- | Query the duration of an animation.
+ 80 duration :: Animation -> Duration
+ 81 duration (Animation d _) = d
+ 82
+ 83 -- | Play animations in sequence. The @lhs@ animation is removed after it has
+ 84 -- completed. New animation duration is '@duration lhs + duration rhs@'.
+ 85 --
+ 86 -- Example:
+ 87 --
+ 88 -- > drawBox `seqA` drawCircle
+ 89 --
+ 90 -- <<docs/gifs/doc_seqA.gif>>
+ 91 seqA :: Animation -> Animation -> Animation
+ 92 seqA (Animation d1 f1) (Animation d2 f2) =
+ 93 Animation totalD $ \t ->
+ 94 if t < d1/totalD
+ 95 then f1 (t * totalD/d1)
+ 96 else f2 ((t-d1/totalD) * totalD/d2)
+ 97 where
+ 98 totalD = d1+d2
+ 99
+ 100 -- | Play two animation concurrently. Shortest animation freezes on last frame.
+ 101 -- New animation duration is '@max (duration lhs) (duration rhs)@'.
+ 102 --
+ 103 -- Example:
+ 104 --
+ 105 -- > drawBox `parA` adjustDuration (*2) drawCircle
+ 106 --
+ 107 -- <<docs/gifs/doc_parA.gif>>
+ 108 parA :: Animation -> Animation -> Animation
+ 109 parA (Animation d1 f1) (Animation d2 f2) =
+ 110 Animation (max d1 d2) $ \t ->
+ 111 let t1 = t * totalD/d1
+ 112 t2 = t * totalD/d2 in
+ 113 mkGroup
+ 114 [ f1 (min 1 t1)
+ 115 , f2 (min 1 t2) ]
+ 116 where
+ 117 totalD = max d1 d2
+ 118
+ 119 -- | Play two animation concurrently. Shortest animation loops.
+ 120 -- New animation duration is '@max (duration lhs) (duration rhs)@'.
+ 121 --
+ 122 -- Example:
+ 123 --
+ 124 -- > drawBox `parLoopA` adjustDuration (*2) drawCircle
+ 125 --
+ 126 -- <<docs/gifs/doc_parLoopA.gif>>
+ 127 parLoopA :: Animation -> Animation -> Animation
+ 128 parLoopA (Animation d1 f1) (Animation d2 f2) =
+ 129 Animation totalD $ \t ->
+ 130 let t1 = t * totalD/d1
+ 131 t2 = t * totalD/d2 in
+ 132 mkGroup
+ 133 [ f1 (t1 `mod'` 1)
+ 134 , f2 (t2 `mod'` 1) ]
+ 135 where
+ 136 totalD = max d1 d2
+ 137
+ 138 -- | Play two animation concurrently. Animations disappear after playing once.
+ 139 -- New animation duration is '@max (duration lhs) (duration rhs)@'.
+ 140 --
+ 141 -- Example:
+ 142 --
+ 143 -- > drawBox `parLoopA` adjustDuration (*2) drawCircle
+ 144 --
+ 145 -- <<docs/gifs/doc_parDropA.gif>>
+ 146 parDropA :: Animation -> Animation -> Animation
+ 147 parDropA (Animation d1 f1) (Animation d2 f2) =
+ 148 Animation totalD $ \t ->
+ 149 let t1 = t * totalD/d1
+ 150 t2 = t * totalD/d2 in
+ 151 mkGroup
+ 152 [ if t1>1 then None else f1 t1
+ 153 , if t2>1 then None else f2 t2 ]
+ 154 where
+ 155 totalD = max d1 d2
+ 156
+ 157 -- | Empty animation (no SVG output) with a fixed duration.
+ 158 --
+ 159 -- Example:
+ 160 --
+ 161 -- > pause 1 `seqA` drawProgress
+ 162 --
+ 163 -- <<docs/gifs/doc_pause.gif>>
+ 164 pause :: Duration -> Animation
+ 165 pause d = Animation d (const None)
+ 166
+ 167 -- | Play left animation and freeze on the last frame, then play the right
+ 168 -- animation. New duration is '@duration lhs + duration rhs@'.
+ 169 --
+ 170 -- Example:
+ 171 --
+ 172 -- > drawBox `andThen` drawCircle
+ 173 --
+ 174 -- <<docs/gifs/doc_andThen.gif>>
+ 175 andThen :: Animation -> Animation -> Animation
+ 176 andThen a b = a `parA` (pause (duration a) `seqA` b)
+ 177
+ 178 -- | Calculate the frame that would be displayed at given point in @time@ of running @animation@.
+ 179 --
+ 180 -- The provided time parameter is clamped between 0 and animation duration.
+ 181 frameAt :: Time -> Animation -> SVG
+ 182 frameAt t (Animation d f) = f t'
+ 183 where
+ 184 t' = clamp 0 1 (t/d)
+ 185
+ 186 renderTree :: SVG -> String
+ 187 renderTree t = maybe "" ppElement $ xmlOfTree t
+ 188
+ 189 renderSvg :: Maybe Number -- ^ The number to use as value of the @width@ attribute of the resulting top-level svg element. If @Nothing@, the width attribute won't be rendered.
+ 190 -> Maybe Number -- ^ Similar to previous argument, but for @height@ attribute.
+ 191 -> SVG -- ^ SVG to render
+ 192 -> String -- ^ String representation of SVG XML markup
+ 193 renderSvg w h t = ppDocument doc
+ 194 -- renderSvg w h t = ppFastElement (xmlOfDocument doc)
+ 195 where
+ 196 width = 16
+ 197 height = 9
+ 198 doc = Document
+ 199 { _viewBox = Just (-width/2, -height/2, width, height)
+ 200 , _width = w
+ 201 , _height = h
+ 202 , _elements = [withStrokeWidth defaultStrokeWidth $ scaleXY 1 (-1) t]
+ 203 , _description = ""
+ 204 , _documentLocation = ""
+ 205 , _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing
+ 206 }
+ 207
+ 208 -- | Map over the SVG produced by an animation at every frame.
+ 209 --
+ 210 -- Example:
+ 211 --
+ 212 -- > mapA (scale 0.5) drawCircle
+ 213 --
+ 214 -- <<docs/gifs/doc_mapA.gif>>
+ 215
+ 216 mapA :: (SVG -> SVG) -> Animation -> Animation
+ 217 mapA fn (Animation d f) = Animation d (fn . f)
+ 218
+ 219 -- | Freeze the last frame for @t@ seconds at the end of the animation.
+ 220 --
+ 221 -- Example:
+ 222 --
+ 223 -- > pauseAtEnd 1 drawProgress
+ 224 --
+ 225 -- <<docs/gifs/doc_pauseAtEnd.gif>>
+ 226 pauseAtEnd :: Duration -> Animation -> Animation
+ 227 pauseAtEnd t a = a `andThen` pause t
+ 228
+ 229 -- | Freeze the first frame for @t@ seconds at the beginning of the animation.
+ 230 --
+ 231 -- Example:
+ 232 --
+ 233 -- > pauseAtBeginning 1 drawProgress
+ 234 --
+ 235 -- <<docs/gifs/doc_pauseAtBeginning.gif>>
+ 236 pauseAtBeginning :: Duration -> Animation -> Animation
+ 237 pauseAtBeginning t a =
+ 238 Animation t (freezeFrame 0 a) `seqA` a
+ 239
+ 240 -- | Freeze the first and the last frame of the animation for a specified duration.
+ 241 --
+ 242 -- Example:
+ 243 --
+ 244 -- > pauseAround 1 1 drawProgress
+ 245 --
+ 246 -- <<docs/gifs/doc_pauseAround.gif>>
+ 247 pauseAround :: Duration -> Duration -> Animation -> Animation
+ 248 pauseAround start end = pauseAtEnd end . pauseAtBeginning start
+ 249
+ 250 -- XXX: Rename to 'setDurationFreeze'. Add 'setDurationDrop' and
+ 251 -- 'setDurationLoop'.
+ 252 pauseUntil :: Duration -> Animation -> Animation
+ 253 pauseUntil d a = pauseAtEnd (d-duration a) a
+ 254
+ 255 -- Freeze frame at time @t@.
+ 256 freezeFrame :: Time -> Animation -> (Time -> SVG)
+ 257 freezeFrame t (Animation d f) = const $ f (t/d)
+ 258
+ 259 -- | Change the duration of an animation. Animates are stretched or squished
+ 260 -- (rather than truncated) to fit the new duration.
+ 261 adjustDuration :: (Duration -> Duration) -> Animation -> Animation
+ 262 adjustDuration fn (Animation d gen) =
+ 263 Animation (fn d) gen
+ 264
+ 265 -- | Set the duration of an animation by adjusting its playback rate. The
+ 266 -- animation is still played from start to finish without being cropped.
+ 267 setDuration :: Duration -> Animation -> Animation
+ 268 setDuration newD = adjustDuration (const newD)
+ 269
+ 270 -- | Play an animation in reverse. Duration remains unchanged. Shorthand for:
+ 271 -- @'signalA' 'reverseS'@.
+ 272 --
+ 273 -- Example:
+ 274 --
+ 275 -- > reverseA drawCircle
+ 276 --
+ 277 -- <<docs/gifs/doc_reverseA.gif>>
+ 278 reverseA :: Animation -> Animation
+ 279 reverseA = signalA reverseS
+ 280
+ 281 -- | Play animation before playing it again in reverse. Duration is twice
+ 282 -- the duration of the input.
+ 283 --
+ 284 -- Example:
+ 285 --
+ 286 -- > playThenReverseA drawCircle
+ 287 --
+ 288 -- <<docs/gifs/doc_playThenReverseA.gif>>
+ 289 playThenReverseA :: Animation -> Animation
+ 290 playThenReverseA a = a `seqA` reverseA a
+ 291
+ 292 -- | Loop animation @n@ number of times. This number may be fractional and it
+ 293 -- may be less than 1. It must be greater than or equal to 0, though.
+ 294 -- New duration is @n*duration input@.
+ 295 --
+ 296 -- Example:
+ 297 --
+ 298 -- > repeatA 1.5 drawCircle
+ 299 --
+ 300 -- <<docs/gifs/doc_repeatA.gif>>
+ 301 repeatA :: Double -> Animation -> Animation
+ 302 repeatA n (Animation d f) = Animation (d*n) $ \t ->
+ 303 f ((t*n) `mod'` 1)
+ 304
+ 305
+ 306 -- | @freezeAtPercentage time animation@ creates an animation consisting of stationary frame,
+ 307 -- that would be displayed in the provided @animation@ at given @time@.
+ 308 -- The duration of the new animation is the same as the duration of provided @animation@.
+ 309 freezeAtPercentage :: Time -- ^ value between 0 and 1. The frame displayed at this point in the original animation will be displayed for the duration of the new animation
+ 310 -> Animation -- ^ original animation, from which the frame will be taken
+ 311 -> Animation -- ^ new animation consisting of static frame displayed for the duration of the original animation
+ 312 freezeAtPercentage frac (Animation d genFrame) =
+ 313 Animation d $ const $ genFrame frac
+ 314
+ 315 -- | Overlay animation on top of static SVG image.
+ 316 --
+ 317 -- Example:
+ 318 --
+ 319 -- > addStatic (mkBackground "lightblue") drawCircle
+ 320 --
+ 321 -- <<docs/gifs/doc_addStatic.gif>>
+ 322 addStatic :: SVG -> Animation -> Animation
+ 323 addStatic static = mapA (\frame -> mkGroup [static, frame])
+ 324
+ 325 -- | Modify the time component of an animation. Animation duration is unchanged.
+ 326 --
+ 327 -- Example:
+ 328 --
+ 329 -- > signalA (fromToS 0.25 0.75) drawCircle
+ 330 --
+ 331 -- <<docs/gifs/doc_signalA.gif>>
+ 332 signalA :: Signal -> Animation -> Animation
+ 333 signalA fn (Animation d gen) = Animation d $ gen . fn
+ 334
+ 335 -- | @takeA duration animation@ creates a new animation consisting of initial segment of
+ 336 -- @animation@ of given @duration@, played at the same rate as the original animation.
+ 337 --
+ 338 -- The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
+ 339 -- New animation duration is equal to (eventually clamped) @duration@.
+ 340 takeA :: Duration -> Animation -> Animation
+ 341 takeA len (Animation d gen) = Animation len' $ \t ->
+ 342 gen (t * len'/d)
+ 343 where
+ 344 len' = clamp 0 d len
+ 345
+ 346 -- | @dropA duration animation@ creates a new animation by dropping initial segment
+ 347 -- of length @duration@ from the provided @animation@, played at the same rate as the original animation.
+ 348 --
+ 349 -- The @duration@ parameter is clamped to be between 0 and @animation@'s duration.
+ 350 -- The duration of the resulting animation is duration of provided @animation@ minus (eventually clamped) @duration@.
+ 351 dropA :: Duration -> Animation -> Animation
+ 352 dropA len (Animation d gen) = Animation len' $ \t ->
+ 353 gen (t * len'/d + len/d)
+ 354 where
+ 355 len' = d - clamp 0 d len
+ 356
+ 357 lastA :: Duration -> Animation -> Animation
+ 358 lastA len a = dropA (duration a - len) a
+ 359
+ 360 clamp :: Double -> Double -> Double -> Double
+ 361 clamp a b number
+ 362 | a < b = max a (min b number)
+ 363 | otherwise = max b (min a number)
+ 364
+ 365 (#) :: a -> (a -> b) -> b
+ 366 o # f = f o
+ 367
+ 368 getAnimationFrame :: Sync -> Animation -> Time -> Duration -> SVG
+ 369 getAnimationFrame sync (Animation aDur aGen) t d =
+ 370 case sync of
+ 371 SyncStretch -> aGen (t/d)
+ 372 SyncLoop -> aGen (takeFrac $ t/aDur)
+ 373 SyncDrop -> if t > aDur then None else aGen (t/aDur)
+ 374 SyncFreeze -> aGen (min 1 $ t/aDur)
+ 375 where
+ 376 takeFrac f = snd (properFraction f :: (Int, Double))
+ 377
+ 378 data Sync
+ 379 = SyncStretch
+ 380 | SyncLoop
+ 381 | SyncDrop
+ 382 | SyncFreeze
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation.hs.html
new file mode 100644
index 0000000..2797d0d
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation.hs.html
@@ -0,0 +1,76 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Builtin.Documentation where
+ 2
+ 3 import Reanimate.Animation
+ 4 import Reanimate.Svg
+ 5 import Reanimate.Raster
+ 6 import Reanimate.Constants
+ 7 import Codec.Picture
+ 8
+ 9 docEnv :: Animation -> Animation
+ 10 docEnv = mapA $ \svg -> mkGroup
+ 11 [ mkBackground "white"
+ 12 , withFillOpacity 0 $
+ 13 withStrokeWidth 0.1 $
+ 14 withStrokeColor "black" (mkGroup [svg]) ]
+ 15
+ 16 -- | <<docs/gifs/doc_drawBox.gif>>
+ 17 drawBox :: Animation
+ 18 drawBox = mkAnimation 2 $ \t ->
+ 19 partialSvg t $ pathify $
+ 20 mkRect (screenWidth/2) (screenHeight/2)
+ 21
+ 22 -- | <<docs/gifs/doc_drawCircle.gif>>
+ 23 drawCircle :: Animation
+ 24 drawCircle = mkAnimation 2 $ \t ->
+ 25 partialSvg t $ pathify $
+ 26 mkCircle (screenHeight/3)
+ 27
+ 28 drawBall :: Animation
+ 29 drawBall = mkAnimation 2 $ \t ->
+ 30 scale t $ withFillOpacity 1 $ withFillColor "red" $
+ 31 mkCircle (screenHeight/3)
+ 32
+ 33 -- | <<docs/gifs/doc_drawProgress.gif>>
+ 34 drawProgress :: Animation
+ 35 drawProgress = mkAnimation 2 $ \t ->
+ 36 mkGroup
+ 37 [ mkLine (-screenWidth/2*widthP,0)
+ 38 (screenWidth/2*widthP,0)
+ 39 , translate (-screenWidth/2*widthP + screenWidth*widthP*t) 0 $
+ 40 withFillOpacity 1 $ mkCircle 0.5 ]
+ 41 where
+ 42 widthP = 0.8
+ 43
+ 44 showColorMap :: (Double -> PixelRGB8) -> SVG
+ 45 showColorMap f = center $ scaleToSize screenWidth screenHeight $ embedImage img
+ 46 where
+ 47 width = 256
+ 48 height = 1
+ 49 img = generateImage pixelRenderer width height
+ 50 pixelRenderer x _y = f (fromIntegral x / fromIntegral (width-1))
+ 51
+ 52 rtfdBackgroundColor :: PixelRGBA8
+ 53 rtfdBackgroundColor = PixelRGBA8 252 252 252 0xFF
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Cache.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Cache.hs.html
new file mode 100644
index 0000000..0499e9a
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Cache.hs.html
@@ -0,0 +1,134 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Cache
+ 2 ( cacheFile -- :: FilePath -> (FilePath -> IO ()) -> IO FilePath
+ 3 , cacheMem
+ 4 , cacheDisk
+ 5 , cacheDiskSvg
+ 6 , cacheDiskKey
+ 7 , cacheDiskLines
+ 8 , encodeInt
+ 9 ) where
+ 10
+ 11 import Control.Exception
+ 12 import Control.Monad (unless)
+ 13 import Data.Bits
+ 14 import Data.Hashable
+ 15 import Data.IORef
+ 16 import Data.Map (Map)
+ 17 import qualified Data.Map as Map
+ 18 import Data.Text (Text)
+ 19 import qualified Data.Text as T
+ 20 import qualified Data.Text.IO as T
+ 21 import Graphics.SvgTree (Tree (..), unparse)
+ 22 import Reanimate.Animation (renderTree)
+ 23 import Reanimate.Misc (renameOrCopyFile)
+ 24 import System.Directory
+ 25 import System.FilePath
+ 26 import System.IO
+ 27 import System.IO.Temp
+ 28 import System.IO.Unsafe
+ 29 import Text.XML.Light (Content (..), parseXML)
+ 30
+ 31 -- Memory cache and disk cache
+ 32
+ 33 cacheFile :: FilePath -> (FilePath -> IO ()) -> IO FilePath
+ 34 cacheFile template gen = do
+ 35 root <- getXdgDirectory XdgCache "reanimate"
+ 36 createDirectoryIfMissing True root
+ 37 let path = root </> template
+ 38 hit <- doesFileExist path
+ 39 unless hit $ withSystemTempFile template $ \tmp h -> do
+ 40 hClose h
+ 41 gen tmp
+ 42 renameOrCopyFile tmp path
+ 43 evaluate path
+ 44
+ 45 cacheDisk :: String -> (T.Text -> Maybe a) -> (a -> T.Text) -> (Text -> IO a) -> (Text -> IO a)
+ 46 cacheDisk cacheType parse render gen key = do
+ 47 root <- getXdgDirectory XdgCache "reanimate"
+ 48 createDirectoryIfMissing True root
+ 49 let path = root </> encodeInt (hash key) <.> cacheType
+ 50 hit <- doesFileExist path
+ 51 if hit
+ 52 then do
+ 53 inp <- T.readFile path
+ 54 case parse inp of
+ 55 Nothing -> genCache root path
+ 56 Just val -> pure val
+ 57 else genCache root path
+ 58 where
+ 59 genCache root path = do
+ 60 (tmpPath, tmpHandle) <- openTempFile root (encodeInt (hash key))
+ 61 new <- gen key
+ 62 T.hPutStr tmpHandle (render new)
+ 63 hClose tmpHandle
+ 64 renameOrCopyFile tmpPath path
+ 65 return new
+ 66
+ 67 cacheDiskKey :: Text -> IO Tree -> IO Tree
+ 68 cacheDiskKey key gen = cacheDiskSvg (const gen) key
+ 69
+ 70 cacheDiskSvg :: (Text -> IO Tree) -> (Text -> IO Tree)
+ 71 cacheDiskSvg = cacheDisk "svg" parse render
+ 72 where
+ 73 parse txt = case parseXML txt of
+ 74 [Elem t] -> Just (unparse t)
+ 75 _ -> Nothing
+ 76 render = T.pack . renderTree
+ 77
+ 78 cacheDiskLines :: (Text -> IO [Text]) -> (Text -> IO [Text])
+ 79 cacheDiskLines = cacheDisk "txt" parse render
+ 80 where
+ 81 parse = Just . T.lines
+ 82 render = T.unlines
+ 83
+ 84
+ 85 {-# NOINLINE cache #-}
+ 86 cache :: IORef (Map Text Tree)
+ 87 cache = unsafePerformIO (newIORef Map.empty)
+ 88
+ 89 cacheMem :: (Text -> IO Tree) -> (Text -> IO Tree)
+ 90 cacheMem gen key = do
+ 91 store <- readIORef cache
+ 92 case Map.lookup key store of
+ 93 Just svg -> return svg
+ 94 Nothing -> do
+ 95 svg <- gen key
+ 96 case svg of
+ 97 -- None usually indicates that latex or another tool was misconfigured. In this case,
+ 98 -- don't store the result.
+ 99 None -> pure None
+ 100 _ -> atomicModifyIORef cache (\m -> (Map.insert key svg m, svg))
+ 101
+ 102 encodeInt :: Int -> String
+ 103 encodeInt i = worker (fromIntegral i) 60
+ 104 where
+ 105 worker :: Word -> Int -> String
+ 106 worker key sh
+ 107 | sh < 0 = []
+ 108 | otherwise =
+ 109 case (key `shiftR` sh) `mod` 64 of
+ 110 idx -> alphabet !! fromIntegral idx : worker key (sh-6)
+ 111 alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+$"
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Constants.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Constants.hs.html
new file mode 100644
index 0000000..17214ef
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Constants.hs.html
@@ -0,0 +1,51 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Constants
+ 2 ( screenWidth
+ 3 , screenHeight
+ 4 , screenTop
+ 5 , screenBottom
+ 6 , screenLeft
+ 7 , screenRight
+ 8 , defaultDPI
+ 9 , defaultStrokeWidth
+ 10 ) where
+ 11
+ 12 import Graphics.SvgTree
+ 13
+ 14 screenWidth, screenHeight, screenTop :: Fractional a => a
+ 15 screenBottom, screenLeft, screenRight :: Fractional a => a
+ 16
+ 17 screenWidth = 16
+ 18 screenHeight = 9
+ 19 screenTop = screenHeight/2
+ 20 screenBottom = -screenHeight/2
+ 21 screenLeft = -screenWidth/2
+ 22 screenRight = screenWidth/2
+ 23
+ 24 defaultDPI :: Dpi
+ 25 defaultDPI = 96
+ 26
+ 27 defaultStrokeWidth :: Double
+ 28 defaultStrokeWidth = 0.05
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI.hs.html
new file mode 100644
index 0000000..493e067
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI.hs.html
@@ -0,0 +1,246 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Driver.CLI
+ 2 ( getDriverOptions
+ 3 , Options(..)
+ 4 , Command(..)
+ 5 , Preset(..)
+ 6 , Format(..)
+ 7 , Raster(..)
+ 8 , showFormat
+ 9 , showRaster
+ 10 ) where
+ 11
+ 12 import Data.Char
+ 13 import Data.Monoid
+ 14 import Options.Applicative
+ 15 import Prelude
+ 16 import Reanimate.Render (FPS, Format (..), Height, Raster (..),
+ 17 Width)
+ 18
+ 19 newtype Options = Options
+ 20 { optsCommand :: Command
+ 21 } deriving (Show)
+ 22
+ 23 data Command
+ 24 = Raw
+ 25 { rawOutputFolder :: FilePath
+ 26 , rawFrameOffset :: Int
+ 27 , rawPrettyPrint :: Bool
+ 28 }
+ 29 | Test
+ 30 | Check
+ 31 | View
+ 32 { viewVerbose :: Bool
+ 33 , viewGHCPath :: Maybe FilePath
+ 34 , viewGHCOpts :: [String]
+ 35 , viewOrigin :: Maybe FilePath
+ 36 }
+ 37 | Render
+ 38 { renderTarget :: Maybe String
+ 39 , renderFPS :: Maybe FPS
+ 40 , renderWidth :: Maybe Width
+ 41 , renderHeight :: Maybe Height
+ 42 , renderCompile :: Bool
+ 43 , renderFormat :: Maybe Format
+ 44 , renderPreset :: Maybe Preset
+ 45 , renderRaster :: Raster
+ 46 , renderPartial :: Bool
+ 47 }
+ 48 deriving (Show)
+ 49
+ 50 data Preset = Youtube | ExampleGif | Quick | MediumQ | HighQ | LowFPS
+ 51 deriving (Show)
+ 52
+ 53 readRaster :: String -> Maybe Raster
+ 54 readRaster raster =
+ 55 case map toLower raster of
+ 56 "none" -> Just RasterNone
+ 57 "auto" -> Just RasterAuto
+ 58 "inkscape" -> Just RasterInkscape
+ 59 "rsvg" -> Just RasterRSvg
+ 60 "imagemagick" -> Just RasterMagick
+ 61 _ -> Nothing
+ 62
+ 63 showRaster :: Raster -> String
+ 64 showRaster RasterNone = "none"
+ 65 showRaster RasterAuto = "auto"
+ 66 showRaster RasterInkscape = "inkscape"
+ 67 showRaster RasterRSvg = "rsvg"
+ 68 showRaster RasterMagick = "imagemagick"
+ 69
+ 70 readFormat :: String -> Maybe Format
+ 71 readFormat fmt =
+ 72 case map toLower fmt of
+ 73 "mp4" -> Just RenderMp4
+ 74 "gif" -> Just RenderGif
+ 75 "webm" -> Just RenderWebm
+ 76 _ -> Nothing
+ 77
+ 78 showFormat :: Format -> String
+ 79 showFormat RenderMp4 = "mp4"
+ 80 showFormat RenderGif = "gif"
+ 81 showFormat RenderWebm = "webm"
+ 82
+ 83 readPreset :: String -> Maybe Preset
+ 84 readPreset preset =
+ 85 case map toLower preset of
+ 86 "youtube" -> Just Youtube
+ 87 "gif" -> Just ExampleGif
+ 88 "quick" -> Just Quick
+ 89 "medium" -> Just MediumQ
+ 90 "high" -> Just HighQ
+ 91 "lowfps" -> Just LowFPS
+ 92 _ -> Nothing
+ 93
+ 94 showPreset :: Preset -> String
+ 95 showPreset Youtube = "youtube"
+ 96 showPreset ExampleGif = "gif"
+ 97 showPreset Quick = "quick"
+ 98 showPreset MediumQ = "medium"
+ 99 showPreset HighQ = "high"
+ 100 showPreset LowFPS = "lowfps"
+ 101
+ 102 options :: Parser Options
+ 103 options = Options <$> commandP
+ 104
+ 105 commandP :: Parser Command
+ 106 commandP = subparser(
+ 107 command "test" testCommand
+ 108 <> commandGroup "Internal commands"
+ 109 <> internal )
+ 110 <|> hsubparser
+ 111 ( command "check" checkCommand
+ 112 <> command "view" viewCommand
+ 113 <> command "render" renderCommand
+ 114 <> command "raw" rawCommand
+ 115 )
+ 116 <|> infoParser viewCommand
+ 117
+ 118 rawCommand :: ParserInfo Command
+ 119 rawCommand = info parse
+ 120 (progDesc "Output raw SVGs for animation at 60 fps. Used internally by viewer.")
+ 121 where
+ 122 parse = Raw
+ 123 <$> strOption
+ 124 ( long "output" <>
+ 125 short 'o' <>
+ 126 metavar "PATH" <>
+ 127 help "Output folder" <>
+ 128 value ".")
+ 129 <*> option auto
+ 130 ( long "offset" <>
+ 131 metavar "NUMBER" <>
+ 132 help "Frame offset" <>
+ 133 value 0)
+ 134 <*> switch
+ 135 ( long "pretty-print" <>
+ 136 short 'p' <>
+ 137 help "Pretty print svg")
+ 138
+ 139 testCommand :: ParserInfo Command
+ 140 testCommand = info (parse <**> helper)
+ 141 (progDesc "Generate 10 frames spread out evenly across the animation. Used \
+ 142 \internally by the test-suite.")
+ 143 where
+ 144 parse = pure Test
+ 145
+ 146 checkCommand :: ParserInfo Command
+ 147 checkCommand = info parse
+ 148 (progDesc "Run a system's diagnostic and report any missing external dependencies.")
+ 149 where
+ 150 parse = pure Check
+ 151
+ 152 viewCommand :: ParserInfo Command
+ 153 viewCommand = info parse
+ 154 (progDesc "Play animation in browser window.")
+ 155 where
+ 156 parse = View
+ 157 <$> switch
+ 158 (long "verbose" <> short 'v')
+ 159 <*> optional (strOption (long "ghc"
+ 160 <> metavar "PATH"
+ 161 <> help "Path to GHC binary"))
+ 162 <*> many (strOption (long "ghc-opt"
+ 163 <> short 'G'
+ 164 <> help "Additional option to pass to ghc"))
+ 165 <*> optional (strOption (long "self"
+ 166 <> metavar "PATH"
+ 167 <> help "Source file used for live-reloading"))
+ 168
+ 169 renderCommand :: ParserInfo Command
+ 170 renderCommand = info parse
+ 171 (progDesc "Render animation to file.")
+ 172 where
+ 173 -- fromPreset :: (Maybe Preset -> (Command -> Command))
+ 174 -- fromPreset Nothing = id
+ 175 -- fromPreset (Just ExampleGif) = \cmd -> cmd{renderFPS=24}
+ 176 -- modParser :: Parser (Command -> Command)
+ 177 -- modParser = fmap fromPreset $
+ 178 -- optional (option (maybeReader readPreset)
+ 179 -- (long "preset" <> showDefaultWith showPreset
+ 180 -- <> metavar "TYPE"
+ 181 -- <> help "Parameter presets: youtube, gif, quick"))
+ 182 parse = Render
+ 183 <$> optional (strOption (long "target"
+ 184 <> short 'o'
+ 185 <> metavar "FILE"
+ 186 <> help "Write output to FILE"))
+ 187 <*> optional (option auto
+ 188 (long "fps" <> metavar "FPS"
+ 189 <> help "Set frames per second."))
+ 190 <*> optional (option auto
+ 191 (long "width" <> short 'w' <> metavar "PIXELS"
+ 192 <> help "Set video width."))
+ 193 <*> optional (option auto
+ 194 (long "height" <> short 'h'
+ 195 <> metavar "PIXELS" <> help "Set video height."))
+ 196 <*> switch (long "compile"
+ 197 <> help "Compile source code before rendering.")
+ 198 <*> optional (option (maybeReader readFormat)
+ 199 (long "format" <> metavar "FMT"
+ 200 <> help "Video format: mp4, gif, webm"))
+ 201 <*> optional (option (maybeReader readPreset)
+ 202 (long "preset" <> showDefaultWith showPreset
+ 203 <> metavar "TYPE"
+ 204 <> help "Parameter presets: youtube, gif, quick, medium, high"))
+ 205 <*> option (maybeReader readRaster)
+ 206 (long "raster" <> showDefaultWith showRaster
+ 207 <> metavar "RASTER"
+ 208 <> value RasterNone
+ 209 <> help "Raster engine: none, auto, inkscape, rsvg, imagemagick")
+ 210 <*> switch
+ 211 (long "partial"
+ 212 <> help "Produce partial animation even if frame generation was \
+ 213 \interrupted by ctrl-c")
+ 214
+ 215 opts :: ParserInfo Options
+ 216 opts = info (options <**> helper )
+ 217 ( fullDesc
+ 218 <> progDesc "This program contains an animation which can either be viewed \
+ 219 \in a web-browser or rendered to disk."
+ 220 )
+ 221
+ 222 getDriverOptions :: IO Options
+ 223 getDriverOptions = customExecParser (prefs showHelpOnError) opts
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Driver.Check.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Driver.Check.hs.html
new file mode 100644
index 0000000..11d56c6
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Driver.Check.hs.html
@@ -0,0 +1,229 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 {-# LANGUAGE ScopedTypeVariables #-}
+ 2 module Reanimate.Driver.Check
+ 3 ( checkEnvironment
+ 4 , hasRSvg
+ 5 , hasInkscape
+ 6 , hasMagick
+ 7 , hasFFmpegRSvg
+ 8 ) where
+ 9
+ 10 import Control.Exception (SomeException, handle)
+ 11 import Control.Monad
+ 12 import Data.Maybe
+ 13 import Data.Version
+ 14 import Reanimate.Misc (runCmd_)
+ 15 import Reanimate.Driver.Magick (magickCmd)
+ 16 import System.Console.ANSI.Codes
+ 17 import System.Directory (findExecutable)
+ 18 import System.IO
+ 19 import System.IO.Temp
+ 20 import Text.ParserCombinators.ReadP
+ 21 import Text.Printf
+ 22
+ 23 --------------------------------------------------------------------------
+ 24 -- Check environment
+ 25
+ 26 checkEnvironment :: IO ()
+ 27 checkEnvironment = do
+ 28 putStrLn "reanimate checks:"
+ 29 runCheck "Has ffmpeg" hasFFmpeg
+ 30 runCheck "Has ffmpeg(rsvg)" hasFFmpegRSvg
+ 31 runCheck "Has dvisvgm" hasDvisvgm
+ 32 runCheck "Has povray" hasPovray
+ 33 runCheck "Has blender" hasBlender
+ 34 runCheck "Has rsvg-convert" hasRSvg
+ 35 runCheck "Has inkscape" hasInkscape
+ 36 runCheck "Has imagemagick" hasMagick
+ 37 runCheck "Has LaTeX" hasLaTeX
+ 38 runCheck ("Has LaTeX package '"++ "babel" ++ "'") $ hasTeXPackage "latex"
+ 39 "[english]{babel}"
+ 40 forM_ latexPackages $ \pkg ->
+ 41 runCheck ("Has LaTeX package '"++ pkg ++ "'") $ hasTeXPackage "latex" $
+ 42 "{"++pkg++"}"
+ 43 runCheck "Has XeLaTeX" hasXeLaTeX
+ 44 forM_ xelatexPackages $ \pkg ->
+ 45 runCheck ("Has XeLaTeX package '"++ pkg ++ "'") $ hasTeXPackage "xelatex" $
+ 46 "{"++pkg++"}"
+ 47 where
+ 48 latexPackages =
+ 49 ["preview"
+ 50 ,"amsmath"
+ 51 --,"amssymb"
+ 52 --,"dsfont"
+ 53 --,"setspace"
+ 54 --,"relsize"
+ 55 --,"textcomp"
+ 56 --,"mathrsfs"
+ 57 --,"calligra"
+ 58 --,"wasysym"
+ 59 --,"ragged2e"
+ 60 --,"physics"
+ 61 --,"xcolor"
+ 62 --,"textcomp"
+ 63 --,"xfrac"
+ 64 --,"microtype"
+ 65 ]
+ 66 xelatexPackages =
+ 67 ["ctex"]
+ 68 runCheck msg fn = do
+ 69 printf " %-35s" (msg ++ ":")
+ 70 val <- fn
+ 71 case val of
+ 72 Left err -> putStrLnColor Red err
+ 73 Right ok -> putStrLnColor Green ok
+ 74
+ 75 putStrLnColor :: Color -> String -> IO ()
+ 76 putStrLnColor color msg =
+ 77 putStrLn $ setSGRCode [SetColor Foreground Vivid color] ++ msg ++ setSGRCode [Reset]
+ 78
+ 79 -- latex, dvisvgm, xelatex
+ 80
+ 81 hasLaTeX :: IO (Either String String)
+ 82 hasLaTeX = hasProgram "latex"
+ 83
+ 84 hasXeLaTeX :: IO (Either String String)
+ 85 hasXeLaTeX = hasProgram "xelatex"
+ 86
+ 87 hasDvisvgm :: IO (Either String String)
+ 88 hasDvisvgm = hasProgram "dvisvgm"
+ 89
+ 90 hasPovray :: IO (Either String String)
+ 91 hasPovray = hasProgram "povray"
+ 92
+ 93 hasFFmpeg :: IO (Either String String)
+ 94 hasFFmpeg = checkMinVersion minVersion <$> ffmpegVersion
+ 95 where
+ 96 minVersion = Version [4,1,3] []
+ 97
+ 98 hasFFmpegRSvg :: IO (Either String String)
+ 99 hasFFmpegRSvg = do
+ 100 mbPath <- findExecutable "ffmpeg"
+ 101 case mbPath of
+ 102 Nothing -> return $ Left "n/a"
+ 103 Just path -> do
+ 104 ret <- runCmd_ path ["-version"]
+ 105 pure $ case ret of
+ 106 Right out | "--enable-librsvg" `elem` words out
+ 107 -> Right "yes"
+ 108 _ -> Left "no"
+ 109
+ 110 hasBlender :: IO (Either String String)
+ 111 hasBlender = checkMinVersion minVersion <$> blenderVersion
+ 112 where
+ 113 minVersion = Version [2,80] []
+ 114
+ 115 hasRSvg :: IO (Either String String)
+ 116 hasRSvg = checkMinVersion minVersion <$> rsvgVersion
+ 117 where
+ 118 minVersion = Version [2,44,0] []
+ 119
+ 120 hasInkscape :: IO (Either String String)
+ 121 hasInkscape = checkMinVersion minVersion <$> inkscapeVersion
+ 122 where
+ 123 minVersion = Version [0,92] []
+ 124
+ 125 hasMagick :: IO (Either String String)
+ 126 hasMagick = checkMinVersion minVersion <$> magickVersion
+ 127 where
+ 128 minVersion = Version [6,0,0] []
+ 129
+ 130 ffmpegVersion :: IO (Maybe Version)
+ 131 ffmpegVersion = extractVersion "ffmpeg" ["-version"] $ \line ->
+ 132 case take 3 $ words line of
+ 133 ["ffmpeg", "version", vs] -> vs
+ 134 _ -> ""
+ 135
+ 136 blenderVersion :: IO (Maybe Version)
+ 137 blenderVersion = extractVersion "blender" ["--version"] $ \line ->
+ 138 case take 2 (words line) of
+ 139 ["Blender", vs] -> vs
+ 140 _ -> ""
+ 141
+ 142 rsvgVersion :: IO (Maybe Version)
+ 143 rsvgVersion = extractVersion "rsvg-convert" ["--version"] $ \line ->
+ 144 case words line of
+ 145 ["rsvg-convert", "version", vs] -> vs
+ 146 _ -> ""
+ 147
+ 148 inkscapeVersion :: IO (Maybe Version)
+ 149 inkscapeVersion = extractVersion "inkscape" ["--version"] $ \line ->
+ 150 case take 2 $ words line of
+ 151 ["Inkscape", vs] -> vs
+ 152 _ -> ""
+ 153
+ 154 magickVersion :: IO (Maybe Version)
+ 155 magickVersion = extractVersion magickCmd ["-version"] $ \line ->
+ 156 case take 3 $ words line of
+ 157 ["Version:", "ImageMagick", vs] -> vs
+ 158 _ -> ""
+ 159
+ 160 checkMinVersion :: Version -> Maybe Version -> Either String String
+ 161 checkMinVersion _minVersion Nothing = Left "no"
+ 162 checkMinVersion minVersion (Just vs)
+ 163 | vs < minVersion = Left $ "too old: " ++ showVersion vs ++ " < " ++ showVersion minVersion
+ 164 | otherwise = Right (showVersion vs)
+ 165
+ 166 extractVersion :: FilePath -> [String] -> (String -> String) -> IO (Maybe Version)
+ 167 extractVersion execPath args outputFilter = do
+ 168 mbPath <- findExecutable execPath
+ 169 case mbPath of
+ 170 Nothing -> return Nothing
+ 171 Just path -> do
+ 172 ret <- runCmd_ path args
+ 173 case ret of
+ 174 Left{} -> return $ Just noVersion
+ 175 Right out ->
+ 176 pure $ Just $ fromMaybe noVersion $ parseVS $ outputFilter out
+ 177 where
+ 178 noVersion = Version [] []
+ 179 parseVS vs = listToMaybe $ reverse
+ 180 [ v | (v, _) <- readP_to_S parseVersion vs ]
+ 181
+ 182 hasTeXPackage :: FilePath -> String -> IO (Either String String)
+ 183 hasTeXPackage exec pkg = handle (\(_::SomeException) -> return $ Left "n/a") $
+ 184 withSystemTempDirectory "reanimate" $ \tmp_dir -> withTempFile tmp_dir "test.tex" $ \tex_file tex_handle -> do
+ 185 hPutStr tex_handle tex_document
+ 186 hPutStr tex_handle $ "\\usepackage" ++ pkg ++ "\n"
+ 187 hPutStr tex_handle "\\begin{document}\n"
+ 188 hPutStr tex_handle "blah\n"
+ 189 hPutStr tex_handle tex_epilogue
+ 190 hClose tex_handle
+ 191 ret <- runCmd_ exec ["-interaction=batchmode", "-halt-on-error", "-output-directory="++tmp_dir, tex_file]
+ 192 return $ case ret of
+ 193 Right{} -> Right "OK"
+ 194 Left{} -> Left "missing"
+ 195 where
+ 196 tex_document = "\\documentclass[preview]{standalone}\n"
+ 197 tex_epilogue =
+ 198 "\n\
+ 199 \\\end{document}"
+ 200
+ 201 hasProgram :: String -> IO (Either String String)
+ 202 hasProgram exec = do
+ 203 mbPath <- findExecutable exec
+ 204 return $ case mbPath of
+ 205 Nothing -> Left $ "'" ++ exec ++ "' not found"
+ 206 Just path -> Right path
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile.hs.html
new file mode 100644
index 0000000..131765a
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile.hs.html
@@ -0,0 +1,58 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Driver.Compile ( compile ) where
+ 2
+ 3 import Reanimate.Driver.Server (findOwnSource)
+ 4 import System.Directory
+ 5 import System.Exit
+ 6 import System.FilePath
+ 7 import System.Process
+ 8 import System.IO
+ 9
+ 10 compile :: [String] -> IO ()
+ 11 compile opts = do
+ 12 mbSelf <- findOwnSource
+ 13 case mbSelf of
+ 14 Nothing -> do
+ 15 hPutStrLn stderr
+ 16 "Failed to find source code. Did you already compile the animations?\n\
+ 17 \Try running again without the --compile flag."
+ 18 exitFailure
+ 19 Just self -> do
+ 20 let selfDir = takeDirectory self
+ 21 selfName = takeBaseName self
+ 22 outDir = selfDir </> ".reanimate" </> selfName
+ 23 target = outDir </> selfName
+ 24 ghcOptions =
+ 25 ["-rtsopts", "--make", "-threaded", "-O2"] ++
+ 26 ["-odir", outDir, "-hidir", outDir] ++
+ 27 [self, "-o", target]
+ 28 createDirectoryIfMissing True outDir
+ 29 withCurrentDirectory selfDir $ do
+ 30 checkExitCode =<< rawSystem "stack" (["ghc", "--"] ++ ghcOptions)
+ 31 checkExitCode =<< rawSystem target opts
+ 32
+ 33 checkExitCode :: ExitCode -> IO ()
+ 34 checkExitCode ExitSuccess = return ()
+ 35 checkExitCode (ExitFailure n) = exitWith (ExitFailure n)
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick.hs.html
new file mode 100644
index 0000000..b96e488
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick.hs.html
@@ -0,0 +1,41 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Driver.Magick
+ 2 ( magickCmd
+ 3 ) where
+ 4
+ 5 import System.IO.Unsafe (unsafePerformIO)
+ 6 import System.Directory (findExecutable)
+ 7
+ 8 -- |The name of the ImageMagick command. On Unix-like operating systems, the
+ 9 -- command 'convert' does not conflict with the name of other commands. On
+ 10 -- Windows, ImageMagick version 7 is readily available, the command 'magick'
+ 11 -- should be present, and is preferred over 'convert'. If it is not present,
+ 12 -- 'convert' is assumed to be the relevant command.
+ 13 magickCmd :: String
+ 14 -- The use of 'unsafeperformIO' is justified on the basis that if 'magick' is
+ 15 -- found once, it will always be present.
+ 16 magickCmd = unsafePerformIO $ do
+ 17 mPath <- findExecutable "magick"
+ 18 pure $ maybe "convert" (const "magick") mPath
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Driver.Server.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Driver.Server.hs.html
new file mode 100644
index 0000000..b319148
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Driver.Server.hs.html
@@ -0,0 +1,321 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 {-# LANGUAGE OverloadedStrings #-}
+ 2 {-# LANGUAGE ScopedTypeVariables #-}
+ 3 module Reanimate.Driver.Server
+ 4 ( serve
+ 5 , findOwnSource
+ 6 ) where
+ 7
+ 8 import Control.Concurrent
+ 9 import Control.Exception (SomeException, catch, finally)
+ 10 import Control.Monad
+ 11 import Data.IORef
+ 12 import Data.Text (Text)
+ 13 import qualified Data.Text as T
+ 14 import qualified Data.Text.Read as T
+ 15 import Data.Time
+ 16 import GHC.Environment (getFullArgs)
+ 17 import Language.Haskell.Ghcid
+ 18 import Network.WebSockets
+ 19 import Paths_reanimate
+ 20 import Reanimate.Misc (runCmdLazy, runCmd_)
+ 21 import System.Directory (createDirectoryIfMissing,
+ 22 doesFileExist, findFile, listDirectory,
+ 23 makeAbsolute,
+ 24 withCurrentDirectory)
+ 25 import System.Environment (getProgName)
+ 26 import System.Exit
+ 27 import System.FilePath
+ 28 import System.FSNotify
+ 29 import System.IO
+ 30 import System.IO.Temp
+ 31 import System.Process
+ 32 import Web.Browser (openBrowser)
+ 33
+ 34 opts :: ConnectionOptions
+ 35 opts = defaultConnectionOptions
+ 36 { connectionCompressionOptions = PermessageDeflateCompression defaultPermessageDeflate }
+ 37
+ 38 serve :: Bool -> Maybe FilePath -> [String] -> Maybe FilePath -> IO ()
+ 39 serve verbose mbGHCPath extraGHCOpts mbSelfPath = withManager $ \watch -> do
+ 40 hSetBuffering stdin NoBuffering
+ 41 self <- maybe requireOwnSource pure mbSelfPath
+ 42 when verbose $
+ 43 logMsg $ "Found own source code at: " ++ self
+ 44 hasConnectionVar <- newMVar False
+ 45
+ 46 ghci <- ghciBackend mbGHCPath self
+ 47
+ 48 -- There might already browser window open. Wait 2s to see if that window
+ 49 -- connects to us. If not, open a new window.
+ 50 _ <- forkIO $ do
+ 51 threadDelay (2*10^(6::Int))
+ 52 hasConn <- readMVar hasConnectionVar
+ 53 unless hasConn openViewer
+ 54 logMsg "Listening..."
+ 55 let options = ServerOptions
+ 56 { serverHost = "127.0.0.1"
+ 57 , serverPort = 9161
+ 58 , serverConnectionOptions = opts
+ 59 , serverRequirePong = Nothing }
+ 60 withSystemTempDirectory "reanimate-svgs" $ \tmpDir ->
+ 61 runServerWithOptions options $ \pending -> do
+ 62 logMsg "New connection received."
+ 63 hasConn <- swapMVar hasConnectionVar True
+ 64 if hasConn
+ 65 then do
+ 66 logMsg "Already connected to browser. Rejecting."
+ 67 rejectRequestWith pending defaultRejectRequest
+ 68 else do
+ 69 createDirectoryIfMissing True tmpDir
+ 70 conn <- acceptRequest pending
+ 71 slave <- newEmptyMVar
+ 72 let handler = modifyMVar_ slave $ \tid -> do
+ 73 logMsg "Reloading code..."
+ 74 killThread tid
+ 75 forkIO $ ignoreErrors $ slaveHandler verbose mbGHCPath extraGHCOpts conn ghci self tmpDir
+ 76 killSlave = do
+ 77 tid <- takeMVar slave
+ 78 killThread tid
+ 79 stop <- watchFile watch self handler
+ 80 putMVar slave =<< forkIO (return ())
+ 81 handler
+ 82 let loop = do
+ 83 -- FIXME: We don't use msg here.
+ 84 _msg <- receiveData conn :: IO T.Text
+ 85 handler
+ 86 loop
+ 87 cleanup = do
+ 88 stop
+ 89 killSlave
+ 90 _ <- swapMVar hasConnectionVar False
+ 91 return ()
+ 92 loop `finally` cleanup
+ 93
+ 94 ignoreErrors :: IO () -> IO ()
+ 95 ignoreErrors action = action `catch` \(_::SomeException) -> return ()
+ 96
+ 97 openViewer :: IO ()
+ 98 openViewer = do
+ 99 url <- getDataFileName "viewer-elm/dist/index.html"
+ 100 logMsg "Opening browser..."
+ 101 bSucc <- openBrowser url
+ 102 if bSucc
+ 103 then logMsg "Browser opened."
+ 104 else hPutStrLn stderr $ "Failed to open browser. Manually visit: " ++ url
+ 105
+ 106 slaveHandler :: Bool -> Maybe FilePath -> [String] -> Connection -> GhciBackend
+ 107 -> FilePath -> FilePath -> IO ()
+ 108 slaveHandler verbose mbGHCPath extraGHCOpts conn ghci self svgDir =
+ 109 withCurrentDirectory (takeDirectory self) $
+ 110 withSystemTempDirectory "reanimate" $ \tmpDir ->
+ 111 withTempFile tmpDir "reanimate.exe" $ \tmpExecutable handle -> do
+ 112 outputFolder <- createTempDirectory svgDir "svgs"
+ 113 let frameFileName frameIdx =
+ 114 outputFolder </> show frameIdx <.> "svg"
+ 115
+ 116 sentFrameCount <- newMVar False
+ 117 hClose handle
+ 118 lock <- newMVar ()
+ 119 sendWebMessage conn $ WebStatus "Compiling"
+ 120 ghciThread <- forkIO $ do
+ 121 firstFrame <- newIORef True
+ 122 ghciReload ghci
+ 123 logMsg "GHCi reload done."
+ 124 ghciGenerate ghci outputFolder $ \frameIdx -> do
+ 125 first <- readIORef firstFrame
+ 126 writeIORef firstFrame False
+ 127 if first
+ 128 then do
+ 129 modifyMVar_ sentFrameCount $ \sent -> do
+ 130 unless sent $
+ 131 sendWebMessage conn $ WebFrameCount frameIdx
+ 132 logMsg "Framecount sent."
+ 133 return True
+ 134 else
+ 135 withMVar lock $ \_ ->
+ 136 sendWebMessage conn $ WebFrame frameIdx (frameFileName frameIdx)
+ 137 logMsg "GHCi render done."
+ 138 ret <- case mbGHCPath of
+ 139 Nothing -> do
+ 140 let args = ["ghc", "--"] ++ ghcOptions tmpDir ++ extraGHCOpts ++ [takeFileName self, "-o", tmpExecutable]
+ 141 when verbose $
+ 142 logMsg $ "Running: " ++ showCommandForUser "stack" args
+ 143 runCmd_ "stack" args
+ 144 Just ghc -> do
+ 145 let args = ghcOptions tmpDir ++ extraGHCOpts ++ [takeFileName self, "-o", tmpExecutable]
+ 146 when verbose $
+ 147 logMsg $ "Running: " ++ showCommandForUser ghc args
+ 148 runCmd_ ghc args
+ 149 logMsg "Compile done."
+ 150 case ret of
+ 151 Left err ->
+ 152 sendWebMessage conn $ WebError $ unlines (lines err)
+ 153 Right{} -> runCmdLazy tmpExecutable (execOpts outputFolder) $ \getFrame -> do
+ 154 frameCount <- expectFrame =<< getFrame
+ 155 modifyMVar_ sentFrameCount $ \sent -> do
+ 156 unless sent $
+ 157 sendWebMessage conn $ WebFrameCount frameCount
+ 158 return True
+ 159 replicateM_ frameCount $ do
+ 160 frameIdx <- expectFrame =<< getFrame
+ 161 withMVar lock $ \_ ->
+ 162 sendWebMessage conn $ WebFrame frameIdx (frameFileName frameIdx)
+ 163 logMsg "Optimized render done."
+ 164 killThread ghciThread
+ 165 where
+ 166 execOpts output =
+ 167 [ "raw", "--output", output, "--offset", "1"
+ 168 , "+RTS", "-N", "-M2G", "-RTS"]
+ 169 expectFrame :: Either String Text -> IO Int
+ 170 expectFrame (Left "") = do
+ 171 sendWebMessage conn $ WebStatus "Done"
+ 172 exitSuccess
+ 173 expectFrame (Left err) = do
+ 174 sendWebMessage conn $ WebError err
+ 175 exitWith (ExitFailure 1)
+ 176 expectFrame (Right frame) =
+ 177 case T.decimal frame of
+ 178 Left err -> do
+ 179 hPutStrLn stderr (T.unpack frame)
+ 180 hPutStrLn stderr $ "expectFrame: " ++ err
+ 181 sendWebMessage conn $ WebError err
+ 182 exitWith (ExitFailure 1)
+ 183 Right (frameNumber, "") ->
+ 184 pure frameNumber
+ 185 Right {} -> do
+ 186 let err = "Unexpected output"
+ 187 hPutStrLn stderr (T.unpack frame)
+ 188 hPutStrLn stderr $ "expectFrame: " ++ err
+ 189 sendWebMessage conn $ WebError err
+ 190 exitWith (ExitFailure 1)
+ 191
+ 192 watchFile :: WatchManager -> FilePath -> IO () -> IO StopListening
+ 193 watchFile watch file action = watchTree watch (takeDirectory file) check (const action)
+ 194 where
+ 195 check event =
+ 196 takeFileName (eventPath event) == takeFileName file ||
+ 197 takeExtension (eventPath event) `elem` sourceExtensions ||
+ 198 takeExtension (eventPath event) `elem` dataExtensions
+ 199 sourceExtensions = [".hs", ".lhs"]
+ 200 dataExtensions = [".jpg", ".png", ".bmp", ".pov", ".tex", ".csv"]
+ 201
+ 202 ghcOptions :: FilePath -> [String]
+ 203 ghcOptions tmpDir =
+ 204 ["-rtsopts", "--make", "-threaded", "-O2"] ++
+ 205 ["-odir", tmpDir, "-hidir", tmpDir]
+ 206
+ 207 -- FIXME: Move to a different module
+ 208 requireOwnSource :: IO FilePath
+ 209 requireOwnSource = do
+ 210 mbSelf <- findOwnSource
+ 211 case mbSelf of
+ 212 Nothing -> do
+ 213 hPutStrLn stderr
+ 214 "Rendering in browser window is only available when interpreting.\n\
+ 215 \To render a video file, use the 'render' command or run again with --help\n\
+ 216 \to see all available options."
+ 217 exitFailure
+ 218 Just self -> pure self
+ 219
+ 220 findOwnSource :: IO (Maybe FilePath)
+ 221 findOwnSource = do
+ 222 fullArgs <- getFullArgs
+ 223 stackSource <- makeAbsolute (last fullArgs)
+ 224 exist <- doesFileExist stackSource
+ 225 if exist && isHaskellFile stackSource
+ 226 then return (Just stackSource)
+ 227 else do
+ 228 prog <- getProgName
+ 229 let hsProg
+ 230 | isHaskellFile prog = prog
+ 231 | otherwise = replaceExtension prog "hs"
+ 232 lst <- listDirectory "."
+ 233 findFile ("." : lst) hsProg
+ 234
+ 235 isHaskellFile :: FilePath -> Bool
+ 236 isHaskellFile path = takeExtension path `elem` [".hs", ".lhs"]
+ 237
+ 238 logMsg :: String -> IO ()
+ 239 logMsg msg = do
+ 240 now <- getCurrentTime
+ 241 putStrLn $ formatTime defaultTimeLocale fmt now ++ ": " ++ msg
+ 242 where
+ 243 fmt = "%F %T%2Q"
+ 244
+ 245 -------------------------------------------------------------------------------
+ 246 -- Ghci interface
+ 247
+ 248 -- stack
+ 249 -- cabal
+ 250 -- raw
+ 251 -- none?
+ 252 data GhciBackend = GhciBackend (MVar Ghci)
+ 253
+ 254 ghciBackend :: Maybe FilePath -> FilePath -> IO GhciBackend
+ 255 ghciBackend mbGHCPath self = do
+ 256 let ghciProc =
+ 257 case mbGHCPath of
+ 258 Just ghcPath ->
+ 259 proc ghcPath $ ["--interactive", "+RTS"] ++ words memoryLimit ++ ["-RTS"]
+ 260 Nothing ->
+ 261 proc "stack" ["exec", "ghci", "--rts-options="++memoryLimit]
+ 262 (ghci, _loads) <- startGhciProcess ghciProc $ \_stream _msg -> return ()
+ 263 void $ exec ghci $ ":load " ++ self
+ 264 ref <- newMVar ghci
+ 265 return $ GhciBackend ref
+ 266
+ 267 ghciReload :: GhciBackend -> IO ()
+ 268 ghciReload (GhciBackend ref) =
+ 269 withMVar ref $ \ghci ->
+ 270 void $ reload ghci
+ 271
+ 272 ghciGenerate :: GhciBackend -> FilePath -> (Int -> IO ()) -> IO ()
+ 273 ghciGenerate (GhciBackend ref) target cb = withMVar ref $ \ghci -> do
+ 274 execStream ghci (":main raw --output=" ++ target ++ " --offset=1")
+ 275 $ \_ msg ->
+ 276 case reads msg of
+ 277 [(frameIdx,"")] -> cb frameIdx
+ 278 _ -> return ()
+ 279
+ 280 memoryLimit :: String
+ 281 memoryLimit = "-M1G"
+ 282
+ 283 -------------------------------------------------------------------------------
+ 284 -- Websocket API
+ 285
+ 286 data WebMessage
+ 287 = WebStatus String
+ 288 | WebError String
+ 289 | WebFrameCount Int
+ 290 | WebFrame Int FilePath
+ 291
+ 292 sendWebMessage :: Connection -> WebMessage -> IO ()
+ 293 sendWebMessage conn msg = sendTextData conn $
+ 294 case msg of
+ 295 WebStatus txt -> T.pack "status\n" <> T.pack txt
+ 296 WebError txt -> T.pack "error\n" <> T.pack txt
+ 297 WebFrameCount n -> T.pack $ "frame_count\n" ++ show n
+ 298 WebFrame n path -> T.pack $ "frame\n" ++ show n ++ "\n" ++ path
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Driver.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Driver.hs.html
new file mode 100644
index 0000000..b870c32
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Driver.hs.html
@@ -0,0 +1,246 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 {-# LANGUAGE MultiWayIf #-}
+ 2 {-# LANGUAGE RecordWildCards #-}
+ 3 module Reanimate.Driver
+ 4 ( reanimate
+ 5 )
+ 6 where
+ 7
+ 8 import Control.Applicative ((<|>))
+ 9 import Control.Monad
+ 10 import Data.Maybe
+ 11 import Data.Either
+ 12 import Reanimate.Animation (Animation)
+ 13 import Reanimate.Driver.Check
+ 14 import Reanimate.Driver.CLI
+ 15 import Reanimate.Driver.Compile
+ 16 import Reanimate.Driver.Server
+ 17 import Reanimate.Parameters
+ 18 import Reanimate.Render (render, renderSnippets, renderSvgs,
+ 19 selectRaster)
+ 20 import System.Directory
+ 21 import System.Exit
+ 22 import System.FilePath
+ 23 import System.IO
+ 24 import Text.Printf
+ 25
+ 26 presetFormat :: Preset -> Format
+ 27 presetFormat Youtube = RenderMp4
+ 28 presetFormat ExampleGif = RenderGif
+ 29 presetFormat Quick = RenderMp4
+ 30 presetFormat MediumQ = RenderMp4
+ 31 presetFormat HighQ = RenderMp4
+ 32 presetFormat LowFPS = RenderMp4
+ 33
+ 34 presetFPS :: Preset -> FPS
+ 35 presetFPS Youtube = 60
+ 36 presetFPS ExampleGif = 25
+ 37 presetFPS Quick = 15
+ 38 presetFPS MediumQ = 30
+ 39 presetFPS HighQ = 30
+ 40 presetFPS LowFPS = 10
+ 41
+ 42 presetWidth :: Preset -> Width
+ 43 presetWidth Youtube = 2560
+ 44 presetWidth ExampleGif = 320
+ 45 presetWidth Quick = 320
+ 46 presetWidth MediumQ = 800
+ 47 presetWidth HighQ = 1920
+ 48 presetWidth LowFPS = presetWidth HighQ
+ 49
+ 50 presetHeight :: Preset -> Height
+ 51 presetHeight preset = presetWidth preset * 9 `div` 16
+ 52
+ 53 formatFPS :: Format -> FPS
+ 54 formatFPS RenderMp4 = 60
+ 55 formatFPS RenderGif = 25
+ 56 formatFPS RenderWebm = 60
+ 57
+ 58 formatWidth :: Format -> Width
+ 59 formatWidth RenderMp4 = 2560
+ 60 formatWidth RenderGif = 320
+ 61 formatWidth RenderWebm = 2560
+ 62
+ 63 formatHeight :: Format -> Height
+ 64 formatHeight RenderMp4 = 1440
+ 65 formatHeight RenderGif = 180
+ 66 formatHeight RenderWebm = 1440
+ 67
+ 68 formatExtension :: Format -> String
+ 69 formatExtension RenderMp4 = "mp4"
+ 70 formatExtension RenderGif = "gif"
+ 71 formatExtension RenderWebm = "webm"
+ 72
+ 73 {-|
+ 74 Main entry-point for accessing an animation. Creates a program that takes the
+ 75 following command-line arguments:
+ 76
+ 77 > Usage: PROG [COMMAND]
+ 78 > This program contains an animation which can either be viewed in a web-browser
+ 79 > or rendered to disk.
+ 80 >
+ 81 > Available options:
+ 82 > -h,--help Show this help text
+ 83 >
+ 84 > Available commands:
+ 85 > check Run a system's diagnostic and report any missing
+ 86 > external dependencies.
+ 87 > view Play animation in browser window.
+ 88 > render Render animation to file.
+ 89
+ 90 Neither the 'check' nor the 'view' command take any additional arguments.
+ 91 Rendering animation can be controlled with these arguments:
+ 92
+ 93 > Usage: PROG render [-o|--target FILE] [--fps FPS] [-w|--width PIXELS]
+ 94 > [-h|--height PIXELS] [--compile] [--format FMT]
+ 95 > [--preset TYPE]
+ 96 > Render animation to file.
+ 97 >
+ 98 > Available options:
+ 99 > -o,--target FILE Write output to FILE
+ 100 > --fps FPS Set frames per second.
+ 101 > -w,--width PIXELS Set video width.
+ 102 > -h,--height PIXELS Set video height.
+ 103 > --compile Compile source code before rendering.
+ 104 > --format FMT Video format: mp4, gif, webm
+ 105 > --preset TYPE Parameter presets: youtube, gif, quick
+ 106 > -h,--help Show this help text
+ 107 -}
+ 108 reanimate :: Animation -> IO ()
+ 109 reanimate animation = do
+ 110 Options {..} <- getDriverOptions
+ 111 case optsCommand of
+ 112 Raw {..} -> do
+ 113 setFPS 60
+ 114 renderSvgs rawOutputFolder rawFrameOffset rawPrettyPrint animation
+ 115 Test -> do
+ 116 setNoExternals True
+ 117 -- hSetBinaryMode stdout True
+ 118 renderSnippets animation
+ 119 Check -> checkEnvironment
+ 120 View {..} -> serve viewVerbose viewGHCPath viewGHCOpts viewOrigin
+ 121 Render {..} -> do
+ 122 let fmt =
+ 123 guessParameter renderFormat (fmap presetFormat renderPreset)
+ 124 $ case renderTarget of
+ 125 -- Format guessed from output
+ 126 Just target -> case takeExtension target of
+ 127 ".mp4" -> RenderMp4
+ 128 ".gif" -> RenderGif
+ 129 ".webm" -> RenderWebm
+ 130 _ -> RenderMp4
+ 131 -- Default to mp4 rendering.
+ 132 Nothing -> RenderMp4
+ 133
+ 134 target <- case renderTarget of
+ 135 Nothing -> do
+ 136 mbSelf <- findOwnSource
+ 137 let ext = formatExtension fmt
+ 138 self = fromMaybe "output" mbSelf
+ 139 pure $ replaceExtension self ext
+ 140 Just target -> makeAbsolute target
+ 141
+ 142 let
+ 143 fps =
+ 144 guessParameter renderFPS (fmap presetFPS renderPreset) $ formatFPS fmt
+ 145 (width, height) = fromMaybe
+ 146 ( maybe (formatWidth fmt) presetWidth renderPreset
+ 147 , maybe (formatHeight fmt) presetHeight renderPreset
+ 148 )
+ 149 (userPreferredDimensions renderWidth renderHeight)
+ 150
+ 151 raster <-
+ 152 if renderRaster == RasterNone || renderRaster == RasterAuto then do
+ 153 svgSupport <- hasFFmpegRSvg
+ 154 if isRight svgSupport
+ 155 then selectRaster renderRaster
+ 156 else do
+ 157 raster <- selectRaster RasterAuto
+ 158 when (raster == RasterNone) $ do
+ 159 hPutStrLn stderr $
+ 160 "Error: your FFmpeg was built without SVG support and no raster engines \
+ 161 \are available. Please install either inkscape, imagemagick, or rsvg."
+ 162 exitWith (ExitFailure 1)
+ 163 return raster
+ 164 else selectRaster renderRaster
+ 165
+ 166 if renderCompile
+ 167 then compile $
+ 168 [ "render"
+ 169 , "--fps"
+ 170 , show fps
+ 171 , "--width"
+ 172 , show width
+ 173 , "--height"
+ 174 , show height
+ 175 , "--format"
+ 176 , showFormat fmt
+ 177 , "--raster"
+ 178 , showRaster raster
+ 179 , "--target"
+ 180 , target
+ 181 , "+RTS"
+ 182 , "-N"
+ 183 , "-RTS"
+ 184 ] ++ [ "--partial" | renderPartial ]
+ 185 else do
+ 186 setRaster raster
+ 187 setFPS fps
+ 188 setWidth width
+ 189 setHeight height
+ 190 printf
+ 191 "Animation options:\n\
+ 192 \ fps: %d\n\
+ 193 \ width: %d\n\
+ 194 \ height: %d\n\
+ 195 \ fmt: %s\n\
+ 196 \ target: %s\n\
+ 197 \ raster: %s\n"
+ 198 fps
+ 199 width
+ 200 height
+ 201 (showFormat fmt)
+ 202 target
+ 203 (show raster)
+ 204
+ 205 render animation target raster fmt width height fps renderPartial
+ 206
+ 207 guessParameter :: Maybe a -> Maybe a -> a -> a
+ 208 guessParameter a b def = fromMaybe def (a <|> b)
+ 209
+ 210
+ 211 -- If user specifies exactly one dimension explicitly, calculate the other
+ 212 userPreferredDimensions :: Maybe Width -> Maybe Height -> Maybe (Width, Height)
+ 213 userPreferredDimensions (Just width) (Just height) = Just (width, height)
+ 214 userPreferredDimensions (Just width) Nothing =
+ 215 Just (width, makeEven $ width * 9 `div` 16)
+ 216 userPreferredDimensions Nothing (Just height) =
+ 217 Just (makeEven $ height * 16 `div` 9, height)
+ 218 userPreferredDimensions Nothing Nothing = Nothing
+ 219
+ 220 -- Avoid ffmpeg failures "height not divisible by 2"
+ 221 makeEven :: Int -> Int
+ 222 makeEven x | even x = x
+ 223 | otherwise = x - 1
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Ease.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Ease.hs.html
new file mode 100644
index 0000000..f0f27de
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Ease.hs.html
@@ -0,0 +1,130 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Ease
+ 2 ( Signal
+ 3 , constantS
+ 4 , fromToS
+ 5 , reverseS
+ 6 , curveS
+ 7 , powerS
+ 8 , bellS
+ 9 , oscillateS
+ 10 , fromListS
+ 11 , cubicBezierS
+ 12 ) where
+ 13
+ 14 -- | Signals are time-varying variables. Signals can be composed using function
+ 15 -- composition.
+ 16 type Signal = Double -> Double
+ 17
+ 18 fromListS :: [(Double, Signal)] -> Signal
+ 19 fromListS fns t = worker 0 fns
+ 20 where
+ 21 worker _ [] = 0
+ 22 worker now [(len, fn)] = fn (min 1 ((t-now) / min (1-now) len))
+ 23 worker now ((len, fn):rest)
+ 24 | now+len < t = worker (now+len) rest
+ 25 | otherwise = fn ((t-now) / len)
+ 26
+ 27 -- | Constant signal.
+ 28 --
+ 29 -- Example:
+ 30 --
+ 31 -- > signalA (constantS 0.5) drawProgress
+ 32 --
+ 33 -- <<docs/gifs/doc_constantS.gif>>
+ 34 constantS :: Double -> Signal
+ 35 constantS = const
+ 36
+ 37 -- | Signal with new starting and end values.
+ 38 --
+ 39 -- Example:
+ 40 --
+ 41 -- > signalA (fromToS 0.8 0.2) drawProgress
+ 42 --
+ 43 -- <<docs/gifs/doc_fromToS.gif>>
+ 44 fromToS :: Double -> Double -> Signal
+ 45 fromToS from to t = from + (to-from)*t
+ 46
+ 47 -- | Reverse signal order.
+ 48 --
+ 49 -- Example:
+ 50 --
+ 51 -- > signalA reverseS drawProgress
+ 52 --
+ 53 -- <<docs/gifs/doc_reverseS.gif>>
+ 54 reverseS :: Signal
+ 55 reverseS t = 1-t
+ 56
+ 57 -- | S-curve signal. Takes a steepness parameter. 2 is a good default.
+ 58 --
+ 59 -- Example:
+ 60 --
+ 61 -- > signalA (curveS 2) drawProgress
+ 62 --
+ 63 -- <<docs/gifs/doc_curveS.gif>>
+ 64 curveS :: Double -> Signal
+ 65 curveS steepness s =
+ 66 if s < 0.5
+ 67 then 0.5 * (2*s)**steepness
+ 68 else 1-0.5 * (2 - 2*s)**steepness
+ 69
+ 70 powerS :: Double -> Signal
+ 71 powerS steepness s = s**steepness
+ 72
+ 73 -- | Oscillate signal.
+ 74 --
+ 75 -- Example:
+ 76 --
+ 77 -- > signalA oscillateS drawProgress
+ 78 --
+ 79 -- <<docs/gifs/doc_oscillateS.gif>>
+ 80 oscillateS :: Signal
+ 81 oscillateS t =
+ 82 if t < 1/2
+ 83 then t*2
+ 84 else 2-t*2
+ 85
+ 86 -- | Bell-curve signal. Takes a steepness parameter. 2 is a good default.
+ 87 --
+ 88 -- Example:
+ 89 --
+ 90 -- > signalA (bellS 2) drawProgress
+ 91 --
+ 92 -- <<docs/gifs/doc_bellS.gif>>
+ 93 bellS :: Double -> Signal
+ 94 bellS steepness = curveS steepness . oscillateS
+ 95
+ 96 -- | Cubic Bezier signal. Gives you a fair amount of control over how the
+ 97 -- signal will 'curve'.
+ 98 --
+ 99 -- Example:
+ 100 --
+ 101 -- > signalA (cubicBezierS (0.0, 0.8, 0.9, 1.0)) drawProgress
+ 102 --
+ 103 -- <<docs/gifs/doc_cubicBezierS.gif>>
+ 104 cubicBezierS :: (Double, Double, Double, Double) -> Signal
+ 105 cubicBezierS (x1, x2, x3, x4) s =
+ 106 let ms = 1-s
+ 107 in x1*ms^(3::Int) + 3*x2*ms^(2::Int)*s + 3*x3*ms*s^(2::Int) + x4*s^(3::Int)
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Internal.CubicBezier.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Internal.CubicBezier.hs.html
new file mode 100644
index 0000000..21485d4
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Internal.CubicBezier.hs.html
@@ -0,0 +1,287 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 {-# LANGUAGE FunctionalDependencies #-}
+ 2 {-# LANGUAGE MultiParamTypeClasses #-}
+ 3 {-# LANGUAGE UndecidableInstances #-}
+ 4 module Reanimate.Internal.CubicBezier
+ 5 ( AnyBezier(..)
+ 6 , CubicBezier(..)
+ 7 , QuadBezier(..)
+ 8 , OpenPath(..)
+ 9 , ClosedPath(..)
+ 10 , PathJoin(..)
+ 11 , ClosedMetaPath(..)
+ 12 , OpenMetaPath(..)
+ 13 , MetaJoin(..)
+ 14 , MetaNodeType(..)
+ 15 , C.GenericBezier(..)
+ 16 , C.FillRule(..)
+ 17 , C.Tension(..)
+ 18 , quadToCubic
+ 19 , arcLength
+ 20 , arcLengthParam
+ 21 , C.splitBezier
+ 22 , colinear
+ 23 , evalBezier
+ 24 , evalBezierDeriv
+ 25 , bezierHoriz
+ 26 , bezierVert
+ 27 , C.bezierSubsegment
+ 28 , C.reorient
+ 29 , closedPathCurves
+ 30 , openPathCurves
+ 31 , curvesToClosed
+ 32 , closest
+ 33 , unmetaOpen
+ 34 , unmetaClosed
+ 35 , union
+ 36 , bezierIntersection
+ 37 , interpolateVector
+ 38 , vectorDistance
+ 39 , findBezierInflection
+ 40 , findBezierCusp
+ 41 ) where
+ 42
+ 43 import qualified Data.Vector.Unboxed as V
+ 44 import qualified Geom2D.CubicBezier as C
+ 45 import Linear.V2
+ 46
+ 47 ------------------------------------------------------------
+ 48 -- Data types
+ 49
+ 50 newtype AnyBezier a = AnyBezier (V.Vector (V2 a))
+ 51
+ 52 data CubicBezier a = CubicBezier
+ 53 { cubicC0 :: !(V2 a)
+ 54 , cubicC1 :: !(V2 a)
+ 55 , cubicC2 :: !(V2 a)
+ 56 , cubicC3 :: !(V2 a)
+ 57 } deriving (Show, Eq)
+ 58
+ 59 data QuadBezier a = QuadBezier
+ 60 { quadC0 :: !(V2 a)
+ 61 , quadC1 :: !(V2 a)
+ 62 , quadC2 :: !(V2 a)
+ 63 } deriving (Show, Eq)
+ 64
+ 65 data OpenPath a = OpenPath [(V2 a, PathJoin a)] (V2 a)
+ 66 deriving (Show, Eq)
+ 67 data ClosedPath a = ClosedPath [(V2 a, PathJoin a)]
+ 68 deriving (Show, Eq)
+ 69
+ 70 data PathJoin a
+ 71 = JoinLine
+ 72 | JoinCurve (V2 a) (V2 a)
+ 73 deriving (Show, Eq)
+ 74
+ 75 data ClosedMetaPath a = ClosedMetaPath [(V2 a, MetaJoin a)]
+ 76 deriving (Show, Eq)
+ 77 data OpenMetaPath a = OpenMetaPath [(V2 a, MetaJoin a)] (V2 a)
+ 78 deriving (Show, Eq)
+ 79
+ 80 data MetaJoin a
+ 81 = MetaJoin
+ 82 { metaTypeL :: MetaNodeType a
+ 83 , tensionL :: C.Tension a
+ 84 , tensionR :: C.Tension a
+ 85 , metaTypeR :: MetaNodeType a
+ 86 }
+ 87 | Controls (V2 a) (V2 a)
+ 88 deriving (Show, Eq)
+ 89
+ 90 data MetaNodeType a
+ 91 = Open
+ 92 | Curl { curlgamma :: a }
+ 93 | Direction { nodedir :: V2 a }
+ 94 deriving (Show, Eq)
+ 95
+ 96 ------------------------------------------------------------
+ 97 -- Methods
+ 98
+ 99 quadToCubic :: Fractional a => QuadBezier a -> CubicBezier a
+ 100 quadToCubic = upCast . C.quadToCubic . downCast
+ 101
+ 102 arcLength :: CubicBezier Double -> Double -> Double -> Double
+ 103 arcLength bezier t tol = C.arcLength (downCast bezier) t tol
+ 104
+ 105 arcLengthParam :: CubicBezier Double -> Double -> Double -> Double
+ 106 arcLengthParam bezier t tol = C.arcLengthParam (downCast bezier) t tol
+ 107
+ 108 colinear :: CubicBezier Double -> Double -> Bool
+ 109 colinear bezier tol = C.colinear (downCast bezier) tol
+ 110
+ 111 evalBezier :: (C.GenericBezier b, V.Unbox a, Fractional a) => b a -> a -> V2 a
+ 112 evalBezier c p = upCast $ C.evalBezier c p
+ 113
+ 114 evalBezierDeriv :: (V.Unbox a, Fractional a,C.GenericBezier b) => b a -> a -> (V2 a, V2 a)
+ 115 evalBezierDeriv c p = upCast $ C.evalBezierDeriv c p
+ 116
+ 117 bezierHoriz :: CubicBezier Double -> [Double]
+ 118 bezierHoriz = C.bezierHoriz . downCast
+ 119
+ 120 bezierVert :: CubicBezier Double -> [Double]
+ 121 bezierVert = C.bezierVert . downCast
+ 122
+ 123 unmetaOpen :: OpenMetaPath Double -> OpenPath Double
+ 124 unmetaOpen = upCast . C.unmetaOpen . downCast
+ 125
+ 126 unmetaClosed :: ClosedMetaPath Double -> ClosedPath Double
+ 127 unmetaClosed = upCast . C.unmetaClosed . downCast
+ 128
+ 129 union :: [ClosedPath Double] -> C.FillRule -> Double -> [ClosedPath Double]
+ 130 union p fill tol = upCast (C.union (downCast p) fill tol)
+ 131
+ 132 bezierIntersection :: CubicBezier Double -> CubicBezier Double -> Double -> [(Double, Double)]
+ 133 bezierIntersection a b t = C.bezierIntersection (downCast a) (downCast b) t
+ 134
+ 135 closest :: CubicBezier Double -> V2 Double -> Double -> Double
+ 136 closest c p t = C.closest (downCast c) (downCast p) t
+ 137
+ 138 closedPathCurves :: Fractional a => ClosedPath a -> [CubicBezier a]
+ 139 closedPathCurves = upCast . C.closedPathCurves . downCast
+ 140
+ 141 openPathCurves :: Fractional a => OpenPath a -> [CubicBezier a]
+ 142 openPathCurves = upCast . C.openPathCurves . downCast
+ 143
+ 144 curvesToClosed :: [CubicBezier a] -> ClosedPath a
+ 145 curvesToClosed = upCast . C.curvesToClosed . downCast
+ 146
+ 147 interpolateVector :: Num a => V2 a -> V2 a -> a -> V2 a
+ 148 interpolateVector a b p = upCast $ C.interpolateVector (downCast a) (downCast b) p
+ 149
+ 150 vectorDistance :: Floating a => V2 a -> V2 a -> a
+ 151 vectorDistance a b = C.vectorDistance (downCast a) (downCast b)
+ 152
+ 153 findBezierInflection :: CubicBezier Double -> [Double]
+ 154 findBezierInflection = C.findBezierInflection . downCast
+ 155
+ 156 findBezierCusp :: CubicBezier Double -> [Double]
+ 157 findBezierCusp = C.findBezierCusp . downCast
+ 158
+ 159 ------------------------------------------------------------
+ 160 -- Instances
+ 161
+ 162 instance C.GenericBezier QuadBezier where
+ 163 degree = C.degree . downCast
+ 164 toVector = C.toVector . downCast
+ 165 unsafeFromVector = upCast . C.unsafeFromVector
+ 166
+ 167 instance C.GenericBezier CubicBezier where
+ 168 degree = C.degree . downCast
+ 169 toVector = C.toVector . downCast
+ 170 unsafeFromVector = upCast . C.unsafeFromVector
+ 171
+ 172 instance C.GenericBezier AnyBezier where
+ 173 degree = C.degree . downCast
+ 174 toVector = C.toVector . downCast
+ 175 unsafeFromVector = upCast . C.unsafeFromVector
+ 176
+ 177 ------------------------------------------------------------
+ 178 -- Casting
+ 179
+ 180 class Cast a b | a -> b, b -> a where
+ 181 downCast :: a -> b
+ 182 upCast :: b -> a
+ 183
+ 184 instance Cast a b => Cast [a] [b] where
+ 185 downCast = map downCast
+ 186 upCast = map upCast
+ 187
+ 188 instance (Cast a a', Cast b b') => Cast (a,b) (a',b') where
+ 189 downCast (a, b) = (downCast a, downCast b)
+ 190 upCast (a, b) = (upCast a, upCast b)
+ 191
+ 192 instance Cast (V2 a) (C.Point a) where
+ 193 downCast (V2 a b) = C.Point a b
+ 194 upCast (C.Point a b) = V2 a b
+ 195
+ 196 instance Cast (CubicBezier a) (C.CubicBezier a) where
+ 197 downCast (CubicBezier a b c d) = C.CubicBezier
+ 198 (downCast a) (downCast b) (downCast c) (downCast d)
+ 199 upCast (C.CubicBezier a b c d) = CubicBezier
+ 200 (upCast a) (upCast b) (upCast c) (upCast d)
+ 201
+ 202 instance Cast (QuadBezier a) (C.QuadBezier a) where
+ 203 downCast (QuadBezier a b c) = C.QuadBezier
+ 204 (downCast a) (downCast b) (downCast c)
+ 205 upCast (C.QuadBezier a b c)= QuadBezier
+ 206 (upCast a) (upCast b) (upCast c)
+ 207
+ 208 instance V.Unbox a => Cast (AnyBezier a) (C.AnyBezier a) where
+ 209 downCast (AnyBezier arr) = C.AnyBezier $
+ 210 V.map (\(V2 a b) -> (a,b)) arr
+ 211 upCast (C.AnyBezier arr) = AnyBezier $
+ 212 V.map (\(a, b) -> V2 a b) arr
+ 213
+ 214 instance Cast (MetaNodeType a) (C.MetaNodeType a) where
+ 215 downCast Open = C.Open
+ 216 downCast (Curl gamma) = C.Curl gamma
+ 217 downCast (Direction dir) = C.Direction (downCast dir)
+ 218 upCast C.Open = Open
+ 219 upCast (C.Curl gamma) = Curl gamma
+ 220 upCast (C.Direction dir) = Direction (upCast dir)
+ 221
+ 222 instance Cast (MetaJoin a) (C.MetaJoin a) where
+ 223 downCast (MetaJoin tyL tL tR tyR) = C.MetaJoin (downCast tyL) tL tR (downCast tyR)
+ 224 downCast (Controls p1 p2) = C.Controls (downCast p1) (downCast p2)
+ 225 upCast (C.MetaJoin tyL tL tR tyR) = MetaJoin (upCast tyL) tL tR (upCast tyR)
+ 226 upCast (C.Controls p1 p2) = Controls (upCast p1) (upCast p2)
+ 227
+ 228 instance Cast (PathJoin a) (C.PathJoin a) where
+ 229 downCast JoinLine = C.JoinLine
+ 230 downCast (JoinCurve a b) = C.JoinCurve (downCast a) (downCast b)
+ 231 upCast C.JoinLine = JoinLine
+ 232 upCast (C.JoinCurve a b) = JoinCurve (upCast a) (upCast b)
+ 233
+ 234 instance Cast (OpenMetaPath a) (C.OpenMetaPath a) where
+ 235 downCast (OpenMetaPath lst end) = C.OpenMetaPath
+ 236 [ (downCast p, downCast j)
+ 237 | (p, j) <- lst ] (downCast end)
+ 238 upCast (C.OpenMetaPath lst end) = OpenMetaPath
+ 239 [ (upCast p, upCast j)
+ 240 | (p, j) <- lst ] (upCast end)
+ 241
+ 242 instance Cast (ClosedMetaPath a) (C.ClosedMetaPath a) where
+ 243 downCast (ClosedMetaPath lst) = C.ClosedMetaPath
+ 244 [ (downCast p, downCast j)
+ 245 | (p, j) <- lst ]
+ 246 upCast (C.ClosedMetaPath lst) = ClosedMetaPath
+ 247 [ (upCast p, upCast j)
+ 248 | (p, j) <- lst ]
+ 249
+ 250 instance Cast (OpenPath a) (C.OpenPath a) where
+ 251 downCast (OpenPath lst end) = C.OpenPath
+ 252 [ (downCast p, downCast j)
+ 253 | (p, j) <- lst ] (downCast end)
+ 254 upCast (C.OpenPath lst end) = OpenPath
+ 255 [ (upCast p, upCast j)
+ 256 | (p, j) <- lst ] (upCast end)
+ 257
+ 258 instance Cast (ClosedPath a) (C.ClosedPath a) where
+ 259 downCast (ClosedPath lst) = C.ClosedPath
+ 260 [ (downCast p, downCast j)
+ 261 | (p, j) <- lst ]
+ 262 upCast (C.ClosedPath lst) = ClosedPath
+ 263 [ (upCast p, upCast j)
+ 264 | (p, j) <- lst ]
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Misc.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Misc.hs.html
new file mode 100644
index 0000000..7a10433
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Misc.hs.html
@@ -0,0 +1,131 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Misc
+ 2 ( requireExecutable
+ 3 , runCmd
+ 4 , runCmd_
+ 5 , runCmdLazy
+ 6 , withTempDir
+ 7 , withTempFile
+ 8 , renameOrCopyFile
+ 9 ) where
+ 10
+ 11 import Control.Concurrent
+ 12 import Control.Exception (catch, evaluate, finally, throw)
+ 13 import qualified Data.Text as T
+ 14 import qualified Data.Text.IO as T
+ 15 import Foreign.C.Error
+ 16 import GHC.IO.Exception
+ 17 import System.Directory (copyFile, findExecutable, removeFile,
+ 18 renameFile)
+ 19 import System.FilePath ((<.>))
+ 20 import System.IO (hClose, hGetContents, hIsEOF, hPutStr,
+ 21 stderr)
+ 22 import System.IO.Temp (withSystemTempDirectory,
+ 23 withSystemTempFile)
+ 24 import System.Process (readProcessWithExitCode,
+ 25 runInteractiveProcess, showCommandForUser,
+ 26 terminateProcess, waitForProcess)
+ 27
+ 28
+ 29 requireExecutable :: String -> IO FilePath
+ 30 requireExecutable exec = do
+ 31 mbPath <- findExecutable exec
+ 32 case mbPath of
+ 33 Nothing -> error $ "Couldn't find executable: " ++ exec
+ 34 Just path -> return path
+ 35
+ 36 runCmd :: FilePath -> [String] -> IO ()
+ 37 runCmd exec args = do
+ 38 ret <- runCmd_ exec args
+ 39 case ret of
+ 40 Left err -> error $ showCommandForUser exec args ++ ":\n" ++ err
+ 41 Right{} -> return ()
+ 42
+ 43 runCmd_ :: FilePath -> [String] -> IO (Either String String)
+ 44 runCmd_ exec args = do
+ 45 (ret, stdout, errMsg) <- readProcessWithExitCode exec args ""
+ 46 _ <- evaluate (length stdout + length errMsg)
+ 47 case ret of
+ 48 ExitSuccess -> return (Right stdout)
+ 49 ExitFailure err | False ->
+ 50 return
+ 51 $ Left
+ 52 $ "Failed to run: "
+ 53 ++ showCommandForUser exec args
+ 54 ++ "\n"
+ 55 ++ "Error code: "
+ 56 ++ show err
+ 57 ++ "\n"
+ 58 ++ "stderr: "
+ 59 ++ errMsg
+ 60 ExitFailure{} | null errMsg -> -- LaTeX prints errors to stdout. :(
+ 61 return $ Left stdout
+ 62 ExitFailure{} -> return $ Left errMsg
+ 63
+ 64 runCmdLazy
+ 65 :: FilePath -> [String] -> (IO (Either String T.Text) -> IO a) -> IO a
+ 66 runCmdLazy exec args handler = do
+ 67 (inp, out, err, pid) <- runInteractiveProcess exec args Nothing Nothing
+ 68 hClose inp
+ 69 errOutput <- hGetContents err
+ 70 _ <- forkIO $ hPutStr stderr errOutput
+ 71 let fetch = do
+ 72 eof <- hIsEOF out
+ 73 if eof
+ 74 then do
+ 75 _ <- evaluate (length errOutput)
+ 76 ret <- waitForProcess pid
+ 77 case ret of
+ 78 ExitSuccess -> return (Left "")
+ 79 ExitFailure{} -> return (Left errOutput)
+ 80 {-ExitFailure errMsg -> do
+ 81 return $ Left $
+ 82 "Failed to run: " ++ showCommandForUser exec args ++ "\n" ++
+ 83 "Error code: " ++ show errMsg ++ "\n" ++
+ 84 "stderr: " ++ stderr-}
+ 85 else do
+ 86 line <- T.hGetLine out
+ 87 return (Right line)
+ 88 handler fetch `finally` do
+ 89 terminateProcess pid
+ 90 _ <- waitForProcess pid
+ 91 return ()
+ 92
+ 93 -- renameFile fails if we're crossing filesystem boundaries. If this happens,
+ 94 -- revert back to copyFile + removeFile.
+ 95 renameOrCopyFile :: FilePath -> FilePath -> IO ()
+ 96 renameOrCopyFile src dst = renameFile src dst `catch` exdev
+ 97 where
+ 98 exdev e = if fmap Errno (ioe_errno e) == Just eXDEV
+ 99 then copyFile src dst >> removeFile src
+ 100 else throw e
+ 101
+ 102 withTempDir :: (FilePath -> IO a) -> IO a
+ 103 withTempDir = withSystemTempDirectory "reanimate"
+ 104
+ 105 withTempFile :: String -> (FilePath -> IO a) -> IO a
+ 106 withTempFile ext action =
+ 107 withSystemTempFile ("reanimate" <.> ext) $ \path hd ->
+ 108 hClose hd >> action path
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Parameters.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Parameters.hs.html
new file mode 100644
index 0000000..1073182
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Parameters.hs.html
@@ -0,0 +1,123 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Parameters
+ 2 ( Raster(..)
+ 3 , Width
+ 4 , Height
+ 5 , FPS
+ 6 , pRaster
+ 7 , pFPS
+ 8 , pWidth
+ 9 , pHeight
+ 10 , pNoExternals
+ 11 , pRootDirectory
+ 12 , setRaster
+ 13 , setFPS
+ 14 , setWidth
+ 15 , setHeight
+ 16 , setNoExternals
+ 17 , setRootDirectory
+ 18 ) where
+ 19
+ 20 import System.IO.Unsafe
+ 21 import Data.IORef
+ 22
+ 23 type Width = Int
+ 24 type Height = Int
+ 25 type FPS = Int
+ 26
+ 27 data Raster
+ 28 = RasterNone
+ 29 | RasterAuto
+ 30 | RasterInkscape
+ 31 | RasterRSvg
+ 32 | RasterMagick
+ 33 deriving (Show, Eq)
+ 34
+ 35 {-# NOINLINE pRasterRef #-}
+ 36 pRasterRef :: IORef Raster
+ 37 pRasterRef = unsafePerformIO (newIORef RasterNone)
+ 38
+ 39 {-# NOINLINE pRaster #-}
+ 40 pRaster :: Raster
+ 41 pRaster = unsafePerformIO (readIORef pRasterRef)
+ 42
+ 43 setRaster :: Raster -> IO ()
+ 44 setRaster = writeIORef pRasterRef
+ 45
+ 46 {-# NOINLINE pFPSRef #-}
+ 47 pFPSRef :: IORef FPS
+ 48 pFPSRef = unsafePerformIO (newIORef 0)
+ 49
+ 50 {-# NOINLINE pFPS #-}
+ 51 pFPS :: FPS
+ 52 pFPS = unsafePerformIO (readIORef pFPSRef)
+ 53
+ 54 setFPS :: FPS -> IO ()
+ 55 setFPS = writeIORef pFPSRef
+ 56
+ 57 {-# NOINLINE pWidthRef #-}
+ 58 pWidthRef :: IORef FPS
+ 59 pWidthRef = unsafePerformIO (newIORef 0)
+ 60
+ 61 {-# NOINLINE pWidth #-}
+ 62 pWidth :: Width
+ 63 pWidth = unsafePerformIO (readIORef pWidthRef)
+ 64
+ 65 setWidth :: Width -> IO ()
+ 66 setWidth = writeIORef pWidthRef
+ 67
+ 68
+ 69 {-# NOINLINE pHeightRef #-}
+ 70 pHeightRef :: IORef FPS
+ 71 pHeightRef = unsafePerformIO (newIORef 0)
+ 72
+ 73 {-# NOINLINE pHeight #-}
+ 74 pHeight :: Height
+ 75 pHeight = unsafePerformIO (readIORef pHeightRef)
+ 76
+ 77 setHeight :: Height -> IO ()
+ 78 setHeight = writeIORef pHeightRef
+ 79
+ 80 {-# NOINLINE pNoExternalsRef #-}
+ 81 pNoExternalsRef :: IORef Bool
+ 82 pNoExternalsRef = unsafePerformIO (newIORef False)
+ 83
+ 84 {-# NOINLINE pNoExternals #-}
+ 85 pNoExternals :: Bool
+ 86 pNoExternals = unsafePerformIO (readIORef pNoExternalsRef)
+ 87
+ 88 setNoExternals :: Bool -> IO ()
+ 89 setNoExternals = writeIORef pNoExternalsRef
+ 90
+ 91 {-# NOINLINE pRootDirectoryRef #-}
+ 92 pRootDirectoryRef :: IORef FilePath
+ 93 pRootDirectoryRef = unsafePerformIO (newIORef (error "root directory not set"))
+ 94
+ 95 {-# NOINLINE pRootDirectory #-}
+ 96 pRootDirectory :: FilePath
+ 97 pRootDirectory = unsafePerformIO (readIORef pRootDirectoryRef)
+ 98
+ 99 setRootDirectory :: FilePath -> IO ()
+ 100 setRootDirectory = writeIORef pRootDirectoryRef
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Raster.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Raster.hs.html
new file mode 100644
index 0000000..2788c75
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Raster.hs.html
@@ -0,0 +1,318 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Raster
+ 2 ( mkImage -- :: Double -> Double -> FilePath -> SVG
+ 3 , cacheImage -- :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath
+ 4 , prerenderSvg -- :: Hashable a => a -> SVG -> SVG
+ 5 , prerenderSvgFile -- :: Hashable a => a -> Width -> Height -> SVG -> FilePath
+ 6 , embedImage -- :: PngSavable a => Image a -> SVG
+ 7 , embedDynamicImage -- :: DynamicImage -> SVG
+ 8 , embedPng -- :: Double -> Double -> LBS.ByteString -> SVG
+ 9 , raster -- :: SVG -> DynamicImage
+ 10 , rasterSized -- :: Width -> Height -> SVG -> DynamicImage
+ 11 , vectorize -- :: FilePath -> SVG
+ 12 , vectorize_ -- :: [String] -> FilePath -> SVG
+ 13 , svgAsPngFile -- :: SVG -> FilePath
+ 14 , svgAsPngFile' -- :: Width -> Height -> SVG -> FilePath
+ 15 )
+ 16 where
+ 17
+ 18 import Codec.Picture
+ 19 import Control.Lens ( (&)
+ 20 , (.~)
+ 21 )
+ 22 import Control.Monad
+ 23 import qualified Data.ByteString as B
+ 24 import qualified Data.ByteString.Base64.Lazy as Base64
+ 25 import qualified Data.ByteString.Lazy.Char8 as LBS
+ 26 import Data.Hashable
+ 27 import qualified Data.Text as T
+ 28 import Graphics.SvgTree ( Number(..)
+ 29 , Tree(..)
+ 30 , defaultSvg
+ 31 , parseSvgFile
+ 32 )
+ 33 import qualified Graphics.SvgTree as Svg
+ 34 import Reanimate.Animation
+ 35 import Reanimate.Cache
+ 36 import Reanimate.Driver.Magick
+ 37 import Reanimate.Misc
+ 38 import Reanimate.Render
+ 39 import Reanimate.Parameters
+ 40 import Reanimate.Constants
+ 41 import Reanimate.Svg.Constructors
+ 42 import Reanimate.Svg.Unuse
+ 43 import System.Directory
+ 44 import System.FilePath
+ 45 import System.IO
+ 46 import System.IO.Temp
+ 47 import System.IO.Unsafe
+ 48
+ 49 -- | Load an external image. Width and height must be specified,
+ 50 -- ignoring the image's aspect ratio. The center of the image is
+ 51 -- placed at position (0,0).
+ 52 --
+ 53 -- For security reasons, must SVG renderer do not allow arbitrary
+ 54 -- image links. For some renderers, we can get around this by placing
+ 55 -- the images in the same root directory as the parent SVG file. Other
+ 56 -- renderers (like Chrome and ffmpeg) requires that the image is inlined
+ 57 -- as base64 data. External SVG files are an exception, though, as must
+ 58 -- always be inlined directly. `mkImage` attempts to hide all the complexity
+ 59 -- but edge-cases may exist.
+ 60 --
+ 61 -- Example:
+ 62 --
+ 63 -- > mkImage screenWidth screenHeight "../data/haskell.svg"
+ 64 --
+ 65 -- <<docs/gifs/doc_mkImage.gif>>
+ 66 mkImage
+ 67 :: Double -- ^ Desired image width.
+ 68 -> Double -- ^ Desired image height.
+ 69 -> FilePath -- ^ Path to external image file.
+ 70 -> SVG
+ 71 mkImage width height path | takeExtension path == ".svg" = unsafePerformIO $ do
+ 72 svg_data <- B.readFile path
+ 73 case parseSvgFile path svg_data of
+ 74 Nothing -> error "Malformed svg"
+ 75 Just svg ->
+ 76 return
+ 77 $ scaleXY (width / screenWidth) (height / screenHeight)
+ 78 $ embedDocument svg
+ 79 mkImage width height path | pRaster == RasterNone = unsafePerformIO $ do
+ 80 inp <- LBS.readFile path
+ 81 let imgData = LBS.unpack $ Base64.encode inp
+ 82 return
+ 83 $ flipYAxis
+ 84 $ ImageTree
+ 85 $ defaultSvg
+ 86 & Svg.imageWidth
+ 87 .~ Svg.Num width
+ 88 & Svg.imageHeight
+ 89 .~ Svg.Num height
+ 90 & Svg.imageHref
+ 91 .~ ("data:" ++ mimeType ++ ";base64," ++ imgData)
+ 92 & Svg.imageCornerUpperLeft
+ 93 .~ (Svg.Num (-width / 2), Svg.Num (-height / 2))
+ 94 & Svg.imageAspectRatio
+ 95 .~ Svg.PreserveAspectRatio False Svg.AlignNone Nothing
+ 96 where
+ 97 -- FIXME: Is there a better way to do this?
+ 98 mimeType = case takeExtension path of
+ 99 ".jpg" -> "image/jpeg"
+ 100 ext -> "image/" ++ drop 1 ext
+ 101 mkImage width height path = unsafePerformIO $ do
+ 102 exists <- doesFileExist target
+ 103 unless exists $ copyFile path target
+ 104 return
+ 105 $ flipYAxis
+ 106 $ ImageTree
+ 107 $ defaultSvg
+ 108 & Svg.imageWidth
+ 109 .~ Svg.Num width
+ 110 & Svg.imageHeight
+ 111 .~ Svg.Num height
+ 112 & Svg.imageHref
+ 113 .~ ("file://" ++ target)
+ 114 & Svg.imageCornerUpperLeft
+ 115 .~ (Svg.Num (-width / 2), Svg.Num (-height / 2))
+ 116 & Svg.imageAspectRatio
+ 117 .~ Svg.PreserveAspectRatio False Svg.AlignNone Nothing
+ 118 where
+ 119 target = pRootDirectory </> encodeInt hashPath <.> takeExtension path
+ 120 hashPath = hash path
+ 121
+ 122 cacheImage :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath
+ 123 cacheImage key gen = unsafePerformIO $ cacheFile template $ \path ->
+ 124 writePng path gen
+ 125 where template = encodeInt (hash key) <.> "png"
+ 126
+ 127 -- Warning: Caching svg elements with links to external objects does
+ 128 -- not work. 2020-06-01
+ 129 prerenderSvgFile :: Hashable a => a -> Width -> Height -> SVG -> FilePath
+ 130 prerenderSvgFile key width height svg =
+ 131 unsafePerformIO $ cacheFile template $ \path -> do
+ 132 let svgPath = replaceExtension path "svg"
+ 133 writeFile svgPath rendered
+ 134 engine <- requireRaster pRaster
+ 135 applyRaster engine svgPath
+ 136 where
+ 137 template = encodeInt (hash (key, width, height)) <.> "png"
+ 138 rendered = renderSvg (Just $ Px $ fromIntegral width)
+ 139 (Just $ Px $ fromIntegral height)
+ 140 svg
+ 141
+ 142 prerenderSvg :: Hashable a => a -> SVG -> SVG
+ 143 prerenderSvg key =
+ 144 mkImage screenWidth screenHeight . prerenderSvgFile key pWidth pHeight
+ 145
+ 146
+ 147 {-# INLINE embedImage #-}
+ 148 -- | Embed an in-memory PNG image. Note, the pixel size of the image
+ 149 -- is used as the dimensions. As such, embedding a 100x100 PNG will
+ 150 -- result in an image 100 units wide and 100 units high. Consider
+ 151 -- using with 'scaleToSize'.
+ 152 embedImage :: PngSavable a => Image a -> SVG
+ 153 embedImage img = embedPng width height (encodePng img)
+ 154 where
+ 155 width = fromIntegral $ imageWidth img
+ 156 height = fromIntegral $ imageHeight img
+ 157
+ 158 -- | Embed in-memory PNG bytestring without parsing it.
+ 159 embedPng
+ 160 :: Double -- ^ Width
+ 161 -> Double -- ^ Height
+ 162 -> LBS.ByteString -- ^ Raw PNG data
+ 163 -> SVG
+ 164 -- embedPng w h png = unsafePerformIO $ do
+ 165 -- LBS.writeFile path png
+ 166 -- return $ ImageTree $ defaultSvg
+ 167 -- & Svg.imageCornerUpperLeft .~ (Svg.Num (-w/2), Svg.Num (-h/2))
+ 168 -- & Svg.imageWidth .~ Svg.Num w
+ 169 -- & Svg.imageHeight .~ Svg.Num h
+ 170 -- & Svg.imageHref .~ ("file://"++path)
+ 171 -- where
+ 172 -- path = "/tmp" </> show (hash png) <.> "png"
+ 173 embedPng w h png =
+ 174 flipYAxis
+ 175 $ ImageTree
+ 176 $ defaultSvg
+ 177 & Svg.imageCornerUpperLeft
+ 178 .~ (Svg.Num (-w / 2), Svg.Num (-h / 2))
+ 179 & Svg.imageWidth
+ 180 .~ Svg.Num w
+ 181 & Svg.imageHeight
+ 182 .~ Svg.Num h
+ 183 & Svg.imageHref
+ 184 .~ ("data:image/png;base64," ++ imgData)
+ 185 where imgData = LBS.unpack $ Base64.encode png
+ 186
+ 187
+ 188 {-# INLINE embedDynamicImage #-}
+ 189 -- | Embed an in-memory image. Note, the pixel size of the image
+ 190 -- is used as the dimensions. As such, embedding a 100x100 image will
+ 191 -- result in an image 100 units wide and 100 units high. Consider
+ 192 -- using with 'scaleToSize'.
+ 193 embedDynamicImage :: DynamicImage -> SVG
+ 194 embedDynamicImage img = embedPng width height imgData
+ 195 where
+ 196 width = fromIntegral $ dynamicMap imageWidth img
+ 197 height = fromIntegral $ dynamicMap imageHeight img
+ 198 imgData = case encodeDynamicPng img of
+ 199 Left err -> error err
+ 200 Right dat -> dat
+ 201
+ 202 -- embedImageFile :: FilePath -> Tree
+ 203 -- embedImageFile path = unsafePerformIO $ do
+ 204 -- png <- B.readFile path
+ 205 -- case decodePng png of
+ 206 -- Left{} -> error "bad image"
+ 207 -- Right img -> return $
+ 208 -- let width = fromIntegral $ dynamicMap imageWidth img
+ 209 -- height = fromIntegral $ dynamicMap imageHeight img in
+ 210 -- ImageTree $ defaultSvg
+ 211 -- & Svg.imageCornerUpperLeft .~ (Svg.Num (-width/2), Svg.Num (-height/2))
+ 212 -- & Svg.imageWidth .~ Svg.Num width
+ 213 -- & Svg.imageHeight .~ Svg.Num height
+ 214 -- & Svg.imageHref .~ ("file://" ++ path)
+ 215
+ 216
+ 217 -- | Convert an SVG object to a pixel-based image. The default resolution
+ 218 -- is 2560x1440. See also 'rasterSized'. Multiple raster engines are supported
+ 219 -- and are selected using the '--raster' flag in the driver.
+ 220 raster :: SVG -> DynamicImage
+ 221 raster = rasterSized 2560 1440
+ 222
+ 223 -- | Convert an SVG object to a pixel-based image.
+ 224 rasterSized
+ 225 :: Width -- ^ X resolution in pixels
+ 226 -> Height -- ^ Y resolution in pixels
+ 227 -> SVG -- ^ SVG object
+ 228 -> DynamicImage
+ 229 rasterSized w h svg = unsafePerformIO $ do
+ 230 png <- B.readFile (svgAsPngFile' w h svg)
+ 231 case decodePng png of
+ 232 Left{} -> error "bad image"
+ 233 Right img -> return img
+ 234
+ 235 -- | Use 'potrace' to trace edges in a raster image and convert them to SVG polygons.
+ 236 vectorize :: FilePath -> SVG
+ 237 vectorize = vectorize_ []
+ 238
+ 239 -- | Same as 'vectorize' but takes a list of arguments for 'potrace'.
+ 240 vectorize_ :: [String] -> FilePath -> SVG
+ 241 vectorize_ _ path | pNoExternals = mkText $ T.pack path
+ 242 vectorize_ args path = unsafePerformIO $ do
+ 243 root <- getXdgDirectory XdgCache "reanimate"
+ 244 createDirectoryIfMissing True root
+ 245 let svgPath = root </> encodeInt key <.> "svg"
+ 246 hit <- doesFileExist svgPath
+ 247 unless hit $ withSystemTempFile "file.svg" $ \tmpSvgPath svgH ->
+ 248 withSystemTempFile "file.bmp" $ \tmpBmpPath bmpH -> do
+ 249 hClose svgH
+ 250 hClose bmpH
+ 251 potrace <- requireExecutable "potrace"
+ 252 magick <- requireExecutable magickCmd
+ 253 runCmd magick [path, "-flatten", tmpBmpPath]
+ 254 runCmd potrace (args ++ ["--svg", "--output", tmpSvgPath, tmpBmpPath])
+ 255 renameOrCopyFile tmpSvgPath svgPath
+ 256 svg_data <- B.readFile svgPath
+ 257 case parseSvgFile svgPath svg_data of
+ 258 Nothing -> do
+ 259 removeFile svgPath
+ 260 error "Malformed svg"
+ 261 Just svg -> return $ unbox $ replaceUses svg
+ 262 where key = hash (path, args)
+ 263
+ 264 -- imageAsFile :: DynamicImage -> FilePath
+ 265 -- imageAsFile img
+ 266
+ 267 -- | Convert an SVG object to a pixel-based image and save it to disk, returning
+ 268 -- the filepath. The default resolution is 2560x1440. See also 'svgAsPngFile''.
+ 269 -- Multiple raster engines are supported and are selected using the '--raster'
+ 270 -- flag in the driver.
+ 271 svgAsPngFile :: SVG -> FilePath
+ 272 svgAsPngFile = svgAsPngFile' width height
+ 273 where
+ 274 width = 2560
+ 275 height = width * 9 `div` 16
+ 276
+ 277 -- | Convert an SVG object to a pixel-based image and save it to disk, returning
+ 278 -- the filepath.
+ 279 svgAsPngFile'
+ 280 :: Width -- ^ Width
+ 281 -> Height -- ^ Height
+ 282 -> SVG -- ^ SVG object
+ 283 -> FilePath
+ 284 svgAsPngFile' _ _ _ | pNoExternals = "/svgAsPngFile/has/been/disabled"
+ 285 svgAsPngFile' width height svg =
+ 286 unsafePerformIO $ cacheFile template $ \pngPath -> do
+ 287 let svgPath = replaceExtension pngPath "svg"
+ 288 writeFile svgPath rendered
+ 289 engine <- requireRaster pRaster
+ 290 applyRaster engine svgPath
+ 291 where
+ 292 template = encodeInt (hash rendered) <.> "png"
+ 293 rendered = renderSvg (Just $ Px $ fromIntegral width)
+ 294 (Just $ Px $ fromIntegral height)
+ 295 svg
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Render.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Render.hs.html
new file mode 100644
index 0000000..0089522
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Render.hs.html
@@ -0,0 +1,390 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 {-# LANGUAGE MultiWayIf #-}
+ 2 module Reanimate.Render
+ 3 ( render
+ 4 , renderSvgs
+ 5 , renderSnippets -- :: Animation -> IO ()
+ 6 , Format(..)
+ 7 , Raster(..)
+ 8 , Width, Height, FPS
+ 9 , requireRaster -- :: Raster -> IO Raster
+ 10 , selectRaster -- :: Raster -> IO Raster
+ 11 , applyRaster -- :: Raster -> FilePath -> IO ()
+ 12 ) where
+ 13
+ 14 import Control.Concurrent
+ 15 import Control.Exception
+ 16 import Control.Monad (forM_, forever, unless, void, when)
+ 17 import Data.Either
+ 18 import Data.Function
+ 19 import qualified Data.Text as T
+ 20 import qualified Data.Text.IO as T
+ 21 import Data.Time
+ 22 import Graphics.SvgTree (Number (..))
+ 23 import Numeric
+ 24 import Reanimate.Animation
+ 25 import Reanimate.Driver.Check
+ 26 import Reanimate.Driver.Magick
+ 27 import Reanimate.Misc
+ 28 import Reanimate.Parameters
+ 29 import System.Console.ANSI.Codes
+ 30 import System.Exit
+ 31 import System.FileLock (withTryFileLock, SharedExclusive(..), unlockFile)
+ 32 import System.Directory
+ 33 import System.FilePath (replaceExtension, (<.>), (</>))
+ 34 import System.IO
+ 35 import Text.Printf (printf)
+ 36
+ 37 idempotentFile :: FilePath -> IO () -> IO ()
+ 38 idempotentFile path action = do
+ 39 _ <- withTryFileLock lockFile Exclusive $ \lock -> do
+ 40 haveFile <- doesFileExist path
+ 41 unless haveFile action
+ 42 unlockFile lock
+ 43 _ <- try (removeFile lockFile) :: IO (Either SomeException ())
+ 44 return ()
+ 45 return ()
+ 46 where
+ 47 lockFile = path <.> "lock"
+ 48
+ 49 renderSvgs :: FilePath -> Int -> Bool -> Animation -> IO ()
+ 50 renderSvgs folder offset _prettyPrint ani = do
+ 51 print frameCount
+ 52 lock <- newMVar ()
+ 53
+ 54 handle errHandler $ concurrentForM_ (frameOrder rate frameCount) $ \nth' -> do
+ 55 let nth = (nth'+offset) `mod` frameCount
+ 56 now = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth
+ 57 frame = frameAt (if frameCount <= 1 then 0 else now) ani
+ 58 svg = renderSvg Nothing Nothing frame
+ 59 path = folder </> show nth <.> "svg"
+ 60
+ 61 idempotentFile path $ writeFile path svg
+ 62 withMVar lock $ \_ -> do
+ 63 print nth
+ 64 hFlush stdout
+ 65 where
+ 66 rate = 60
+ 67 frameCount = round (duration ani * fromIntegral rate) :: Int
+ 68 errHandler (ErrorCall msg) = do
+ 69 hPutStrLn stderr msg
+ 70 exitWith (ExitFailure 1)
+ 71
+ 72 -- XXX: Merge with 'renderSvgs'
+ 73 renderSnippets :: Animation -> IO ()
+ 74 renderSnippets ani = forM_ [0 .. frameCount - 1] $ \nth -> do
+ 75 let now = (duration ani / (fromIntegral frameCount - 1)) * fromIntegral nth
+ 76 frame = frameAt now ani
+ 77 svg = renderSvg Nothing Nothing frame
+ 78 putStr (show nth)
+ 79 T.putStrLn $ T.concat . T.lines . T.pack $ svg
+ 80 where frameCount = 10 :: Integer
+ 81
+ 82 frameOrder :: Int -> Int -> [Int]
+ 83 frameOrder fps nFrames = worker [] fps
+ 84 where
+ 85 worker _seen 0 = []
+ 86 worker seen nthFrame = filterFrameList seen nthFrame nFrames
+ 87 ++ worker (nthFrame : seen) (nthFrame `div` 2)
+ 88
+ 89 filterFrameList :: [Int] -> Int -> Int -> [Int]
+ 90 filterFrameList seen nthFrame nFrames = filter (not . isSeen)
+ 91 [0, nthFrame .. nFrames - 1]
+ 92 where isSeen x = any (\y -> x `mod` y == 0) seen
+ 93
+ 94 data Format = RenderMp4 | RenderGif | RenderWebm
+ 95 deriving (Show)
+ 96
+ 97 mp4Arguments :: FPS -> FilePath -> FilePath -> FilePath -> [String]
+ 98 mp4Arguments fps progress template target =
+ 99 [ "-r"
+ 100 , show fps
+ 101 , "-i"
+ 102 , template
+ 103 , "-y"
+ 104 , "-c:v"
+ 105 , "libx264"
+ 106 , "-vf"
+ 107 , "fps=" ++ show fps
+ 108 , "-preset"
+ 109 , "slow"
+ 110 , "-crf"
+ 111 , "18"
+ 112 , "-movflags"
+ 113 , "+faststart"
+ 114 , "-progress"
+ 115 , progress
+ 116 , "-pix_fmt"
+ 117 , "yuv420p"
+ 118 , target
+ 119 ]
+ 120
+ 121 -- gifArguments :: FPS -> FilePath -> FilePath -> FilePath -> [String]
+ 122 -- gifArguments fps progress template target =
+ 123
+ 124 render
+ 125 :: Animation
+ 126 -> FilePath
+ 127 -> Raster
+ 128 -> Format
+ 129 -> Width
+ 130 -> Height
+ 131 -> FPS
+ 132 -> Bool
+ 133 -> IO ()
+ 134 render ani target raster format width height fps partial = do
+ 135 printf "Starting render of animation: %.1f\n" (duration ani)
+ 136 ffmpeg <- requireExecutable "ffmpeg"
+ 137 generateFrames raster ani width height fps partial $ \template ->
+ 138 withTempFile "txt" $ \progress -> do
+ 139 writeFile progress ""
+ 140 progressH <- openFile progress ReadMode
+ 141 hSetBuffering progressH NoBuffering
+ 142 allFinished <- newEmptyMVar
+ 143 void $ forkIO $ do
+ 144 progressPrinter "rendered" (animationFrameCount ani fps)
+ 145 $ \done -> fix $ \loop -> do
+ 146 eof <- hIsEOF progressH
+ 147 if eof
+ 148 then threadDelay 1000000 >> loop
+ 149 else do
+ 150 l <- try (hGetLine progressH)
+ 151 case l of
+ 152 Left SomeException{} -> return ()
+ 153 Right str ->
+ 154 case take 6 str of
+ 155 "frame=" -> do
+ 156 void $ swapMVar done (read (drop 6 str))
+ 157 loop
+ 158 _ | str == "progress=end" -> return ()
+ 159 _ -> loop
+ 160 putMVar allFinished ()
+ 161 case format of
+ 162 RenderMp4 -> runCmd ffmpeg (mp4Arguments fps progress template target)
+ 163 RenderGif -> withTempFile "png" $ \palette -> do
+ 164 runCmd
+ 165 ffmpeg
+ 166 [ "-i"
+ 167 , template
+ 168 , "-y"
+ 169 , "-vf"
+ 170 , "fps="
+ 171 ++ show fps
+ 172 ++ ",scale="
+ 173 ++ show width
+ 174 ++ ":"
+ 175 ++ show height
+ 176 ++ ":flags=lanczos,palettegen"
+ 177 , "-t"
+ 178 , showFFloat Nothing (duration ani) ""
+ 179 , palette
+ 180 ]
+ 181 runCmd
+ 182 ffmpeg
+ 183 [ "-framerate"
+ 184 , show fps
+ 185 , "-i"
+ 186 , template
+ 187 , "-y"
+ 188 , "-i"
+ 189 , palette
+ 190 , "-progress"
+ 191 , progress
+ 192 , "-filter_complex"
+ 193 , "fps="
+ 194 ++ show fps
+ 195 ++ ",scale="
+ 196 ++ show width
+ 197 ++ ":"
+ 198 ++ show height
+ 199 ++ ":flags=lanczos[x];[x][1:v]paletteuse"
+ 200 , "-t"
+ 201 , showFFloat Nothing (duration ani) ""
+ 202 , target
+ 203 ]
+ 204 RenderWebm -> runCmd
+ 205 ffmpeg
+ 206 [ "-r"
+ 207 , show fps
+ 208 , "-i"
+ 209 , template
+ 210 , "-y"
+ 211 , "-progress"
+ 212 , progress
+ 213 , "-c:v"
+ 214 , "libvpx-vp9"
+ 215 , "-vf"
+ 216 , "fps=" ++ show fps
+ 217 , target
+ 218 ]
+ 219 takeMVar allFinished
+ 220
+ 221 ---------------------------------------------------------------------------------
+ 222 -- Helpers
+ 223
+ 224 progressPrinter :: String -> Int -> (MVar Int -> IO ()) -> IO ()
+ 225 progressPrinter typeName maxCount action = do
+ 226 printf "\rFrames %s: 0/%d" typeName maxCount
+ 227 putStr $ clearFromCursorToLineEndCode ++ "\r"
+ 228 done <- newMVar (0 :: Int)
+ 229 start <- getCurrentTime
+ 230 let bgThread = forever $ do
+ 231 nDone <- readMVar done
+ 232 now <- getCurrentTime
+ 233 let spent = diffUTCTime now start
+ 234 remaining =
+ 235 (spent / (fromIntegral nDone / fromIntegral maxCount)) - spent
+ 236 printf "\rFrames %s: %d/%d" typeName nDone maxCount
+ 237 putStr $ ", time spent: " ++ ppDiff spent
+ 238 unless (nDone == 0) $ do
+ 239 putStr $ ", time remaining: " ++ ppDiff remaining
+ 240 putStr $ ", total time: " ++ ppDiff (remaining + spent)
+ 241 putStr $ clearFromCursorToLineEndCode ++ "\r"
+ 242 hFlush stdout
+ 243 threadDelay 1000000
+ 244 withBackgroundThread bgThread $ action done
+ 245 now <- getCurrentTime
+ 246 let spent = diffUTCTime now start
+ 247 printf "\rFrames %s: %d/%d" typeName maxCount maxCount
+ 248 putStr $ ", time spent: " ++ ppDiff spent
+ 249 putStr $ clearFromCursorToLineEndCode ++ "\n"
+ 250
+ 251 animationFrameCount :: Animation -> FPS -> Int
+ 252 animationFrameCount ani rate = round (duration ani * fromIntegral rate) :: Int
+ 253
+ 254 generateFrames
+ 255 :: Raster -> Animation -> Width -> Height -> FPS -> Bool -> (FilePath -> IO a) -> IO a
+ 256 generateFrames raster ani width_ height_ rate partial action = withTempDir $ \tmp -> do
+ 257 let frameName nth = tmp </> printf nameTemplate nth
+ 258 setRootDirectory tmp
+ 259 progressPrinter "generated" frameCount
+ 260 $ \done -> handle h $ concurrentForM_ frames $ \n -> do
+ 261 writeFile (frameName n) $ renderSvg width height $ nthFrame n
+ 262 modifyMVar_ done $ \nDone -> return (nDone + 1)
+ 263
+ 264 when (isValidRaster raster)
+ 265 $ progressPrinter "rastered" frameCount
+ 266 $ \done -> handle h $ concurrentForM_ frames $ \n -> do
+ 267 applyRaster raster (frameName n)
+ 268 modifyMVar_ done $ \nDone -> return (nDone + 1)
+ 269
+ 270 action (tmp </> rasterTemplate raster)
+ 271 where
+ 272 isValidRaster RasterNone = False
+ 273 isValidRaster RasterAuto = False
+ 274 isValidRaster _ = True
+ 275
+ 276 width = Just $ Px $ fromIntegral width_
+ 277 height = Just $ Px $ fromIntegral height_
+ 278 h UserInterrupt | partial = do
+ 279 hPutStrLn
+ 280 stderr
+ 281 "\nCtrl-C detected. Trying to generate video with available frames. \
+ 282 \Hit ctrl-c again to abort."
+ 283 return ()
+ 284 h other = throwIO other
+ 285 -- frames = [0..frameCount-1]
+ 286 frames = frameOrder rate frameCount
+ 287 nthFrame nth = frameAt (recip (fromIntegral rate) * fromIntegral nth) ani
+ 288 frameCount = animationFrameCount ani rate
+ 289 nameTemplate :: String
+ 290 nameTemplate = "render-%05d.svg"
+ 291
+ 292 withBackgroundThread :: IO () -> IO a -> IO a
+ 293 withBackgroundThread t = bracket (forkIO t) killThread . const
+ 294
+ 295 ppDiff :: NominalDiffTime -> String
+ 296 ppDiff diff | hours == 0 && mins == 0 = show secs ++ "s"
+ 297 | hours == 0 = printf "%.2d:%.2d" mins secs
+ 298 | otherwise = printf "%.2d:%.2d:%.2d" hours mins secs
+ 299 where
+ 300 (osecs, secs) = round diff `divMod` (60 :: Int)
+ 301 (hours, mins) = osecs `divMod` 60
+ 302
+ 303 rasterTemplate :: Raster -> String
+ 304 rasterTemplate RasterNone = "render-%05d.svg"
+ 305 rasterTemplate RasterAuto = "render-%05d.svg"
+ 306 rasterTemplate _ = "render-%05d.png"
+ 307
+ 308 requireRaster :: Raster -> IO Raster
+ 309 requireRaster raster = do
+ 310 raster' <- selectRaster (if raster == RasterNone then RasterAuto else raster)
+ 311 case raster' of
+ 312 RasterNone -> do
+ 313 hPutStrLn
+ 314 stderr
+ 315 "Raster required but none could be found. \
+ 316 \Please install either inkscape, imagemagick, or rsvg-convert."
+ 317 exitWith (ExitFailure 1)
+ 318 _ -> pure raster'
+ 319
+ 320 selectRaster :: Raster -> IO Raster
+ 321 selectRaster RasterAuto = do
+ 322 rsvg <- hasRSvg
+ 323 ink <- hasInkscape
+ 324 magick <- hasMagick
+ 325 if
+ 326 | isRight rsvg -> pure RasterRSvg
+ 327 | isRight ink -> pure RasterInkscape
+ 328 | isRight magick -> pure RasterMagick
+ 329 | otherwise -> pure RasterNone
+ 330 selectRaster r = pure r
+ 331
+ 332 applyRaster :: Raster -> FilePath -> IO ()
+ 333 applyRaster RasterNone _ = return ()
+ 334 applyRaster RasterAuto _ = return ()
+ 335 applyRaster RasterInkscape path = runCmd
+ 336 "inkscape"
+ 337 [ "--without-gui"
+ 338 , "--file=" ++ path
+ 339 , "--export-png=" ++ replaceExtension path "png"
+ 340 ]
+ 341 applyRaster RasterRSvg path = runCmd
+ 342 "rsvg-convert"
+ 343 [path, "--unlimited", "--output", replaceExtension path "png"]
+ 344 applyRaster RasterMagick path =
+ 345 runCmd magickCmd [path, replaceExtension path "png"]
+ 346
+ 347 concurrentForM_ :: [a] -> (a -> IO ()) -> IO ()
+ 348 concurrentForM_ lst action = do
+ 349 n <- getNumCapabilities
+ 350 sem <- newQSemN n
+ 351 eVar <- newEmptyMVar
+ 352 forM_ lst $ \elt -> do
+ 353 waitQSemN sem 1
+ 354 emp <- isEmptyMVar eVar
+ 355 if emp
+ 356 then
+ 357 void
+ 358 $ forkIO
+ 359 ( catch (action elt) (void . tryPutMVar eVar)
+ 360 `finally` signalQSemN sem 1
+ 361 )
+ 362 else signalQSemN sem 1
+ 363 waitQSemN sem n
+ 364 mbE <- tryTakeMVar eVar
+ 365 case mbE of
+ 366 Nothing -> return ()
+ 367 Just e -> throwIO (e :: SomeException)
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox.hs.html
new file mode 100644
index 0000000..35f45ef
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox.hs.html
@@ -0,0 +1,136 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Svg.BoundingBox where
+ 2
+ 3 import Control.Arrow ((***))
+ 4 import Control.Lens ((^.))
+ 5 import Data.List
+ 6 import Data.Maybe (mapMaybe)
+ 7 import Graphics.SvgTree hiding (height, line, path, use,
+ 8 width)
+ 9 import Linear.V2 hiding (angle)
+ 10 import Linear.Vector
+ 11 import Reanimate.Constants
+ 12 import Reanimate.Svg.LineCommand
+ 13 import qualified Reanimate.Transform as Transform
+ 14 -- import qualified Geom2D.CubicBezier as Bezier
+ 15
+ 16 -- | Return bounding box of SVG tree.
+ 17 -- The four numbers returned are (minimal X-coordinate, minimal Y-coordinate, width, height)
+ 18 --
+ 19 -- Note: Bounding boxes are computed on a best-effort basis and will not work
+ 20 -- in all cases. The only supported SVG nodes are: path, circle, polyline,
+ 21 -- ellipse, line, rectangle, image. All other nodes return (0,0,0,0).
+ 22 boundingBox :: Tree -> (Double, Double, Double, Double)
+ 23 boundingBox t =
+ 24 case svgBoundingPoints t of
+ 25 [] -> (0,0,0,0)
+ 26 (V2 x y:rest) ->
+ 27 let (minx, miny, maxx, maxy) = foldl' worker (x, y, x, y) rest
+ 28 in (minx, miny, maxx-minx, maxy-miny)
+ 29 where
+ 30 worker (minx, miny, maxx, maxy) (V2 x y) =
+ 31 (min minx x, min miny y, max maxx x, max maxy y)
+ 32
+ 33 svgHeight :: Tree -> Double
+ 34 svgHeight t = h
+ 35 where
+ 36 (_x, _y, _w, h) = boundingBox t
+ 37
+ 38 svgWidth :: Tree -> Double
+ 39 svgWidth t = w
+ 40 where
+ 41 (_x, _y, w, _h) = boundingBox t
+ 42
+ 43 linePoints :: [LineCommand] -> [RPoint]
+ 44 linePoints = worker zero
+ 45 where
+ 46 worker _from [] = []
+ 47 worker from (x:xs) =
+ 48 case x of
+ 49 LineMove to -> worker to xs
+ 50 -- LineDraw to -> from:to:worker to xs
+ 51 LineBezier [p] ->
+ 52 p : worker p xs
+ 53 LineBezier ctrl -> -- approximation
+ 54 [ last (partialBezierPoints (from:ctrl) 0 (recip chunks*i)) | i <- [0..chunks]] ++
+ 55 worker (last ctrl) xs
+ 56 LineEnd p -> p : worker p xs
+ 57 chunks = 10
+ 58
+ 59 svgBoundingPoints :: Tree -> [RPoint]
+ 60 svgBoundingPoints t = map (Transform.transformPoint m) $
+ 61 case t of
+ 62 None -> []
+ 63 UseTree{} -> []
+ 64 GroupTree g -> concatMap svgBoundingPoints (g^.groupChildren)
+ 65 SymbolTree (Symbol g) -> concatMap svgBoundingPoints (g^.groupChildren)
+ 66 FilterTree{} -> []
+ 67 DefinitionTree{} -> []
+ 68 PathTree p -> linePoints $ toLineCommands (p^.pathDefinition)
+ 69 CircleTree c -> circleBoundingPoints c
+ 70 PolyLineTree pl -> pl ^. polyLinePoints
+ 71 EllipseTree e -> ellipseBoundingPoints e
+ 72 LineTree line -> map pointToRPoint [line^.linePoint1, line^.linePoint2]
+ 73 RectangleTree rect ->
+ 74 case pointToRPoint (rect^.rectUpperLeftCorner) of
+ 75 V2 x y -> V2 x y :
+ 76 case mapTuple (fmap $ toUserUnit defaultDPI) (rect^.rectWidth, rect^.rectHeight) of
+ 77 (Just (Num w), Just (Num h)) -> [V2 (x+w) (y+h)]
+ 78 _ -> []
+ 79 TextTree{} -> []
+ 80 ImageTree img ->
+ 81 case (img^.imageCornerUpperLeft, img^.imageWidth, img^.imageHeight) of
+ 82 ((Num x, Num y), Num w, Num h) ->
+ 83 [V2 x y, V2 (x+w) (y+h)]
+ 84 _ -> []
+ 85 MeshGradientTree{} -> []
+ 86 _ -> []
+ 87 where
+ 88 m = Transform.mkMatrix (t^.transform)
+ 89 mapTuple f = f *** f
+ 90 pointToRPoint p =
+ 91 case mapTuple (toUserUnit defaultDPI) p of
+ 92 (Num x, Num y) -> V2 x y
+ 93 _ -> error "Reanimate.Svg.svgBoundingPoints: Unrecognized number format."
+ 94
+ 95 circleBoundingPoints circ =
+ 96 let (xnum, ynum) = circ ^. circleCenter
+ 97 rnum = circ ^. circleRadius
+ 98 in case mapMaybe unpackNumber [xnum, ynum, rnum] of
+ 99 [x, y, r] -> [ V2 (x + r * cos angle) (y + r * sin angle) | angle <- [0, pi/10 .. 2 * pi]]
+ 100 _ -> []
+ 101
+ 102 ellipseBoundingPoints e =
+ 103 let (xnum,ynum) = e ^. ellipseCenter
+ 104 xrnum = e ^. ellipseXRadius
+ 105 yrnum = e ^. ellipseYRadius
+ 106 in case mapMaybe unpackNumber [xnum, ynum, xrnum, yrnum] of
+ 107 [x,y,xr,yr] -> [V2 (x + xr * cos angle) (y + yr * sin angle) | angle <- [0, pi/10 .. 2 * pi]]
+ 108 _ -> []
+ 109
+ 110 unpackNumber n =
+ 111 case toUserUnit defaultDPI n of
+ 112 Num d -> Just d
+ 113 _ -> Nothing
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors.hs.html
new file mode 100644
index 0000000..32dbbf8
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors.hs.html
@@ -0,0 +1,436 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 {-| Functions for creating basic SVG elements and applying transformations to them. -}
+ 2 module Reanimate.Svg.Constructors
+ 3 ( -- * Primitive shapes
+ 4 mkCircle
+ 5 , mkEllipse
+ 6 , mkRect
+ 7 , mkLine
+ 8 , mkPath
+ 9 , mkPathString
+ 10 , mkPathText
+ 11 , mkLinePath
+ 12 , mkLinePathClosed
+ 13 , mkClipPath
+ 14 , mkText
+ 15 -- * Grouping shapes and definitions
+ 16 , mkGroup
+ 17 , mkDefinitions
+ 18 , mkUse
+ 19 -- * Attributes
+ 20 , withId
+ 21 , withStrokeColor
+ 22 , withStrokeColorPixel
+ 23 , withStrokeDashArray
+ 24 , withStrokeLineJoin
+ 25 , withFillColor
+ 26 , withFillColorPixel
+ 27 , withFillOpacity
+ 28 , withGroupOpacity
+ 29 , withStrokeWidth
+ 30 , withClipPathRef
+ 31 -- * Transformations
+ 32 , center
+ 33 , centerX
+ 34 , centerY
+ 35 , centerUsing
+ 36 , translate
+ 37 , rotate
+ 38 , rotateAroundCenter
+ 39 , rotateAround
+ 40 , scale
+ 41 , scaleToSize
+ 42 , scaleToWidth
+ 43 , scaleToHeight
+ 44 , scaleXY
+ 45 , flipXAxis
+ 46 , flipYAxis
+ 47 , aroundCenter
+ 48 , aroundCenterX
+ 49 , aroundCenterY
+ 50 , withTransformations
+ 51 , withViewBox
+ 52 -- * Other
+ 53 , mkColor
+ 54 , mkBackground
+ 55 , mkBackgroundPixel
+ 56 , gridLayout
+ 57
+ 58 ) where
+ 59
+ 60 import Codec.Picture (PixelRGBA8 (..))
+ 61 import Control.Lens ((&), (.~), (?~))
+ 62 import Data.Attoparsec.Text (parseOnly)
+ 63 import qualified Data.Map as Map
+ 64 import qualified Data.Text as T
+ 65 import Graphics.SvgTree hiding (height, line, path, use,
+ 66 width)
+ 67 import Graphics.SvgTree.NamedColors
+ 68 import Graphics.SvgTree.PathParser
+ 69 import Linear.V2 hiding (angle)
+ 70 import Reanimate.Constants
+ 71 import Reanimate.Svg.BoundingBox
+ 72
+ 73 -- | Apply list of transformations to given image.
+ 74 withTransformations :: [Transformation] -> Tree -> Tree
+ 75 withTransformations transformations t =
+ 76 mkGroup [t] & transform ?~ transformations
+ 77
+ 78 -- | @translate x y image@ moves the @image@ by @x@ along X-axis and by @y@ along Y-axis.
+ 79 translate :: Double -> Double -> Tree -> Tree
+ 80 translate x y = withTransformations [Translate x y]
+ 81
+ 82 -- | @rotate angle image@ rotates the @image@ around origin @(0,0)@ counterclockwise by @angle@
+ 83 -- given in degrees.
+ 84 rotate :: Double -> Tree -> Tree
+ 85 rotate a = withTransformations [Rotate a Nothing]
+ 86
+ 87 -- | @rotate angle point image@ rotates the @image@ around given @point@ counterclockwise by
+ 88 -- @angle@ given in degrees.
+ 89 rotateAround :: Double -> RPoint -> Tree -> Tree
+ 90 rotateAround a (V2 x y) = withTransformations [Rotate a (Just (x,y))]
+ 91
+ 92 -- | @rotate angle image@ rotates the @image@ around the center of its bounding box counterclockwise
+ 93 -- by @angle@ given in degrees.
+ 94 rotateAroundCenter :: Double -> Tree -> Tree
+ 95 rotateAroundCenter a t =
+ 96 rotateAround a (V2 (x+w/2) (y+h/2)) t
+ 97 where
+ 98 (x,y,w,h) = boundingBox t
+ 99
+ 100 -- | @aroundCenter f image@ first moves the image so the center of its bounding box is at the origin
+ 101 -- @(0, 0)@, applies transformation @f@ to it and then moves the transformed image back to its
+ 102 -- original position.
+ 103 aroundCenter :: (Tree -> Tree) -> Tree -> Tree
+ 104 aroundCenter fn t =
+ 105 translate (-offsetX) (-offsetY) $ fn $ translate offsetX offsetY t
+ 106 where
+ 107 offsetX = -x-w/2
+ 108 offsetY = -y-h/2
+ 109 (x,y,w,h) = boundingBox t
+ 110
+ 111 aroundCenterY :: (Tree -> Tree) -> Tree -> Tree
+ 112 aroundCenterY fn t =
+ 113 translate 0 (-offsetY) $ fn $ translate 0 offsetY t
+ 114 where
+ 115 offsetY = -y-h/2
+ 116 (_x,y,_w,h) = boundingBox t
+ 117
+ 118 aroundCenterX :: (Tree -> Tree) -> Tree -> Tree
+ 119 aroundCenterX fn t =
+ 120 translate (-offsetX) 0 $ fn $ translate offsetX 0 t
+ 121 where
+ 122 offsetX = -x-w/2
+ 123 (x,_y,w,_h) = boundingBox t
+ 124
+ 125 -- | Scale the image uniformly by given factor along both X and Y axes.
+ 126 -- For example @scale 2 image@ makes the image twice as large, while @scale 0.5 image@ makes it
+ 127 -- half the original size. Negative values are also allowed, and lead to flipping the image along
+ 128 -- both X and Y axes.
+ 129 scale :: Double -> Tree -> Tree
+ 130 scale a = withTransformations [Scale a Nothing]
+ 131
+ 132 -- | @scaleToSize width height@ resizes the image so that its bounding box has corresponding @width@
+ 133 -- and @height@.
+ 134 scaleToSize :: Double -> Double -> Tree -> Tree
+ 135 scaleToSize w h t =
+ 136 scaleXY (w/w') (h/h') t
+ 137 where
+ 138 (_x, _y, w', h') = boundingBox t
+ 139
+ 140 -- | @scaleToWidth width@ scales the image so that the width of its bounding box ends up having
+ 141 -- given @width@.
+ 142 scaleToWidth :: Double -> Tree -> Tree
+ 143 scaleToWidth w t =
+ 144 scale (w/w') t
+ 145 where
+ 146 (_x, _y, w', _h') = boundingBox t
+ 147
+ 148 -- | @scaleToHeight height@ scales the image so that the height of its bounding box ends up having
+ 149 -- given @height@.
+ 150 scaleToHeight :: Double -> Tree -> Tree
+ 151 scaleToHeight h t =
+ 152 scale (h/h') t
+ 153 where
+ 154 (_x, _y, _w', h') = boundingBox t
+ 155
+ 156 -- | Similar to 'scale', except scale factors for X and Y axes are specified separately.
+ 157 scaleXY :: Double -> Double -> Tree -> Tree
+ 158 scaleXY x y = withTransformations [Scale x (Just y)]
+ 159
+ 160
+ 161 -- | Flip the image along vertical axis so that what was on the right will end up on left and vice
+ 162 -- versa.
+ 163 flipXAxis :: Tree -> Tree
+ 164 flipXAxis = scaleXY (-1) 1
+ 165
+ 166 -- | Flip the image along horizontal so that what was on the top will end up in the bottom and vice
+ 167 -- versa.
+ 168 flipYAxis :: Tree -> Tree
+ 169 flipYAxis = scaleXY 1 (-1)
+ 170
+ 171 -- | Translate given image so that the center of its bouding box coincides with coordinates
+ 172 -- @(0, 0)@.
+ 173 center :: Tree -> Tree
+ 174 center t = centerUsing t t
+ 175
+ 176 -- | Translate given image so that the X-coordinate of the center of its bouding box is 0.
+ 177 centerX :: Tree -> Tree
+ 178 centerX t = translate (-x-w/2) 0 t
+ 179 where
+ 180 (x, _y, w, _h) = boundingBox t
+ 181
+ 182 -- | Translate given image so that the Y-coordinate of the center of its bouding box is 0.
+ 183 centerY :: Tree -> Tree
+ 184 centerY t = translate 0 (-y-h/2) t
+ 185 where
+ 186 (_x, y, _w, h) = boundingBox t
+ 187
+ 188 centerUsing :: Tree -> Tree -> Tree
+ 189 centerUsing a = translate (-x-w/2) (-y-h/2)
+ 190 where
+ 191 (x, y, w, h) = boundingBox a
+ 192
+ 193 -- | Create 'Texture' based on SVG color name.
+ 194 -- See <https://en.wikipedia.org/wiki/Web_colors#X11_color_names> for the list of available names.
+ 195 -- If the provided name doesn't correspond to valid SVG color name, white-ish color is used.
+ 196 mkColor :: String -> Texture
+ 197 mkColor name =
+ 198 case Map.lookup (T.pack name) svgNamedColors of
+ 199 Nothing -> ColorRef (PixelRGBA8 240 248 255 255)
+ 200 Just c -> ColorRef c
+ 201
+ 202 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke>
+ 203 withStrokeColor :: String -> Tree -> Tree
+ 204 withStrokeColor color = strokeColor .~ pure (mkColor color)
+ 205
+ 206 withStrokeColorPixel :: PixelRGBA8 -> Tree -> Tree
+ 207 withStrokeColorPixel color = strokeColor .~ pure (ColorRef color)
+ 208
+ 209 withStrokeDashArray :: [Double] -> Tree -> Tree
+ 210 withStrokeDashArray arr = strokeDashArray .~ pure (map Num arr)
+ 211
+ 212 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-linejoin>
+ 213 withStrokeLineJoin :: LineJoin -> Tree -> Tree
+ 214 withStrokeLineJoin ljoin = strokeLineJoin .~ pure ljoin
+ 215
+ 216 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>
+ 217 withFillColor :: String -> Tree -> Tree
+ 218 withFillColor color = fillColor .~ pure (mkColor color)
+ 219
+ 220 withFillColorPixel :: PixelRGBA8 -> Tree -> Tree
+ 221 withFillColorPixel color = fillColor .~ pure (ColorRef color)
+ 222
+ 223 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill-opacity>
+ 224 withFillOpacity :: Double -> Tree -> Tree
+ 225 withFillOpacity opacity = fillOpacity ?~ realToFrac opacity
+ 226
+ 227 withGroupOpacity :: Double -> Tree -> Tree
+ 228 withGroupOpacity opacity = groupOpacity ?~ realToFrac opacity
+ 229
+ 230 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-width>
+ 231 withStrokeWidth :: Double -> Tree -> Tree
+ 232 withStrokeWidth width = strokeWidth .~ pure (Num width)
+ 233
+ 234 -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/clip-path>
+ 235 withClipPathRef :: ElementRef -- ^ Reference to clip path defined previously (e.g. by 'mkClipPath')
+ 236 -> Tree -- ^ Image that will be clipped by the referenced clip path
+ 237 -> Tree
+ 238 withClipPathRef ref sub = mkGroup [sub] & clipPathRef .~ pure ref
+ 239
+ 240 -- | Assigns ID attribute to given image.
+ 241 withId :: String -> Tree -> Tree
+ 242 withId idTag = attrId ?~ idTag
+ 243
+ 244 -- | @mkRect width height@ creates a rectangle with given @with@ and @height@, centered at @(0, 0)@.
+ 245 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/rect>
+ 246 mkRect :: Double -> Double -> Tree
+ 247 mkRect width height = translate (-width/2) (-height/2) $ RectangleTree $ defaultSvg
+ 248 & rectUpperLeftCorner .~ (Num 0, Num 0)
+ 249 & rectWidth ?~ Num width
+ 250 & rectHeight ?~ Num height
+ 251
+ 252 -- | Create a circle with given radius, centered at @(0, 0)@.
+ 253 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/circle>
+ 254 mkCircle :: Double -> Tree
+ 255 mkCircle radius = CircleTree $ defaultSvg
+ 256 & circleCenter .~ (Num 0, Num 0)
+ 257 & circleRadius .~ Num radius
+ 258
+ 259 -- | Create an ellipse given X-axis radius, and Y-axis radius, with center at @(0, 0)@.
+ 260 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/ellipse>
+ 261 mkEllipse :: Double -> Double -> Tree
+ 262 mkEllipse rx ry = EllipseTree $ defaultSvg
+ 263 & ellipseCenter .~ (Num 0, Num 0)
+ 264 & ellipseXRadius .~ Num rx
+ 265 & ellipseYRadius .~ Num ry
+ 266
+ 267 -- | Create a line segment between two points given by their @(x, y)@ coordinates.
+ 268 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/line>
+ 269 mkLine :: (Double,Double) -> (Double, Double) -> Tree
+ 270 mkLine (x1,y1) (x2,y2) = LineTree $ defaultSvg
+ 271 & linePoint1 .~ (Num x1, Num y1)
+ 272 & linePoint2 .~ (Num x2, Num y2)
+ 273
+ 274 -- | Merges multiple images into one.
+ 275 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/g>
+ 276 mkGroup :: [Tree] -> Tree
+ 277 mkGroup forest = GroupTree $ defaultSvg
+ 278 & groupChildren .~ forest
+ 279
+ 280 -- | Create definition of graphical objects that can be used at later time.
+ 281 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/defs>
+ 282 mkDefinitions :: [Tree] -> Tree
+ 283 mkDefinitions forest = DefinitionTree $ defaultSvg
+ 284 & groupChildren .~ forest
+ 285
+ 286 -- | Create an element by referring to existing element defined previously.
+ 287 -- For example you can create a graphical element, assign ID to it using 'withId', wrap it in
+ 288 -- 'mkDefinitions' and then use it via @use "myId"@.
+ 289 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/use>
+ 290 mkUse :: String -> Tree
+ 291 mkUse name = UseTree (defaultSvg & useName .~ name) Nothing
+ 292
+ 293 -- | A clip path restricts the region to which paint can be applied.
+ 294 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/clipPath>
+ 295 mkClipPath :: String -- ^ ID of the clip path, which can then be referred to by other elements
+ 296 -- using 'withClipPathRef'.
+ 297 -> [Tree] -- ^ List of shapes that will determine the final shape of the clipping region
+ 298 -> Tree
+ 299 mkClipPath idTag forest = withId idTag $ ClipPathTree $ defaultSvg
+ 300 & clipPathContent .~ forest
+ 301
+ 302 -- | Create a path from the list of path commands.
+ 303 -- See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d#Path_commands>
+ 304 mkPath :: [PathCommand] -> Tree
+ 305 mkPath cmds = PathTree $ defaultSvg & pathDefinition .~ cmds
+ 306
+ 307 -- | Similar to 'mkPathText', but taking SVG path command as a String.
+ 308 mkPathString :: String -> Tree
+ 309 mkPathString = mkPathText . T.pack
+ 310
+ 311 -- | Create path from textual representation of SVG path command.
+ 312 -- If the text doesn't represent valid path command, this function fails with 'Prelude.error'.
+ 313 -- Use 'mkPath' for type safe way of creating paths.
+ 314 mkPathText :: T.Text -> Tree
+ 315 mkPathText str =
+ 316 case parseOnly pathParser str of
+ 317 Left err -> error err
+ 318 Right cmds -> mkPath cmds
+ 319
+ 320 -- | Create a path from a list of @(x, y)@ coordinates of points along the path.
+ 321 mkLinePath :: [(Double, Double)] -> Tree
+ 322 mkLinePath [] = mkGroup []
+ 323 mkLinePath ((startX, startY):rest) =
+ 324 PathTree $ defaultSvg & pathDefinition .~ cmds
+ 325 where
+ 326 cmds = [ MoveTo OriginAbsolute [V2 startX startY]
+ 327 , LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ] ]
+ 328
+ 329 -- | Create a path from a list of @(x, y)@ coordinates of points along the path.
+ 330 mkLinePathClosed :: [(Double, Double)] -> Tree
+ 331 mkLinePathClosed [] = mkGroup []
+ 332 mkLinePathClosed ((startX, startY):rest) =
+ 333 PathTree $ defaultSvg & pathDefinition .~ cmds
+ 334 where
+ 335 cmds = [ MoveTo OriginAbsolute [V2 startX startY]
+ 336 , LineTo OriginAbsolute [ V2 x y | (x, y) <- rest ]
+ 337 , EndPath ]
+ 338
+ 339 -- | Rectangle with a uniform color and the same size as the screen.
+ 340 --
+ 341 -- Example:
+ 342 --
+ 343 -- > animate $ const $ mkBackground "yellow"
+ 344 --
+ 345 -- <<docs/gifs/doc_mkBackground.gif>>
+ 346 mkBackground :: String -> Tree
+ 347 mkBackground color = withFillOpacity 1 $ withStrokeWidth 0 $
+ 348 withFillColor color $ mkRect screenWidth screenHeight
+ 349
+ 350 mkBackgroundPixel :: PixelRGBA8 -> Tree
+ 351 mkBackgroundPixel pixel =
+ 352 withFillOpacity 1 $ withStrokeWidth 0 $
+ 353 withFillColorPixel pixel $ mkRect screenWidth screenHeight
+ 354
+ 355 -- | Take list of rows, where each row consists of number of images and display them in regular
+ 356 -- grid structure.
+ 357 -- All rows will get equal amount of vertical space.
+ 358 -- The images within each row will get equal amount of horizontal space, independent of the other
+ 359 -- rows. Each row can contain different number of cells.
+ 360 gridLayout :: [[Tree]] -> Tree
+ 361 gridLayout rows = mkGroup
+ 362 [ translate (-screenWidth/2+colSep*nCol + colSep*0.5)
+ 363 (screenHeight/2-rowSep*nRow - rowSep*0.5)
+ 364 elt
+ 365 | (nRow, row) <- zip [0..] rows
+ 366 , let nCols = length row
+ 367 colSep = screenWidth / fromIntegral nCols
+ 368 , (nCol, elt) <- zip [0..] row ]
+ 369 where
+ 370 rowSep = screenHeight / fromIntegral nRows
+ 371 nRows = length rows
+ 372
+ 373 -- | Insert a native text object anchored at the middle.
+ 374 --
+ 375 -- Example:
+ 376 --
+ 377 -- > mkAnimation 2 $ \t -> scale 2 $ withStrokeWidth 0.05 $ mkText (T.take (round $ t*15) "text")
+ 378 --
+ 379 -- <<docs/gifs/doc_mkText.gif>>
+ 380 mkText :: T.Text -> Tree
+ 381 mkText str =
+ 382 flipYAxis
+ 383 (TextTree Nothing $ defaultSvg
+ 384 & textRoot .~ span_
+ 385 & fontSize .~ pure (Num 2))
+ 386 & textAnchor .~ pure TextAnchorMiddle
+ 387 -- Note: TextAnchorMiddle is placed on the 'flipYAxis' group such that it can easily
+ 388 -- be overwritten by the user.
+ 389 where
+ 390 span_ = defaultSvg & spanContent .~ [SpanText str]
+ 391
+ 392 -- | Switch from the default viewbox to a custom viewbox. Nesting custom viewboxes is
+ 393 -- unlikely to give good results. If you need nested custom viewboxes, you will have
+ 394 -- to configure them by hand.
+ 395 --
+ 396 -- The viewbox argument is (min-x, min-y, width, height).
+ 397 --
+ 398 -- Example:
+ 399 --
+ 400 -- > withViewBox (0,0,1,1) $ mkBackground "yellow"
+ 401 --
+ 402 -- <<docs/gifs/doc_withViewBox.gif>>
+ 403 withViewBox :: (Double, Double, Double, Double) -> Tree -> Tree
+ 404 withViewBox vbox child = translate (-screenWidth/2) (-screenHeight/2) $
+ 405 SvgTree $ Document
+ 406 { _viewBox = Just vbox
+ 407 , _width = Just (Num screenWidth)
+ 408 , _height = Just (Num screenHeight)
+ 409 , _elements = [child]
+ 410 , _description = ""
+ 411 , _documentLocation = ""
+ 412 , _documentAspectRatio = PreserveAspectRatio False AlignNone Nothing
+ 413 }
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand.hs.html
new file mode 100644
index 0000000..4c1f00d
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand.hs.html
@@ -0,0 +1,284 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Svg.LineCommand where
+ 2
+ 3 import Control.Lens ((%~), (&), (.~))
+ 4 import Control.Monad.Fix
+ 5 import Control.Monad.State
+ 6 import Data.Functor
+ 7 import qualified Data.Vector.Unboxed as V
+ 8 import qualified Reanimate.Internal.CubicBezier as Bezier
+ 9 import Graphics.SvgTree hiding (height, line, path, use, width)
+ 10 import Linear.Metric
+ 11 import Linear.V2 hiding (angle)
+ 12 import Linear.Vector
+ 13
+ 14 type CmdM a = State RPoint a
+ 15
+ 16 data LineCommand
+ 17 = LineMove RPoint
+ 18 -- | LineDraw RPoint
+ 19 | LineBezier [RPoint]
+ 20 | LineEnd RPoint
+ 21 deriving (Show)
+ 22
+ 23 lineToPath :: [LineCommand] -> [PathCommand]
+ 24 lineToPath = map worker
+ 25 where
+ 26 worker (LineMove p) = MoveTo OriginAbsolute [p]
+ 27 -- worker (LineDraw p) = LineTo OriginAbsolute [p]
+ 28 worker (LineBezier [a,b,c]) = CurveTo OriginAbsolute [(a,b,c)]
+ 29 worker (LineBezier [a,b]) = QuadraticBezier OriginAbsolute [(a,b)]
+ 30 worker (LineBezier [a]) = LineTo OriginAbsolute [a]
+ 31 worker LineBezier{} = error "Reanimate.Svg.lineToPath: invalid bezier curve"
+ 32 worker LineEnd{} = EndPath
+ 33
+ 34 lineToPoints :: Int -> [LineCommand] -> [RPoint]
+ 35 lineToPoints nPoints cmds =
+ 36 map lineEnd lineSegments
+ 37 where
+ 38 lineSegments = [ partialLine (fromIntegral n/ fromIntegral nPoints) cmds | n <- [0 .. nPoints-1] ]
+ 39 lineEnd [LineBezier pts] = last pts
+ 40 lineEnd (_:xs) = lineEnd xs
+ 41 lineEnd _ = error "invalid line"
+ 42
+ 43 partialLine :: Double -> [LineCommand] -> [LineCommand]
+ 44 partialLine alpha cmds = evalState (worker 0 cmds) zero
+ 45 where
+ 46 worker _d [] = pure []
+ 47 worker d (cmd:xs) = do
+ 48 from <- get
+ 49 len <- lineLength cmd
+ 50 let frac = (targetLen-d) / len
+ 51 if len == 0 || frac >= 1
+ 52 then (cmd:) <$> worker (d+len) xs
+ 53 else pure [adjustLineLength frac from cmd]
+ 54 totalLen = evalState (sum <$> mapM lineLength cmds) zero
+ 55 targetLen = totalLen * alpha
+ 56
+ 57 adjustLineLength :: Double -> RPoint -> LineCommand -> LineCommand
+ 58 adjustLineLength alpha from cmd =
+ 59 case cmd of
+ 60 LineBezier points -> LineBezier $ drop 1 $ partialBezierPoints (from:points) 0 alpha
+ 61 LineMove p -> LineMove p
+ 62 -- LineDraw t -> LineDraw (lerp alpha t from)
+ 63 LineEnd p -> LineBezier [lerp alpha p from]
+ 64
+ 65 lineLength :: LineCommand -> CmdM Double
+ 66 lineLength cmd =
+ 67 case cmd of
+ 68 LineMove to -> 0 <$ put to
+ 69 -- Straight line:
+ 70 LineBezier [dst] -> gets (distance dst) <* put dst
+ 71 -- Some kind of curve:
+ 72 LineBezier lst -> do
+ 73 from <- get
+ 74 let bezier = rpointsToBezier (from:lst)
+ 75 tol = 0.0001
+ 76 put (last lst)
+ 77 pure $ Bezier.arcLength bezier 1 tol
+ 78 LineEnd to -> gets (distance to) <* put to
+ 79
+ 80 rpointsToBezier :: [RPoint] -> Bezier.CubicBezier Double
+ 81 rpointsToBezier lst =
+ 82 case lst of
+ 83 [a,b] -> Bezier.CubicBezier a a b b
+ 84 [a,b,c] -> Bezier.quadToCubic (Bezier.QuadBezier a b c)
+ 85 [a,b,c,d] -> Bezier.CubicBezier a b c d
+ 86 _ -> error $ "rpointsToBezier: Invalid list of points: " ++ show lst
+ 87
+ 88 toLineCommands :: [PathCommand] -> [LineCommand]
+ 89 toLineCommands ps = evalState (worker zero Nothing ps) zero
+ 90 where
+ 91 worker _startPos _mbPrevControlPt [] = pure []
+ 92 worker startPos mbPrevControlPt (cmd:cmds) = do
+ 93 lcmds <- toLineCommand startPos mbPrevControlPt cmd
+ 94 let startPos' =
+ 95 case lcmds of
+ 96 [LineMove pos] -> pos
+ 97 _ -> startPos
+ 98 (lcmds++) <$> worker startPos' (cmdToControlPoint $ last lcmds) cmds
+ 99
+ 100 cmdToControlPoint :: LineCommand -> Maybe RPoint
+ 101 cmdToControlPoint (LineBezier points) = Just (last (init points))
+ 102 cmdToControlPoint _ = Nothing
+ 103
+ 104 mkStraightLine :: RPoint -> LineCommand
+ 105 mkStraightLine p = LineBezier [p]
+ 106
+ 107 toLineCommand :: RPoint -> Maybe RPoint -> PathCommand -> CmdM [LineCommand]
+ 108 toLineCommand startPos mbPrevControlPt cmd =
+ 109 case cmd of
+ 110 MoveTo OriginAbsolute [] -> pure []
+ 111 MoveTo OriginAbsolute lst -> put (last lst) *> gets (pure.LineMove)
+ 112 MoveTo OriginRelative lst -> modify (+ sum lst) *> gets (pure.LineMove)
+ 113 LineTo OriginAbsolute lst -> forM lst (\to -> put to $> mkStraightLine to)
+ 114 LineTo OriginRelative lst -> forM lst (\to -> modify (+to) *> gets mkStraightLine)
+ 115 HorizontalTo OriginAbsolute lst ->
+ 116 forM lst $ \x -> modify (_x .~ x) *> gets mkStraightLine
+ 117 HorizontalTo OriginRelative lst ->
+ 118 forM lst $ \x -> modify (_x %~ (+x)) *> gets mkStraightLine
+ 119 VerticalTo OriginAbsolute lst ->
+ 120 forM lst $ \y -> modify (_y .~ y) *> gets mkStraightLine
+ 121 VerticalTo OriginRelative lst ->
+ 122 forM lst $ \y -> modify (_y %~ (+y)) *> gets mkStraightLine
+ 123 CurveTo OriginAbsolute quads ->
+ 124 forM quads $ \(a,b,c) -> put c $> LineBezier [a,b,c]
+ 125 CurveTo OriginRelative quads ->
+ 126 forM quads $ \(a,b,c) -> do
+ 127 from <- get <* modify (+c)
+ 128 pure $ LineBezier $ map (+from) [a,b,c]
+ 129 SmoothCurveTo o lst -> mfix $ \result -> do
+ 130 let ctrl = mbPrevControlPt : map cmdToControlPoint result
+ 131 forM (zip lst ctrl) $ \((c2,to), mbControl) -> do
+ 132 from <- get <* adjustPosition o to
+ 133 let c1 = maybe (makeAbsolute o from c2) (mirrorPoint from) mbControl
+ 134 pure $ LineBezier [c1,makeAbsolute o from c2,makeAbsolute o from to]
+ 135 QuadraticBezier OriginAbsolute pairs ->
+ 136 forM pairs $ \(a,b) -> put b $> LineBezier [a,b]
+ 137 QuadraticBezier OriginRelative pairs ->
+ 138 forM pairs $ \(a,b) -> do
+ 139 from <- get <* modify (+b)
+ 140 pure $ LineBezier $ map (+from) [a,b]
+ 141 SmoothQuadraticBezierCurveTo o lst -> mfix $ \result -> do
+ 142 let ctrl = mbPrevControlPt : map cmdToControlPoint result
+ 143 forM (zip lst ctrl) $ \(to, mbControl) -> do
+ 144 from <- get <* adjustPosition o to
+ 145 let c1 = maybe from (mirrorPoint from) mbControl
+ 146 pure $ LineBezier [c1,makeAbsolute o from to]
+ 147 EllipticalArc o points -> concat <$>
+ 148 forM points (\(rotX, rotY, angle, largeArc, sweepFlag, to) -> do
+ 149 from <- get <* adjustPosition o to
+ 150 return $ convertSvgArc from rotX rotY angle largeArc sweepFlag (makeAbsolute o from to))
+ 151 EndPath -> put startPos $> [LineEnd startPos]
+ 152 where
+ 153 mirrorPoint c p = c*2-p
+ 154 adjustPosition OriginRelative p = modify (+p)
+ 155 adjustPosition OriginAbsolute p = put p
+ 156 makeAbsolute OriginAbsolute _from p = p
+ 157 makeAbsolute OriginRelative from p = from+p
+ 158
+ 159
+ 160 calculateVectorAngle :: Double -> Double -> Double -> Double -> Double
+ 161 calculateVectorAngle ux uy vx vy
+ 162 | tb >= ta
+ 163 = tb - ta
+ 164 | otherwise
+ 165 = pi * 2 - (ta - tb)
+ 166 where
+ 167 ta = atan2 uy ux
+ 168 tb = atan2 vy vx
+ 169
+ 170 -- ported from: https://github.com/vvvv/SVG/blob/master/Source/Paths/SvgArcSegment.cs
+ 171 {- HLINT ignore convertSvgArc -}
+ 172 convertSvgArc :: RPoint -> Coord -> Coord -> Coord -> Bool -> Bool -> RPoint -> [LineCommand]
+ 173 convertSvgArc (V2 x0 y0) radiusX radiusY angle largeArcFlag sweepFlag (V2 x y)
+ 174 | x0 == x && y0 == y
+ 175 = []
+ 176 | radiusX == 0.0 && radiusY == 0.0
+ 177 = [LineBezier [V2 x y]]
+ 178 | otherwise
+ 179 = calcSegments x0 y0 theta1' segments'
+ 180 where
+ 181 sinPhi = sin (angle * pi/180)
+ 182 cosPhi = cos (angle * pi/180)
+ 183
+ 184 x1dash = cosPhi * (x0 - x) / 2.0 + sinPhi * (y0 - y) / 2.0
+ 185 y1dash = -sinPhi * (x0 - x) / 2.0 + cosPhi * (y0 - y) / 2.0
+ 186
+ 187 numerator = radiusX * radiusX * radiusY * radiusY - radiusX * radiusX * y1dash * y1dash - radiusY * radiusY * x1dash * x1dash
+ 188
+ 189 s = sqrt(1.0 - numerator / (radiusX * radiusX * radiusY * radiusY))
+ 190 rx = if (numerator < 0.0) then (radiusX * s) else radiusX
+ 191 ry = if (numerator < 0.0) then (radiusY * s) else radiusY
+ 192 root = if (numerator < 0.0)
+ 193 then (0.0)
+ 194 else ((if ((largeArcFlag && sweepFlag) || (not largeArcFlag && not sweepFlag)) then (-1.0) else 1.0) *
+ 195 sqrt(numerator / (radiusX * radiusX * y1dash * y1dash + radiusY * radiusY * x1dash * x1dash)))
+ 196
+ 197 cxdash = root * rx * y1dash / ry
+ 198 cydash = -root * ry * x1dash / rx
+ 199
+ 200 cx = cosPhi * cxdash - sinPhi * cydash + (x0 + x) / 2.0
+ 201 cy = sinPhi * cxdash + cosPhi * cydash + (y0 + y) / 2.0
+ 202
+ 203 theta1' = calculateVectorAngle 1.0 0.0 ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry)
+ 204 dtheta' = calculateVectorAngle ((x1dash - cxdash) / rx) ((y1dash - cydash) / ry) ((-x1dash - cxdash) / rx) ((-y1dash - cydash) / ry)
+ 205 dtheta = if (not sweepFlag && dtheta' > 0)
+ 206 then (dtheta' - 2 * pi)
+ 207 else (if (sweepFlag && dtheta' < 0) then dtheta' + 2 * pi else dtheta')
+ 208
+ 209 segments' = ceiling (abs (dtheta / (pi / 2.0)))
+ 210 delta = dtheta / fromInteger segments'
+ 211 t = 8.0 / 3.0 * sin(delta / 4.0) * sin(delta / 4.0) / sin(delta / 2.0)
+ 212
+ 213 calcSegments startX startY theta1 segments
+ 214 | segments == 0
+ 215 = []
+ 216 | otherwise
+ 217 = LineBezier [ V2 (startX + dx1) (startY + dy1)
+ 218 , V2 (endpointX + dxe) (endpointY + dye)
+ 219 , V2 endpointX endpointY ] : calcSegments endpointX endpointY theta2 (segments - 1)
+ 220 where
+ 221 cosTheta1 = cos theta1
+ 222 sinTheta1 = sin theta1
+ 223 theta2 = theta1 + delta
+ 224 cosTheta2 = cos theta2
+ 225 sinTheta2 = sin theta2
+ 226
+ 227 endpointX = cosPhi * rx * cosTheta2 - sinPhi * ry * sinTheta2 + cx
+ 228 endpointY = sinPhi * rx * cosTheta2 + cosPhi * ry * sinTheta2 + cy
+ 229
+ 230 dx1 = t * (-cosPhi * rx * sinTheta1 - sinPhi * ry * cosTheta1)
+ 231 dy1 = t * (-sinPhi * rx * sinTheta1 + cosPhi * ry * cosTheta1)
+ 232
+ 233 dxe = t * (cosPhi * rx * sinTheta2 + sinPhi * ry * cosTheta2)
+ 234 dye = t * (sinPhi * rx * sinTheta2 - cosPhi * ry * cosTheta2)
+ 235
+ 236 partialBezierPoints :: [RPoint] -> Double -> Double -> [RPoint]
+ 237 partialBezierPoints ps a b =
+ 238 let c1 = Bezier.AnyBezier (V.fromList ps)
+ 239 Bezier.AnyBezier os = Bezier.bezierSubsegment c1 a b
+ 240 in V.toList os
+ 241
+ 242 interpolatePathCommands :: Double -> [PathCommand] -> [PathCommand]
+ 243 interpolatePathCommands alpha = lineToPath . partialLine alpha . toLineCommands
+ 244
+ 245 {- | Create an image showing portion of a path.
+ 246 Note that this only affects paths (see 'Reanimate.Svg.Constructors.mkPath').
+ 247 You can also use this with other SVG shapes if you convert them to path first (see 'Reanimate.Svg.pathify').
+ 248
+ 249 Typical usage:
+ 250
+ 251 > animate $ \t -> partialSvg t myPath
+ 252 -}
+ 253 partialSvg :: Double -- ^ number between 0 and 1 inclusively, determining what portion of the path to show
+ 254 -> Tree -- ^ Image representing a path, of which we only want to display a portion determined by the first argument
+ 255 -> Tree
+ 256 partialSvg alpha | alpha >= 1 = id
+ 257 partialSvg alpha = mapTree worker
+ 258 where
+ 259 worker (PathTree path) =
+ 260 PathTree $ path & pathDefinition %~ lineToPath . partialLine alpha . toLineCommands
+ 261 worker t = t
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse.hs.html
new file mode 100644
index 0000000..4b70acc
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse.hs.html
@@ -0,0 +1,83 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 module Reanimate.Svg.Unuse
+ 2 ( replaceUses
+ 3 , unbox
+ 4 , embedDocument
+ 5 ) where
+ 6
+ 7 import Control.Lens ((%~), (&), (.~), (?~), (^.))
+ 8 import qualified Data.Map as Map
+ 9 import Data.Maybe
+ 10 import Graphics.SvgTree hiding (line, path, use)
+ 11 import Reanimate.Constants
+ 12 import Reanimate.Svg.Constructors
+ 13
+ 14 replaceUses :: Document -> Document
+ 15 replaceUses doc = doc & elements %~ map (mapTree replace)
+ 16 where
+ 17 replaceDefinition PathTree{} = None
+ 18 replaceDefinition t = t
+ 19
+ 20 replace t@DefinitionTree{} = mapTree replaceDefinition t
+ 21 replace (UseTree _ Just{}) = error "replaceUses: subtree in use?"
+ 22 replace (UseTree use Nothing) =
+ 23 case Map.lookup (use^.useName) idMap of
+ 24 Nothing -> error $ "Unknown id: " ++ (use^.useName)
+ 25 Just tree -> mapTree replace $
+ 26 GroupTree $
+ 27 defaultSvg & groupChildren .~ [tree]
+ 28 & transform ?~
+ 29 fromMaybe [] (use^.transform) ++
+ 30 [baseToTransformation (use^.useBase)]
+ 31 replace x = x
+ 32 baseToTransformation (x,y) =
+ 33 case (toUserUnit defaultDPI x, toUserUnit defaultDPI y) of
+ 34 (Num a, Num b) -> Translate a b
+ 35 _ -> TransformUnknown
+ 36 docTree = mkGroup (doc^.elements)
+ 37 idMap = foldTree updMap Map.empty docTree
+ 38 updMap m tree =
+ 39 case tree^.attrId of
+ 40 Nothing -> m
+ 41 Just tid -> Map.insert tid tree m
+ 42
+ 43 -- FIXME: the viewbox is ignored. Can we use the viewbox as a mask?
+ 44 -- Transform out viewbox. defs and CSS rules are discarded.
+ 45 unbox :: Document -> Tree
+ 46 unbox doc@Document{_viewBox = Just (_minx, _minw, _width, _height)} =
+ 47 GroupTree $ defaultSvg
+ 48 & groupChildren .~ doc^.elements
+ 49 unbox doc =
+ 50 GroupTree $ defaultSvg
+ 51 & groupChildren .~ doc^.elements
+ 52
+ 53 embedDocument :: Document -> Tree
+ 54 embedDocument doc =
+ 55 translate (-screenWidth/2) (screenHeight/2) $
+ 56 withFillOpacity 1 $
+ 57 withStrokeWidth 0 $
+ 58 flipYAxis $
+ 59 SvgTree $ doc & width .~ Nothing
+ 60 & height .~ Nothing
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Svg.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Svg.hs.html
new file mode 100644
index 0000000..7f3d2c4
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Svg.hs.html
@@ -0,0 +1,336 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 {-# LANGUAGE LambdaCase #-}
+ 2 module Reanimate.Svg
+ 3 ( module Reanimate.Svg
+ 4 , module Reanimate.Svg.Constructors
+ 5 , module Reanimate.Svg.LineCommand
+ 6 , module Reanimate.Svg.BoundingBox
+ 7 , module Reanimate.Svg.Unuse
+ 8 ) where
+ 9
+ 10 import Control.Lens ((%~), (&), (.~), (^.), (?~))
+ 11 import Control.Monad.State
+ 12 import Graphics.SvgTree hiding (height, line, path, use,
+ 13 width)
+ 14 import Linear.V2 hiding (angle)
+ 15 import Reanimate.Constants
+ 16 import Reanimate.Animation (SVG)
+ 17 import Reanimate.Svg.Constructors
+ 18 import Reanimate.Svg.LineCommand
+ 19 import Reanimate.Svg.BoundingBox
+ 20 import Reanimate.Svg.Unuse
+ 21 import qualified Reanimate.Transform as Transform
+ 22
+ 23 lowerTransformations :: Tree -> Tree
+ 24 lowerTransformations = worker False Transform.identity
+ 25 where
+ 26 updLineCmd m cmd =
+ 27 case cmd of
+ 28 LineMove p -> LineMove $ Transform.transformPoint m p
+ 29 -- LineDraw p -> LineDraw $ Transform.transformPoint m p
+ 30 LineBezier ps -> LineBezier $ map (Transform.transformPoint m) ps
+ 31 LineEnd p -> LineEnd $ Transform.transformPoint m p
+ 32 updPath m = lineToPath . map (updLineCmd m) . toLineCommands
+ 33 updPoint m (Num a,Num b) =
+ 34 case Transform.transformPoint m (V2 a b) of
+ 35 V2 x y -> (Num x, Num y)
+ 36 updPoint _ other = other -- XXX: Can we do better here?
+ 37 worker hasPathified m t =
+ 38 let m' = m * Transform.mkMatrix (t^.transform) in
+ 39 case t of
+ 40 PathTree path -> PathTree $
+ 41 path & pathDefinition %~ updPath m'
+ 42 & transform .~ Nothing
+ 43 GroupTree g -> GroupTree $
+ 44 g & groupChildren %~ map (worker hasPathified m')
+ 45 & transform .~ Nothing
+ 46 LineTree line ->
+ 47 LineTree $
+ 48 line & linePoint1 %~ updPoint m
+ 49 & linePoint2 %~ updPoint m
+ 50 ClipPathTree{} -> t
+ 51 -- If we encounter an unknown node and we've already tried to convert
+ 52 -- to paths, give up and insert an explicit transformation.
+ 53 _ | hasPathified ->
+ 54 mkGroup [t] & transform ?~ [ Transform.toTransformation m ]
+ 55 -- If we haven't tried to pathify, run pathify only once.
+ 56 _ -> worker True m (pathify t)
+ 57
+ 58 lowerIds :: Tree -> Tree
+ 59 lowerIds = mapTree worker
+ 60 where
+ 61 worker t@GroupTree{} = t & attrId .~ Nothing
+ 62 worker t@PathTree{} = t & attrId .~ Nothing
+ 63 worker t = t
+ 64
+ 65 simplify :: Tree -> Tree
+ 66 simplify root =
+ 67 case worker root of
+ 68 [] -> None
+ 69 [x] -> x
+ 70 xs -> mkGroup xs
+ 71 where
+ 72 worker None = []
+ 73 worker (DefinitionTree d) =
+ 74 concatMap dropNulls
+ 75 [DefinitionTree $ d & groupChildren %~ concatMap worker]
+ 76 worker (GroupTree g)
+ 77 | g ^. drawAttributes == defaultSvg =
+ 78 concatMap dropNulls $
+ 79 concatMap worker (g^.groupChildren)
+ 80 | otherwise =
+ 81 dropNulls $
+ 82 GroupTree $ g & groupChildren %~ concatMap worker
+ 83 worker t = dropNulls t
+ 84
+ 85 dropNulls None = []
+ 86 dropNulls (DefinitionTree d)
+ 87 | null (d^.groupChildren) = []
+ 88 dropNulls (GroupTree g)
+ 89 | null (g^.groupChildren) = []
+ 90 dropNulls t = [t]
+ 91
+ 92 removeGroups :: Tree -> [Tree]
+ 93 removeGroups = worker defaultSvg
+ 94 where
+ 95 worker _attr None = []
+ 96 worker _attr (DefinitionTree d) =
+ 97 concatMap dropNulls
+ 98 [DefinitionTree $ d & groupChildren %~ concatMap (worker defaultSvg)]
+ 99 worker attr (GroupTree g)
+ 100 | g ^. drawAttributes == defaultSvg =
+ 101 concatMap dropNulls $
+ 102 concatMap (worker attr) (g^.groupChildren)
+ 103 | otherwise =
+ 104 concatMap (worker (attr <> g ^. drawAttributes)) (g^.groupChildren)
+ 105 worker attr t = dropNulls (t & drawAttributes .~ attr)
+ 106
+ 107 dropNulls None = []
+ 108 dropNulls (DefinitionTree d)
+ 109 | null (d^.groupChildren) = []
+ 110 dropNulls (GroupTree g)
+ 111 | null (g^.groupChildren) = []
+ 112 dropNulls t = [t]
+ 113
+ 114 extractPath :: Tree -> [PathCommand]
+ 115 extractPath = worker . simplify . lowerTransformations . pathify
+ 116 where
+ 117 worker (GroupTree g) = concatMap worker (g^.groupChildren)
+ 118 worker (PathTree p) = p^.pathDefinition
+ 119 worker _ = []
+ 120
+ 121 withSubglyphs :: [Int] -> (Tree -> Tree) -> Tree -> Tree
+ 122 withSubglyphs target fn = \t -> evalState (worker t) 0
+ 123 where
+ 124 worker :: Tree -> State Int Tree
+ 125 worker t =
+ 126 case t of
+ 127 GroupTree g -> do
+ 128 cs <- mapM worker (g ^. groupChildren)
+ 129 return $ GroupTree $ g & groupChildren .~ cs
+ 130 PathTree{} -> handleGlyph t
+ 131 CircleTree{} -> handleGlyph t
+ 132 PolyLineTree{} -> handleGlyph t
+ 133 PolygonTree{} -> handleGlyph t
+ 134 EllipseTree{} -> handleGlyph t
+ 135 LineTree{} -> handleGlyph t
+ 136 RectangleTree{} -> handleGlyph t
+ 137 _ -> return t
+ 138 handleGlyph :: Tree -> State Int Tree
+ 139 handleGlyph svg = do
+ 140 n <- get <* modify (+1)
+ 141 if n `elem` target
+ 142 then return $ fn svg
+ 143 else return svg
+ 144
+ 145 splitGlyphs :: [Int] -> Tree -> (Tree, Tree)
+ 146 splitGlyphs target = \t ->
+ 147 let (_, l, r) = execState (worker id t) (0, [], [])
+ 148 in (mkGroup l, mkGroup r)
+ 149 where
+ 150 handleGlyph :: Tree -> State (Int, [Tree], [Tree]) ()
+ 151 handleGlyph t = do
+ 152 (n, l, r) <- get
+ 153 if n `elem` target
+ 154 then put (n+1, l, t:r)
+ 155 else put (n+1, t:l, r)
+ 156 worker :: (Tree -> Tree) -> Tree -> State (Int, [Tree], [Tree]) ()
+ 157 worker acc t =
+ 158 case t of
+ 159 GroupTree g -> do
+ 160 let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])
+ 161 mapM_ (worker acc') (g ^. groupChildren)
+ 162 PathTree{} -> handleGlyph $ acc t
+ 163 CircleTree{} -> handleGlyph $ acc t
+ 164 PolyLineTree{} -> handleGlyph $ acc t
+ 165 PolygonTree{} -> handleGlyph $ acc t
+ 166 EllipseTree{} -> handleGlyph $ acc t
+ 167 LineTree{} -> handleGlyph $ acc t
+ 168 RectangleTree{} -> handleGlyph $ acc t
+ 169 DefinitionTree{} -> return ()
+ 170 _ ->
+ 171 modify $ \(n, l, r) -> (n, acc t:l, r)
+ 172 {-
+ 173 <g transform="translate(10,10)">
+ 174 <g transform="scale(2)">
+ 175 <circle/>
+ 176 </g>
+ 177 <g transform="scale(0.5)">
+ 178 <rect/>
+ 179 </g>
+ 180 </g>
+ 181
+ 182 [ (\svg -> <g transform="translate(10,10)"><g transform="scale(2)">svg</g></g>, <circle/>)
+ 183 , (\svg -> <g transform="translate(10,10)"><g transform="scale(0.5)">svg</g></g>, <rect/>)]
+ 184 -}
+ 185 svgGlyphs :: Tree -> [(Tree -> Tree, DrawAttributes, Tree)]
+ 186 svgGlyphs = worker id defaultSvg
+ 187 where
+ 188 worker acc attr =
+ 189 \case
+ 190 None -> []
+ 191 GroupTree g ->
+ 192 let acc' sub = acc (GroupTree $ g & groupChildren .~ [sub])
+ 193 attr' = (g^.drawAttributes) `mappend` attr
+ 194 in concatMap (worker acc' attr') (g ^. groupChildren)
+ 195 t -> [(acc, (t^.drawAttributes) `mappend` attr, t)]
+ 196
+ 197 {-| Convert primitive SVG shapes (like those created by 'mkCircle', 'mkRect', 'mkLine' or
+ 198 'mkEllipse') into SVG path. This can be useful for creating animations of these shapes being
+ 199 drawn progressively with 'partialSvg'.
+ 200
+ 201 Example:
+ 202
+ 203 > pathifyExample :: Animation
+ 204 > pathifyExample = animate $ \t -> gridLayout
+ 205 > [ [ partialSvg t $ pathify $ mkCircle 1
+ 206 > , partialSvg t $ pathify $ mkRect 2 2
+ 207 > ]
+ 208 > , [ partialSvg t $ pathify $ mkEllipse 1 0.5
+ 209 > , partialSvg t $ pathify $ mkLine (-1, -1) (1, 1)
+ 210 > ]
+ 211 > ]
+ 212
+ 213 <<docs/gifs/doc_pathify.gif>>
+ 214 -}
+ 215 pathify :: Tree -> Tree
+ 216 pathify = mapTree worker
+ 217 where
+ 218 worker =
+ 219 \case
+ 220 RectangleTree rect | Just (x,y,w,h) <- unpackRect rect ->
+ 221 PathTree $ defaultSvg
+ 222 & drawAttributes .~ rect ^. drawAttributes
+ 223 & strokeLineCap .~ pure CapSquare
+ 224 & pathDefinition .~
+ 225 [MoveTo OriginAbsolute [V2 x y]
+ 226 ,HorizontalTo OriginRelative [w]
+ 227 ,VerticalTo OriginRelative [h]
+ 228 ,HorizontalTo OriginRelative [-w]
+ 229 ,EndPath ]
+ 230 LineTree line | Just (x1,y1, x2, y2) <- unpackLine line ->
+ 231 PathTree $ defaultSvg
+ 232 & drawAttributes .~ line ^. drawAttributes
+ 233 & pathDefinition .~
+ 234 [MoveTo OriginAbsolute [V2 x1 y1]
+ 235 ,LineTo OriginAbsolute [V2 x2 y2] ]
+ 236 CircleTree circ | Just (x, y, r) <- unpackCircle circ ->
+ 237 PathTree $ defaultSvg
+ 238 & drawAttributes .~ circ ^. drawAttributes
+ 239 & pathDefinition .~
+ 240 [MoveTo OriginAbsolute [V2 (x-r) y]
+ 241 ,EllipticalArc OriginRelative [(r, r, 0,True,False,V2 (r*2) 0)
+ 242 ,(r, r, 0,True,False,V2 (-r*2) 0)]]
+ 243 PolyLineTree pl ->
+ 244 let points = pl ^. polyLinePoints
+ 245 in PathTree $ defaultSvg
+ 246 & drawAttributes .~ pl ^. drawAttributes
+ 247 & pathDefinition .~ pointsToPathCommands points
+ 248 PolygonTree pg ->
+ 249 let points = pg ^. polygonPoints
+ 250 in PathTree $ defaultSvg
+ 251 & drawAttributes .~ pg ^. drawAttributes
+ 252 -- Polygon automatically connects the last point to the first. For path we must do
+ 253 -- it explicitly
+ 254 & pathDefinition .~ (pointsToPathCommands points ++ [EndPath])
+ 255 EllipseTree elip | Just (cx,cy,rx,ry) <- unpackEllipse elip ->
+ 256 PathTree $ defaultSvg
+ 257 & drawAttributes .~ elip ^. drawAttributes
+ 258 & pathDefinition .~
+ 259 [ MoveTo OriginAbsolute [V2 (cx-rx) cy]
+ 260 , EllipticalArc OriginRelative [(rx, ry, 0,True,False,V2 (rx*2) 0)
+ 261 ,(rx, ry, 0,True,False,V2 (-rx*2) 0)]]
+ 262 t -> t
+ 263 unpackCircle circ = do
+ 264 let (x,y) = circ ^. circleCenter
+ 265 liftM3 (,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ circ ^. circleRadius)
+ 266 unpackEllipse elip = do
+ 267 let (x,y) = elip ^. ellipseCenter
+ 268 liftM4 (,,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ elip ^. ellipseXRadius)
+ 269 (unpackNumber $ elip ^. ellipseYRadius)
+ 270 unpackLine line = do
+ 271 let (x1,y1) = line ^. linePoint1
+ 272 (x2,y2) = line ^. linePoint2
+ 273 liftM4 (,,,) (unpackNumber x1) (unpackNumber y1) (unpackNumber x2) (unpackNumber y2)
+ 274 unpackRect rect = do
+ 275 let (x', y') = rect ^. rectUpperLeftCorner
+ 276 x <- unpackNumber x'
+ 277 y <- unpackNumber y'
+ 278 w <- unpackNumber =<< rect ^. rectWidth
+ 279 h <- unpackNumber =<< rect ^. rectHeight
+ 280 return (x,y,w,h)
+ 281 pointsToPathCommands points = case points of
+ 282 [] -> []
+ 283 (p:ps) -> [ MoveTo OriginAbsolute [p]
+ 284 , LineTo OriginAbsolute ps ]
+ 285 unpackNumber n =
+ 286 case toUserUnit defaultDPI n of
+ 287 Num d -> Just d
+ 288 _ -> Nothing
+ 289
+ 290 mapSvgPaths :: ([PathCommand] -> [PathCommand]) -> SVG -> SVG
+ 291 mapSvgPaths fn = mapTree worker
+ 292 where
+ 293 worker =
+ 294 \case
+ 295 PathTree path -> PathTree $
+ 296 path & pathDefinition %~ fn
+ 297 t -> t
+ 298
+ 299 mapSvgLines :: ([LineCommand] -> [LineCommand]) -> SVG -> SVG
+ 300 mapSvgLines fn = mapSvgPaths (lineToPath . fn . toLineCommands)
+ 301
+ 302 -- Only maps points in paths
+ 303 mapSvgPoints :: (RPoint -> RPoint) -> SVG -> SVG
+ 304 mapSvgPoints fn = mapSvgLines (map worker)
+ 305 where
+ 306 worker (LineMove p) = LineMove (fn p)
+ 307 worker (LineBezier ps) = LineBezier (map fn ps)
+ 308 worker (LineEnd p) = LineEnd (fn p)
+ 309
+ 310 svgPointsToRadians :: SVG -> SVG
+ 311 svgPointsToRadians = mapSvgPoints worker
+ 312 where
+ 313 worker (V2 x y) = V2 (x/180*pi) (y/180*pi)
+
+
+
+
diff --git a/reanimate-0.4.1.0-inplace/Reanimate.Transform.hs.html b/reanimate-0.4.1.0-inplace/Reanimate.Transform.hs.html
new file mode 100644
index 0000000..9c24b36
--- /dev/null
+++ b/reanimate-0.4.1.0-inplace/Reanimate.Transform.hs.html
@@ -0,0 +1,84 @@
+
+
+
+
+
+
+
+never executed always true always false
+
+
+ 1 {-# LANGUAGE BangPatterns #-}
+ 2 {-# LANGUAGE PackageImports #-}
+ 3 module Reanimate.Transform
+ 4 ( identity
+ 5 , transformPoint
+ 6 , mkMatrix
+ 7 , toTransformation
+ 8 ) where
+ 9
+ 10 -- XXX: Use Linear.Matrix instead of Data.Matrix to drop the 'matrix' dependency.
+ 11 import Data.List
+ 12 import "matrix" Data.Matrix (Matrix)
+ 13 import qualified "matrix" Data.Matrix as M
+ 14 import Data.Maybe
+ 15 import Graphics.SvgTree
+ 16 import Linear.V2
+ 17
+ 18 type TMatrix = Matrix Coord
+ 19
+ 20 identity :: TMatrix
+ 21 identity = M.identity 3
+ 22
+ 23 fromList :: [Coord] -> TMatrix
+ 24 fromList [a,b,c,d,e,f] = M.fromList 3 3 [a,c,e,b,d,f,0,0,1]
+ 25 fromList _ = error "Reanimate.Transform.fromList: bad input"
+ 26
+ 27 transformPoint :: TMatrix -> RPoint -> RPoint
+ 28 transformPoint m (V2 x y) = V2 (a*x +c*y + e) (b*x + d*y +f)
+ 29 where
+ 30 !a = M.unsafeGet 1 1 m
+ 31 !c = M.unsafeGet 1 2 m
+ 32 !e = M.unsafeGet 1 3 m
+ 33 !b = M.unsafeGet 2 1 m
+ 34 !d = M.unsafeGet 2 2 m
+ 35 !f = M.unsafeGet 2 3 m
+ 36 -- (a:c:e:b:d:f:_) = M.toList m
+ 37
+ 38 mkMatrix :: Maybe [Transformation] -> TMatrix
+ 39 mkMatrix Nothing = identity
+ 40 mkMatrix (Just ts) = foldl' (*) identity (map transformationMatrix ts)
+ 41
+ 42 transformationMatrix :: Transformation -> TMatrix
+ 43 transformationMatrix transformation =
+ 44 case transformation of
+ 45 TransformMatrix a b c d e f -> fromList [a,b,c,d,e,f]
+ 46 Translate x y -> translate x y
+ 47 Scale sx mbSy -> fromList [sx,0,0,fromMaybe sx mbSy,0,0]
+ 48 Rotate a Nothing -> rotate a
+ 49 Rotate a (Just (x,y)) -> translate x y * rotate a * translate (-x) (-y)
+ 50 SkewX a -> fromList [1,0,tan (a*pi/180),1,0,0]
+ 51 SkewY a -> fromList [1,tan (a*pi/180),0,1,0,0]
+ 52 TransformUnknown -> identity
+ 53 where
+ 54 translate x y = fromList [1,0,0,1,x,y]
+ 55 rotate a = fromList [cos r,sin r,-sin r,cos r,0,0]
+ 56 where r = a * pi / 180
+ 57
+ 58 toTransformation :: TMatrix -> Transformation
+ 59 toTransformation m = TransformMatrix a b c d e f
+ 60 where
+ 61 [a,c,e,b,d,f,_,_,_] = M.toList m
+
+
+
+
