From c657d1a52d2930da99114d2dd11b9ebb57724491 Mon Sep 17 00:00:00 2001 From: Lemmih Date: Wed, 5 Aug 2020 13:36:11 +0000 Subject: [PATCH] =?UTF-8?q?Deploying=20to=20gh-pages=20from=20=20@=20569b7?= =?UTF-8?q?94d74f425480f70187ffc8ee8923860d5fa=20=F0=9F=9A=80?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- hpc_index.html | 81 ++++ hpc_index_alt.html | 81 ++++ hpc_index_exp.html | 81 ++++ hpc_index_fun.html | 81 ++++ .../Paths_reanimate.hs.html | 73 +++ .../Reanimate.Animation.hs.html | 405 ++++++++++++++++ .../Reanimate.Builtin.Documentation.hs.html | 76 +++ .../Reanimate.Cache.hs.html | 134 ++++++ .../Reanimate.Constants.hs.html | 51 ++ .../Reanimate.Driver.CLI.hs.html | 246 ++++++++++ .../Reanimate.Driver.Check.hs.html | 229 +++++++++ .../Reanimate.Driver.Compile.hs.html | 58 +++ .../Reanimate.Driver.Magick.hs.html | 41 ++ .../Reanimate.Driver.Server.hs.html | 321 +++++++++++++ .../Reanimate.Driver.hs.html | 246 ++++++++++ .../Reanimate.Ease.hs.html | 130 ++++++ .../Reanimate.Internal.CubicBezier.hs.html | 287 ++++++++++++ .../Reanimate.Misc.hs.html | 131 ++++++ .../Reanimate.Parameters.hs.html | 123 +++++ .../Reanimate.Raster.hs.html | 318 +++++++++++++ .../Reanimate.Render.hs.html | 390 ++++++++++++++++ .../Reanimate.Svg.BoundingBox.hs.html | 136 ++++++ .../Reanimate.Svg.Constructors.hs.html | 436 ++++++++++++++++++ .../Reanimate.Svg.LineCommand.hs.html | 284 ++++++++++++ .../Reanimate.Svg.Unuse.hs.html | 83 ++++ .../Reanimate.Svg.hs.html | 336 ++++++++++++++ .../Reanimate.Transform.hs.html | 84 ++++ 27 files changed, 4942 insertions(+) create mode 100644 hpc_index.html create mode 100644 hpc_index_alt.html create mode 100644 hpc_index_exp.html create mode 100644 hpc_index_fun.html create mode 100644 reanimate-0.4.1.0-inplace/Paths_reanimate.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Animation.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Cache.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Constants.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Driver.Check.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Driver.Server.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Driver.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Ease.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Internal.CubicBezier.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Misc.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Parameters.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Raster.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Render.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Svg.hs.html create mode 100644 reanimate-0.4.1.0-inplace/Reanimate.Transform.hs.html 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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.4.1.0-inplace/Paths_reanimate0%0/15
- 0/0 0%0/58
  module reanimate-0.4.1.0-inplace/Reanimate.Animation21%7/33
21%3/14
24%84/349
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation42%3/7
- 0/0 35%47/134
  module reanimate-0.4.1.0-inplace/Reanimate.Cache0%0/8
0%0/12
0%0/160
  module reanimate-0.4.1.0-inplace/Reanimate.Constants37%3/8
- 0/0 16%3/18
  module reanimate-0.4.1.0-inplace/Reanimate.Driver8%1/12
1%1/55
3%8/246
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI14%5/35
0%0/63
8%31/376
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Check0%0/21
0%0/27
0%0/396
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile0%0/2
0%0/4
0%0/64
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick0%0/1
- 0/0 0%0/12
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Server0%0/16
0%0/30
0%0/634
  module reanimate-0.4.1.0-inplace/Reanimate.Ease0%0/9
0%0/8
0%0/121
  module reanimate-0.4.1.0-inplace/Reanimate.Internal.CubicBezier8%7/86
0%0/26
11%39/337
  module reanimate-0.4.1.0-inplace/Reanimate.Misc0%0/7
0%0/14
0%0/162
  module reanimate-0.4.1.0-inplace/Reanimate.Parameters10%2/20
- 0/0 8%4/49
  module reanimate-0.4.1.0-inplace/Reanimate.Raster0%0/13
0%0/17
0%0/443
  module reanimate-0.4.1.0-inplace/Reanimate.Render5%1/18
0%0/44
5%39/762
  module reanimate-0.4.1.0-inplace/Reanimate.Svg7%1/13
5%4/80
17%137/777
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox0%0/5
0%0/36
0%0/281
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors24%12/49
12%1/8
19%110/565
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand75%12/16
51%38/74
65%620/943
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse0%0/3
0%0/14
0%0/128
  module reanimate-0.4.1.0-inplace/Reanimate.Transform0%0/6
0%0/12
0%0/166
  Program Coverage Total13%54/403
8%47/538
15%1122/7181
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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand75%12/16
51%38/74
65%620/943
  module reanimate-0.4.1.0-inplace/Reanimate.Animation21%7/33
21%3/14
24%84/349
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors24%12/49
12%1/8
19%110/565
  module reanimate-0.4.1.0-inplace/Reanimate.Svg7%1/13
5%4/80
17%137/777
  module reanimate-0.4.1.0-inplace/Reanimate.Driver8%1/12
1%1/55
3%8/246
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse0%0/3
0%0/14
0%0/128
  module reanimate-0.4.1.0-inplace/Reanimate.Cache0%0/8
0%0/12
0%0/160
  module reanimate-0.4.1.0-inplace/Reanimate.Raster0%0/13
0%0/17
0%0/443
  module reanimate-0.4.1.0-inplace/Reanimate.Misc0%0/7
0%0/14
0%0/162
  module reanimate-0.4.1.0-inplace/Reanimate.Render5%1/18
0%0/44
5%39/762
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile0%0/2
0%0/4
0%0/64
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Server0%0/16
0%0/30
0%0/634
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI14%5/35
0%0/63
8%31/376
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Check0%0/21
0%0/27
0%0/396
  module reanimate-0.4.1.0-inplace/Reanimate.Internal.CubicBezier8%7/86
0%0/26
11%39/337
  module reanimate-0.4.1.0-inplace/Reanimate.Transform0%0/6
0%0/12
0%0/166
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox0%0/5
0%0/36
0%0/281
  module reanimate-0.4.1.0-inplace/Reanimate.Ease0%0/9
0%0/8
0%0/121
  module reanimate-0.4.1.0-inplace/Reanimate.Parameters10%2/20
- 0/0 8%4/49
  module reanimate-0.4.1.0-inplace/Paths_reanimate0%0/15
- 0/0 0%0/58
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick0%0/1
- 0/0 0%0/12
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation42%3/7
- 0/0 35%47/134
  module reanimate-0.4.1.0-inplace/Reanimate.Constants37%3/8
- 0/0 16%3/18
  Program Coverage Total13%54/403
8%47/538
15%1122/7181
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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand75%12/16
51%38/74
65%620/943
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation42%3/7
- 0/0 35%47/134
  module reanimate-0.4.1.0-inplace/Reanimate.Animation21%7/33
21%3/14
24%84/349
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors24%12/49
12%1/8
19%110/565
  module reanimate-0.4.1.0-inplace/Reanimate.Svg7%1/13
5%4/80
17%137/777
  module reanimate-0.4.1.0-inplace/Reanimate.Constants37%3/8
- 0/0 16%3/18
  module reanimate-0.4.1.0-inplace/Reanimate.Internal.CubicBezier8%7/86
0%0/26
11%39/337
  module reanimate-0.4.1.0-inplace/Reanimate.Parameters10%2/20
- 0/0 8%4/49
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI14%5/35
0%0/63
8%31/376
  module reanimate-0.4.1.0-inplace/Reanimate.Render5%1/18
0%0/44
5%39/762
  module reanimate-0.4.1.0-inplace/Reanimate.Driver8%1/12
1%1/55
3%8/246
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse0%0/3
0%0/14
0%0/128
  module reanimate-0.4.1.0-inplace/Reanimate.Cache0%0/8
0%0/12
0%0/160
  module reanimate-0.4.1.0-inplace/Reanimate.Raster0%0/13
0%0/17
0%0/443
  module reanimate-0.4.1.0-inplace/Reanimate.Misc0%0/7
0%0/14
0%0/162
  module reanimate-0.4.1.0-inplace/Paths_reanimate0%0/15
- 0/0 0%0/58
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile0%0/2
0%0/4
0%0/64
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Server0%0/16
0%0/30
0%0/634
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick0%0/1
- 0/0 0%0/12
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Check0%0/21
0%0/27
0%0/396
  module reanimate-0.4.1.0-inplace/Reanimate.Transform0%0/6
0%0/12
0%0/166
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox0%0/5
0%0/36
0%0/281
  module reanimate-0.4.1.0-inplace/Reanimate.Ease0%0/9
0%0/8
0%0/121
  Program Coverage Total13%54/403
8%47/538
15%1122/7181
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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
moduleTop Level DefinitionsAlternativesExpressions
%covered / total%covered / total%covered / total
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.LineCommand75%12/16
51%38/74
65%620/943
  module reanimate-0.4.1.0-inplace/Reanimate.Builtin.Documentation42%3/7
- 0/0 35%47/134
  module reanimate-0.4.1.0-inplace/Reanimate.Constants37%3/8
- 0/0 16%3/18
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Constructors24%12/49
12%1/8
19%110/565
  module reanimate-0.4.1.0-inplace/Reanimate.Animation21%7/33
21%3/14
24%84/349
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.CLI14%5/35
0%0/63
8%31/376
  module reanimate-0.4.1.0-inplace/Reanimate.Parameters10%2/20
- 0/0 8%4/49
  module reanimate-0.4.1.0-inplace/Reanimate.Driver8%1/12
1%1/55
3%8/246
  module reanimate-0.4.1.0-inplace/Reanimate.Internal.CubicBezier8%7/86
0%0/26
11%39/337
  module reanimate-0.4.1.0-inplace/Reanimate.Svg7%1/13
5%4/80
17%137/777
  module reanimate-0.4.1.0-inplace/Reanimate.Render5%1/18
0%0/44
5%39/762
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.Unuse0%0/3
0%0/14
0%0/128
  module reanimate-0.4.1.0-inplace/Reanimate.Cache0%0/8
0%0/12
0%0/160
  module reanimate-0.4.1.0-inplace/Reanimate.Raster0%0/13
0%0/17
0%0/443
  module reanimate-0.4.1.0-inplace/Reanimate.Misc0%0/7
0%0/14
0%0/162
  module reanimate-0.4.1.0-inplace/Paths_reanimate0%0/15
- 0/0 0%0/58
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Compile0%0/2
0%0/4
0%0/64
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Server0%0/16
0%0/30
0%0/634
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Magick0%0/1
- 0/0 0%0/12
  module reanimate-0.4.1.0-inplace/Reanimate.Driver.Check0%0/21
0%0/27
0%0/396
  module reanimate-0.4.1.0-inplace/Reanimate.Transform0%0/6
0%0/12
0%0/166
  module reanimate-0.4.1.0-inplace/Reanimate.Svg.BoundingBox0%0/5
0%0/36
0%0/281
  module reanimate-0.4.1.0-inplace/Reanimate.Ease0%0/9
0%0/8
0%0/121
  Program Coverage Total13%54/403
8%47/538
15%1122/7181
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
+
+
+ +