reanimate 1.1.4.0 → 1.1.5.0
raw patch · 22 files changed
+384/−141 lines, 22 filesdep ~aesonPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson
API changes (from Hackage documentation)
+ Reanimate: signalS :: Sprite s -> Duration -> Signal -> Scene s ()
+ Reanimate.Animation: unsafeMkAnimation :: Duration -> (Time -> SVG) -> Animation
+ Reanimate.Scene: signalO :: Object s a -> Duration -> Signal -> Scene s ()
+ Reanimate.Scene: signalS :: Sprite s -> Duration -> Signal -> Scene s ()
+ Reanimate.Svg.Constructors: withStrokeOpacity :: Double -> Tree -> Tree
Files
- examples/doc_signalO.hs +27/−0
- examples/doc_signalS.hs +13/−0
- examples/tut_glue_povray.hs +7/−3
- examples/tut_glue_povray_ortho.hs +2/−0
- reanimate.cabal +3/−2
- src/Reanimate.hs +1/−0
- src/Reanimate/Animation.hs +79/−47
- src/Reanimate/Cache.hs +3/−3
- src/Reanimate/Driver/Check.hs +3/−2
- src/Reanimate/Math/Triangulate.hs +1/−1
- src/Reanimate/Misc.hs +10/−0
- src/Reanimate/Povray.hs +52/−32
- src/Reanimate/Raster.hs +4/−3
- src/Reanimate/Render.hs +2/−3
- src/Reanimate/Scene.hs +2/−0
- src/Reanimate/Scene/Core.hs +18/−0
- src/Reanimate/Scene/Object.hs +5/−1
- src/Reanimate/Scene/Sprite.hs +27/−10
- src/Reanimate/Svg/BoundingBox.hs +45/−30
- src/Reanimate/Svg/Constructors.hs +14/−4
- unix/POVRay.hs +16/−0
- windows/POVRay.hs +50/−0
+ examples/doc_signalO.hs view
@@ -0,0 +1,27 @@+#!/usr/bin/env stack+-- stack runghc --package reanimate+module Main(main) where++import Reanimate+import Reanimate.Scene+import Reanimate.Builtin.Documentation+import Control.Lens+import Control.Monad++main :: IO ()+main = reanimate $ docEnv $ scene $ do+ objs <- waitOn $ replicateM 3 $ do+ obj1 <- newObject $ mkCircle 1+ oModifyS obj1 $ oEasing .= id+ oModifyS obj1 $ oRightX .= screenRight+ fork $ oShowWith obj1 oFadeIn+ fork $ oTweenS obj1 2 $ \t ->+ oLeftX %= \origin -> fromToS origin screenLeft t+ wait 1+ oHideWith obj1 oFadeOut+ wait (-1.5)+ return obj1+ dur <- queryNow+ wait (-dur)+ forM_ objs $ \obj -> do+ signalO obj dur $ curveS 2
+ examples/doc_signalS.hs view
@@ -0,0 +1,13 @@+#!/usr/bin/env stack+-- stack runghc --package reanimate+module Main(main) where++import Reanimate+import Reanimate.Builtin.Documentation++main :: IO ()+main = reanimate $ docEnv $ playThenReverseA $ scene $ do+ sprite <- fork $ newSpriteA $ drawCircle+ signalS sprite 1 (curveS 2)+ wait 1+ signalS sprite 1 (powerS 2)
examples/tut_glue_povray.hs view
@@ -53,6 +53,8 @@ transZ_ = T.pack $ show transZ rotZ_ = T.pack $ show rotZ in [text|+#version 3.7;+//Files with predefined colors and textures #include "colors.inc" //Place the camera@@ -64,6 +66,8 @@ right x*16/9 } +global_settings { assumed_gamma 1.0 }+ //Ambient light to "brighten up" darker pictures global_settings { ambient_light White*3 } @@ -71,15 +75,15 @@ background { color rgbt <0, 0, 0, 1> } // transparent polygon {- 4,- <0, 0>, <0, 1>, <1, 1>, <1, 0>+ 5,+ <0, 0>, <0, 1>, <1, 1>, <1, 0>, <0, 0> texture { pigment{ image_map{ png "${png_}" } } } translate <-1/2,-1/2>- scale <16,9>+ scale <16,9,1> rotate <0,${rotX_},${rotZ_}> translate <0,0,${transZ_}> }
examples/tut_glue_povray_ortho.hs view
@@ -60,6 +60,7 @@ rotY_ = T.pack $ show rotY rotZ_ = T.pack $ show rotZ in [text|+# version 3.7; //Files with predefined colors and textures #include "colors.inc" @@ -74,6 +75,7 @@ right x*16 } +global_settings { assumed_gamma 1.0 } //Ambient light to "brighten up" darker pictures global_settings { ambient_light White*3 }
reanimate.cabal view
@@ -3,7 +3,7 @@ -- see http://haskell.org/cabal/users-guide/ name: reanimate-version: 1.1.4.0+version: 1.1.5.0 -- synopsis: -- description: license: PublicDomain@@ -111,6 +111,7 @@ Reanimate.Scene.Sprite Reanimate.Scene.Object Detach+ POVRay autogen-modules: Paths_reanimate if flag(no-hgeometry) cpp-options: -DNO_HGEOMETRY@@ -121,7 +122,7 @@ build-depends: base >=4.10 && <5, JuicyPixels >=3.3.3,- aeson >=1.3.0.0,+ aeson >=1.3.0.0 && <2, ansi-terminal >=0.8.0.4, array >=0.5.2.0, attoparsec >=0.13.2.0,
src/Reanimate.hs view
@@ -103,6 +103,7 @@ , unVar -- :: Var s a -> Frame s a , spriteT -- :: Frame s Time , spriteDuration -- :: Frame s Duration+ , signalS -- :: Sprite s -> Duration -> Signal -> Scene s () , newSprite -- :: Frame s SVG -> Scene s (Sprite s) , newSprite_ -- :: Frame s SVG -> Scene s () , newSpriteA -- :: Animation -> Scene s (Sprite s)
src/Reanimate/Animation.hs view
@@ -17,6 +17,7 @@ , Animation -- * Creating animations , mkAnimation+ , unsafeMkAnimation , animate , staticFrame , pause@@ -72,17 +73,26 @@ -- | Animations are SVGs over a finite time. data Animation = Animation Duration (Time -> SVG) --- | Construct an animation with a given duration.+-- | Construct an animation with a given duration. If the duration is not+-- positive throws 'Prelude.error'. mkAnimation :: Duration -> (Time -> SVG) -> Animation-mkAnimation = Animation+mkAnimation d f+ | d > 0 = unsafeMkAnimation d f+ | otherwise = error $ "Animation duration (" ++ show d ++ ") is not positive." +-- | Construct an animation with a given duration, without checking that the+-- duration is positive.+unsafeMkAnimation :: Duration -> (Time -> SVG) -> Animation+unsafeMkAnimation = Animation+ -- | Construct an animation with a duration of @1@. animate :: (Time -> SVG) -> Animation animate = Animation 1 --- | Create an animation with provided @duration@, which consists of stationary frame displayed for its entire duration.+-- | Create an animation with provided @duration@, which consists of stationary+-- frame displayed for its entire duration. staticFrame :: Duration -> SVG -> Animation-staticFrame d svg = Animation d (const svg)+staticFrame d svg = mkAnimation d (const svg) -- | Query the duration of an animation. duration :: Animation -> Duration@@ -162,7 +172,8 @@ where totalD = max d1 d2 --- | Empty animation (no SVG output) with a fixed duration.+-- | Empty animation (no SVG output) with a fixed duration. If the duration is+-- not positive throws 'Prelude.error'. -- -- Example: --@@ -170,7 +181,7 @@ -- -- <<docs/gifs/doc_pause.gif>> pause :: Duration -> Animation-pause d = Animation d (const None)+pause d = mkAnimation d (const None) -- | Play left animation and freeze on the last frame, then play the right -- animation. New duration is '@duration lhs + duration rhs@'.@@ -183,9 +194,10 @@ andThen :: Animation -> Animation -> Animation andThen a b = a `parA` (pause (duration a) `seqA` b) --- | Calculate the frame that would be displayed at given point in @time@ of running @animation@.+-- | Calculate the frame that would be displayed at given point in @time@ of+-- running @animation@. ----- The provided time parameter is clamped between 0 and animation duration.+-- The provided time parameter is clamped between 0 and animation duration. frameAt :: Time -> Animation -> SVG frameAt t (Animation d f) = f t' where@@ -196,8 +208,12 @@ renderTree t = maybe "" ppElement $ xmlOfTree t -- | Helper function for pretty-printing SVG nodes as SVG documents.-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.- -> Maybe Number -- ^ Similar to previous argument, but for @height@ attribute.+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.+ -> Maybe Number -- ^ Similar to previous argument, but for @height@+ -- attribute. -> SVG -- ^ SVG to render -> String -- ^ String representation of SVG XML markup renderSvg w h t = ppDocument doc@@ -226,7 +242,8 @@ mapA :: (SVG -> SVG) -> Animation -> Animation mapA fn (Animation d f) = Animation d (fn . f) --- | Freeze the last frame for @t@ seconds at the end of the animation.+-- | Freeze the last frame for @t@ seconds at the end of the animation. If the+-- duration is negative throws 'Prelude.error'. -- -- Example: --@@ -234,9 +251,12 @@ -- -- <<docs/gifs/doc_pauseAtEnd.gif>> pauseAtEnd :: Duration -> Animation -> Animation-pauseAtEnd t a = a `andThen` pause t+pauseAtEnd t a+ | t == 0 = a+ | otherwise = a `andThen` pause t -- | Freeze the first frame for @t@ seconds at the beginning of the animation.+-- If the duration is negative throws 'Prelude.error'. -- -- Example: --@@ -244,10 +264,12 @@ -- -- <<docs/gifs/doc_pauseAtBeginning.gif>> pauseAtBeginning :: Duration -> Animation -> Animation-pauseAtBeginning t a =- Animation t (freezeFrame 0 a) `seqA` a+pauseAtBeginning t a+ | t == 0 = a+ | otherwise = mkAnimation t (freezeFrame 0 a) `seqA` a --- | Freeze the first and the last frame of the animation for a specified duration.+-- | Freeze the first and the last frame of the animation for a specified+-- duration. If a duration is negative throws 'Prelude.error'. -- -- Example: --@@ -262,13 +284,14 @@ freezeFrame t (Animation d f) = const $ f (t/d) -- | Change the duration of an animation. Animates are stretched or squished--- (rather than truncated) to fit the new duration.+-- (rather than truncated) to fit the new duration. If a changed duration is+-- not positive throws 'Prelude.error'. adjustDuration :: (Duration -> Duration) -> Animation -> Animation-adjustDuration fn (Animation d gen) =- Animation (fn d) gen+adjustDuration fn (Animation d gen) = mkAnimation (fn d) gen -- | Set the duration of an animation by adjusting its playback rate. The--- animation is still played from start to finish without being cropped.+-- animation is still played from start to finish without being cropped. If+-- the duration is not positive throws 'Prelude.error'. setDuration :: Duration -> Animation -> Animation setDuration newD = adjustDuration (const newD) @@ -295,8 +318,8 @@ playThenReverseA a = a `seqA` reverseA a -- | Loop animation @n@ number of times. This number may be fractional and it--- may be less than 1. It must be greater than or equal to 0, though.--- New duration is @n*duration input@.+-- may be less than 1. It must be greater than 0, though. New duration is+-- @n*duration input@. If the duration is not positive throws 'Prelude.error'. -- -- Example: --@@ -304,16 +327,21 @@ -- -- <<docs/gifs/doc_repeatA.gif>> repeatA :: Double -> Animation -> Animation-repeatA n (Animation d f) = Animation (d*n) $ \t ->- f ((t*n) `mod'` 1)-+repeatA n (Animation d f) = mkAnimation (d*n) $ \t -> f ((t*n) `mod'` 1) --- | @freezeAtPercentage time animation@ creates an animation consisting of stationary frame,--- that would be displayed in the provided @animation@ at given @time@.--- The duration of the new animation is the same as the duration of provided @animation@.-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- -> Animation -- ^ original animation, from which the frame will be taken- -> Animation -- ^ new animation consisting of static frame displayed for the duration of the original animation+-- | @freezeAtPercentage time animation@ creates an animation consisting of+-- stationary frame, that would be displayed in the provided @animation@ at+-- given @time@. The duration of the new animation is the same as the duration+-- of provided @animation@.+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+ -> Animation -- ^ original animation, from which the frame+ -- will be taken+ -> Animation -- ^ new animation consisting of static frame+ -- displayed for the duration of the original+ -- animation freezeAtPercentage frac (Animation d genFrame) = Animation d $ const $ genFrame frac @@ -337,31 +365,35 @@ signalA :: Signal -> Animation -> Animation signalA fn (Animation d gen) = Animation d $ gen . fn --- | @takeA duration animation@ creates a new animation consisting of initial segment of--- @animation@ of given @duration@, played at the same rate as the original animation.+-- | @takeA duration animation@ creates a new animation consisting of initial+-- segment of @animation@ of given @duration@, played at the same rate as the+-- original animation. If the duration is not positive throws 'Prelude.error'. ----- The @duration@ parameter is clamped to be between 0 and @animation@'s duration.--- New animation duration is equal to (eventually clamped) @duration@.+-- The @duration@ parameter is clamped to be up to the @animation@'s duration.+-- New animation duration is equal to (eventually clamped) @duration@. takeA :: Duration -> Animation -> Animation-takeA len (Animation d gen) = Animation len' $ \t ->- gen (t * len'/d)- where- len' = clamp 0 d len+takeA len a@(Animation d gen)+ | len >= d = a+ | otherwise = mkAnimation len $ \t -> gen (t * len/d) --- | @dropA duration animation@ creates a new animation by dropping initial segment--- of length @duration@ from the provided @animation@, played at the same rate as the original animation.+-- | @dropA duration animation@ creates a new animation by dropping initial+-- segment of length @duration@ from the provided @animation@, played at the+-- same rate as the original animation. If the duration greater than or equal+-- to the @animation@'s duration throws 'Prelude.error'. ----- The @duration@ parameter is clamped to be between 0 and @animation@'s duration.--- The duration of the resulting animation is duration of provided @animation@ minus (eventually clamped) @duration@.+-- The @duration@ parameter is clamped to be non-negative. The duration of the+-- resulting animation is duration of provided @animation@ minus @duration@. dropA :: Duration -> Animation -> Animation-dropA len (Animation d gen) = Animation len' $ \t ->- gen (t * len'/d + len/d)+dropA len a@(Animation d gen)+ | len <= 0 = a+ | otherwise = mkAnimation rest $ \t -> gen (t * rest/d + len/d) where- len' = d - clamp 0 d len+ rest = d - len --- | @lastA duration animation@ return the last @duration@ seconds of the animation.+-- | @lastA duration animation@ return the last @duration@ seconds of the+-- animation. If the duration is not positive throws 'Prelude.error'. lastA :: Duration -> Animation -> Animation-lastA len a = dropA (duration a - len) a+lastA len a@(Animation d _) = dropA (d - len) a clamp :: Double -> Double -> Double -> Double clamp a b number
src/Reanimate/Cache.hs view
@@ -104,6 +104,6 @@ worker key sh | sh < 0 = [] | otherwise =- case (key `shiftR` sh) `mod` 64 of- idx -> alphabet !! fromIntegral idx : worker key (sh-6)- alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+$"+ case (key `shiftR` sh) `mod` 32 of+ idx -> alphabet !! fromIntegral idx : worker key (sh-5)+ alphabet = "ABCDEFGHJKLMNPQRSTUVWXYZ23456789"
src/Reanimate/Driver/Check.hs view
@@ -11,6 +11,7 @@ import Control.Monad (forM_) import Data.Maybe (fromMaybe, listToMaybe) import Data.Version (Version (Version), parseVersion, showVersion)+import POVRay (povrayApp) import Reanimate.Driver.Magick (magickCmd) import Reanimate.Misc (runCmd_) import System.Console.ANSI.Codes@@ -88,7 +89,7 @@ hasDvisvgm = hasProgram "dvisvgm" hasPovray :: IO (Either String String)-hasPovray = hasProgram "povray"+hasPovray = hasProgram povrayApp hasFFmpeg :: IO (Either String String) hasFFmpeg = checkMinVersion minVersion <$> ffmpegVersion@@ -120,7 +121,7 @@ hasInkscape :: IO (Either String String) hasInkscape = checkMinVersion minVersion <$> inkscapeVersion where- minVersion = Version [0,92] []+ minVersion = Version [1,0] [] hasMagick :: IO (Either String String) hasMagick = checkMinVersion minVersion <$> magickVersion
src/Reanimate/Math/Triangulate.hs view
@@ -46,7 +46,7 @@ import Data.Ext import Data.Geometry.PlanarSubdivision (PolygonFaceData) import Data.Geometry.Point-import Data.Geometry.Polygon+import Data.Geometry.Polygon (SimplePolygon, fromPoints) import qualified Data.IntSet as ISet import qualified Data.PlaneGraph as Geo import Data.Proxy
src/Reanimate/Misc.hs view
@@ -7,6 +7,7 @@ withTempFile, renameOrCopyFile, getReanimateCacheDirectory,+ fileUri ) where @@ -118,3 +119,12 @@ -- Incrementing this value invalidates all cached results. cacheVersion :: Int cacheVersion = 0++-- | A valid file URI is file://<hostname>/<path>. If <hostname> is absent, it+-- is file:///<path>. On Windows, absolute paths begin (for example) "C:\".+fileUri :: FilePath -> String+fileUri path = "file://" <> path'+ where+ path' = case path of+ '/' : _ -> path+ _ -> '/' : path
src/Reanimate/Povray.hs view
@@ -1,7 +1,25 @@ {-# LANGUAGE OverloadedStrings #-} {-|- [Povray](http://povray.org/) is a scriptable raytracer. All povray functions- are cached and will reuse images when scripts stay the same.+ [POV-Ray](http://povray.org/) (the Persistance of Vision Raytracer) is a+ scriptable raytracer. All POV-Ray functions are cached and will reuse images+ when scripts stay the same.++ The functions come in two versions, for example 'povray' and 'povray''. The+ versions without an apostrophe character yield a 'Tree'. The versions with a+ final apostrophe character yield a 'FilePath' of a PNG file containing the+ resulting image.++ The functions differ in their use of the POV-Ray @+W@ (width), @+H@ (height)+ and @+A@ or @-A@ (anti-aliasing) switches, as set out below. Resolutions are+ \'width x height\'.++ Example of use:++ > povray args script++ where @args@ is a list of other POV-Ray command-line switches (if any), and+ @script@ is a POV-Ray scene description specified in the POV-Ray /scene/+ /description language/. -} module Reanimate.Povray ( povray@@ -16,18 +34,20 @@ import Data.Hashable (Hashable (hash)) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.IO as T+import qualified Data.Text as T (concat, pack)+import qualified Data.Text.IO as T (writeFile) import Graphics.SvgTree (Tree)+import POVRay (runPOVRay) import Reanimate.Cache (cacheFile, encodeInt) import Reanimate.Constants (screenHeight, screenWidth)-import Reanimate.Misc (requireExecutable, runCmd) import Reanimate.Parameters (pNoExternals) import Reanimate.Raster (mkImage) import Reanimate.Svg.Constructors (mkText) import System.FilePath (replaceExtension, (<.>)) import System.IO.Unsafe (unsafePerformIO) ++ povrayRaw :: [String] -> Text -> Tree povrayRaw args script = unsafePerformIO $ mkPovrayImage args script@@ -36,53 +56,53 @@ povrayRaw' args script = unsafePerformIO $ mkPovrayImage' args script --- | Run the povray raytracer with a default resolution of 320x180+-- | Run the POV-Ray raytracer with a default resolution of 320x180 -- and antialiasing enabled. The resulting image is scaled to fit -- the screen exactly. povray :: [String] -> Text -> Tree-povray args = povrayRaw (["+H180","+W320", "+A"] ++ args)+povray args = povrayRaw (["+H180", "+W320", "+A"] ++ args) --- | Run the povray raytracer with a default resolution of 320x180+-- | Run the POV-Ray raytracer with a default resolution of 320x180 -- and antialiasing enabled. The FilePath points to a PNG file -- containing the resulting image. povray' :: [String] -> Text -> FilePath-povray' args = povrayRaw' (["+H180","+W320", "+A"] ++ args)+povray' args = povrayRaw' (["+H180", "+W320", "+A"] ++ args) --- | Run the povray raytracer with a default resolution of 320x180+-- | Run the POV-Ray raytracer with a default resolution of 320x180 -- but without antialiasing. The resulting image is scaled to fit -- the screen exactly. povrayQuick :: [String] -> Text -> Tree-povrayQuick args = povrayRaw (["+H180","+W320"] ++ args)+povrayQuick args = povrayRaw (["+H180", "+W320"] ++ args) --- | Run the povray raytracer with a default resolution of 320x180+-- | Run the POV-Ray raytracer with a default resolution of 320x180 -- but without antialiasing. The FilePath points to a PNG file -- containing the resulting image. povrayQuick' :: [String] -> Text -> FilePath-povrayQuick' args = povrayRaw' (["+H180","+W320"] ++ args)+povrayQuick' args = povrayRaw' (["+H180", "+W320"] ++ args) --- | Run the povray raytracer with a default resolution of 1440x2560--- and antialiasing enabled. The FilePath points to a PNG file--- containing the resulting image.+-- | Run the POV-Ray raytracer with a default resolution of 2560x1440+-- and antialiasing enabled. The resulting image is scaled to fit+-- the screen exactly. povraySlow :: [String] -> Text -> Tree-povraySlow args = povrayRaw (["+H1440","+W2560", "+A"] ++ args)+povraySlow args = povrayRaw (["+H1440", "+W2560", "+A"] ++ args) --- | Run the povray raytracer with a default resolution of 1440x2560+-- | Run the POV-Ray raytracer with a default resolution of 2560x1440 -- and antialiasing enabled. The FilePath points to a PNG file -- containing the resulting image. povraySlow' :: [String] -> Text -> FilePath-povraySlow' args = povrayRaw' (["+H1440","+W2560", "+A"] ++ args)+povraySlow' args = povrayRaw' (["+H1440", "+W2560", "+A"] ++ args) --- | Run the povray raytracer with a default resolution of 2160x3840--- and antialiasing enabled. The FilePath points to a PNG file--- containing the resulting image.+-- | Run the POV-Ray raytracer with a default resolution of 3840x2160+-- and antialiasing enabled. The resulting image is scaled to fit+-- the screen exactly. povrayExtreme :: [String] -> Text -> Tree-povrayExtreme args = povrayRaw (["+H2160","+W3840", "+A"] ++ args)+povrayExtreme args = povrayRaw (["+H2160", "+W3840", "+A"] ++ args) --- | Run the povray raytracer with a default resolution of 2160x3840+-- | Run the POV-Ray raytracer with a default resolution of 3840x2160 -- and antialiasing enabled. The FilePath points to a PNG file -- containing the resulting image. povrayExtreme' :: [String] -> Text -> FilePath-povrayExtreme' args = povrayRaw' (["+H2160","+W3840", "+A"] ++ args)+povrayExtreme' args = povrayRaw' (["+H2160", "+W3840", "+A"] ++ args) mkPovrayImage :: [String] -> Text -> IO Tree mkPovrayImage _ script | pNoExternals = pure $ mkText script@@ -92,10 +112,10 @@ mkPovrayImage' :: [String] -> Text -> IO FilePath mkPovrayImage' _ _ | pNoExternals = pure "/povray/has/been/disabled" mkPovrayImage' args script = cacheFile template $ \target -> do- exec <- requireExecutable "povray"- let pov_file = replaceExtension target "pov"- T.writeFile pov_file script- runCmd exec (args ++ ["-D","+UA", pov_file, "+o"++target])- where- template = encodeInt (hash key) <.> "png"- key = T.concat (script:map T.pack args)+ let pov_file = replaceExtension target "pov"+ otherArgs = ["-D", "+UA", "+I" ++ pov_file, "+O" ++ target]+ T.writeFile pov_file script+ runPOVRay $ args ++ otherArgs+ where+ template = encodeInt (hash key) <.> "png"+ key = T.concat (script:map T.pack args)
src/Reanimate/Raster.hs view
@@ -43,8 +43,9 @@ import Reanimate.Cache (cacheFile, encodeInt) import Reanimate.Constants (screenHeight, screenWidth) import Reanimate.Driver.Magick (magickCmd)-import Reanimate.Misc (getReanimateCacheDirectory, renameOrCopyFile,- requireExecutable, runCmd)+import Reanimate.Misc (fileUri, getReanimateCacheDirectory,+ renameOrCopyFile, requireExecutable,+ runCmd) import Reanimate.Parameters (Height, Raster (RasterNone), Width, pHeight, pNoExternals, pRaster, pRootDirectory, pWidth) import Reanimate.Render (applyRaster, requireRaster)@@ -122,7 +123,7 @@ & Svg.imageHeight .~ Svg.Num height & Svg.imageHref- .~ ("file://" ++ target)+ .~ (fileUri target) & Svg.imageCornerUpperLeft .~ (Svg.Num (-width / 2), Svg.Num (-height / 2)) & Svg.imageAspectRatio
src/Reanimate/Render.hs view
@@ -413,9 +413,8 @@ applyRaster RasterAuto _ = return () applyRaster RasterInkscape path = runCmd "inkscape"- [ "--without-gui"- , "--file=" ++ path- , "--export-png=" ++ replaceExtension path "png"+ ["--export-type=png"+ , path ] applyRaster RasterRSvg path = runCmd "rsvg-convert"
src/Reanimate/Scene.hs view
@@ -20,6 +20,7 @@ waitOn, -- :: Scene s a -> Scene s a adjustZ, -- :: (ZIndex -> ZIndex) -> Scene s a -> Scene s a withSceneDuration, -- :: Scene s () -> Scene s Duration+ signalS, -- Signal -> Scene s a -> Scene s a -- * Variables Var,@@ -56,6 +57,7 @@ -- * Object API Object, ObjectData,+ signalO, oNew, newObject, oModify,
src/Reanimate/Scene/Core.hs view
@@ -73,6 +73,24 @@ ) ) +-- -- | Apply easing function to all render elements created by the scene+-- -- in the timespan from now to the scene duration.+-- --+-- -- Note that this does not affect time as seen by `queryNow` or any+-- -- time-dependent variables or object properties.+-- signalS :: Signal -> Scene s a -> Scene s a+-- signalS signal (M action) = M $ \now -> do+-- (a, s, p, gens) <- action now+-- let action_dur = max s p+-- modify_t t+-- | t < now = t+-- | t > now+action_dur = t+-- | otherwise = now + signal ((t-now) / action_dur) * action_dur+-- let applyS gen = do+-- fn <- gen+-- return $ \dur t -> fn dur (modify_t t)+-- return (a, s, p, map applyS gens)+ -- | Execute actions in a scene without advancing the clock. Note that scenes do not end before -- all forked actions have completed. --
src/Reanimate/Scene/Object.hs view
@@ -18,7 +18,7 @@ import Reanimate.Svg import Reanimate.Scene.Core (Scene, fork, scene, wait)-import Reanimate.Scene.Sprite (Sprite, newSprite, newSpriteA', play, spriteModify, unVar)+import Reanimate.Scene.Sprite (Sprite, newSprite, newSpriteA', play, spriteModify, unVar, signalS) import Reanimate.Scene.Var (Var, modifyVar, newVar, readVar, tweenVar) -------------------------------------------------------@@ -244,6 +244,10 @@ ------------------------------------------------------------------------------- -- Object modifiers++-- | Apply easing function before rendering object.+signalO :: Object s a -> Duration -> Signal -> Scene s ()+signalO obj dur signal = signalS (objectSprite obj) dur signal -- | Modify object properties. oModify :: Object s a -> (ObjectData a -> ObjectData a) -> Scene s ()
src/Reanimate/Scene/Sprite.hs view
@@ -16,6 +16,7 @@ wait) import Reanimate.Scene.Var (Var (..), newVar, readVar, unpackVar) import Reanimate.Transition (Transition, overlapT)+import Reanimate.Ease (Signal) -- | Create and render a variable. The rendering will be born at the current timestamp -- and will persist until the end of the scene.@@ -57,7 +58,7 @@ -- | Sprites are animations with a given time of birth as well as a time of death. -- They can be controlled using variables, tweening, and effects.-data Sprite s = Sprite Time (STRef s (Duration, ST s (Duration -> Time -> SVG -> (SVG, ZIndex))))+data Sprite s = Sprite Time (STRef s (Time -> Time)) (STRef s (Duration, ST s (Duration -> Time -> SVG -> (SVG, ZIndex)))) -- | Sprite frame generator. Generates frames over time in a stateful environment. newtype Frame s a = Frame {unFrame :: ST s (Time -> Duration -> Time -> a)}@@ -113,13 +114,16 @@ newSprite :: Frame s SVG -> Scene s (Sprite s) newSprite render = do now <- queryNow+ tmod <- liftST $ newSTRef id ref <- liftST $ newSTRef (-1, return $ \_d _t svg -> (svg, 0)) addGen $ do fn <- unFrame render+ time_fn <- readSTRef tmod (spriteDur, spriteEffectGen) <- readSTRef ref spriteEffect <- spriteEffectGen- return $ \d absT ->- let relD = (if spriteDur < 0 then d else spriteDur) - now+ return $ \d absT_ ->+ let absT = time_fn absT_+ relD = (if spriteDur < 0 then d else spriteDur) - now relT = absT - now -- Sprite is live [now;duration[ -- If we're at the end of a scene, sprites@@ -131,7 +135,7 @@ in if inTimeSlice || isLastFrame then spriteEffect relD relT (fn absT relD relT) else (None, 0)- return $ Sprite now ref+ return $ Sprite now tmod ref -- | Create new sprite defined by a frame generator. The sprite will die at -- the end of the scene.@@ -224,7 +228,7 @@ -- -- <<docs/gifs/doc_destroySprite.gif>> destroySprite :: Sprite s -> Scene s ()-destroySprite (Sprite _ ref) = do+destroySprite (Sprite _ _tmod ref) = do now <- queryNow liftST $ modifySTRef ref $ \(ttl, render) ->@@ -232,7 +236,7 @@ -- | Low-level frame modifier. spriteModify :: Sprite s -> Frame s ((SVG, ZIndex) -> (SVG, ZIndex)) -> Scene s ()-spriteModify (Sprite born ref) modFn = liftST $+spriteModify (Sprite born _tmod ref) modFn = liftST $ modifySTRef ref $ \(ttl, renderGen) -> ( ttl, do@@ -242,6 +246,19 @@ let absT = relT + born in modRender absT relD relT . render relD relT ) +-- | Apply easing function before rendering sprite.+signalS :: Sprite s -> Duration -> Signal -> Scene s ()+signalS (Sprite _born tmod _ref) dur signal = do+ now <- queryNow+ let modify_t t+ | t < now = t+ | t > now+dur = t+ | otherwise = now + signal ((t-now) / dur) * dur+ liftST $+ modifySTRef tmod $ \fn -> modify_t . fn+ ++ -- | Map the SVG output of a sprite. -- -- Example:@@ -254,7 +271,7 @@ -- -- <<docs/gifs/doc_spriteMap.gif>> spriteMap :: Sprite s -> (SVG -> SVG) -> Scene s ()-spriteMap sprite@(Sprite born _) fn = do+spriteMap sprite@(Sprite born _ _) fn = do now <- queryNow let tDelta = now - born spriteModify sprite $ do@@ -272,7 +289,7 @@ -- -- <<docs/gifs/doc_spriteTween.gif>> spriteTween :: Sprite s -> Duration -> (Double -> SVG -> SVG) -> Scene s ()-spriteTween sprite@(Sprite born _) dur fn = do+spriteTween sprite@(Sprite born _ _) dur fn = do now <- queryNow let tDelta = now - born spriteModify sprite $ do@@ -314,7 +331,7 @@ -- -- <<docs/gifs/doc_spriteE.gif>> spriteE :: Sprite s -> Effect -> Scene s ()-spriteE (Sprite born ref) effect = do+spriteE (Sprite born _tmod ref) effect = do now <- queryNow liftST $ modifySTRef ref $ \(ttl, renderGen) ->@@ -340,7 +357,7 @@ -- -- <<docs/gifs/doc_spriteZ.gif>> spriteZ :: Sprite s -> ZIndex -> Scene s ()-spriteZ (Sprite born ref) zindex = do+spriteZ (Sprite born _tmod ref) zindex = do now <- queryNow liftST $ modifySTRef ref $ \(ttl, renderGen) ->
src/Reanimate/Svg/BoundingBox.hs view
@@ -29,7 +29,9 @@ -- -- Note: Bounding boxes are computed on a best-effort basis and will not work -- in all cases. The only supported SVG nodes are: path, circle, polyline,--- ellipse, line, rectangle, image. All other nodes return (0,0,0,0).+-- ellipse, line, rectangle, image and svg. All other nodes return (0,0,0,0).+-- The box for the svg node is based on the document's width and height+-- (if both are present). boundingBox :: Tree -> (Double, Double, Double, Double) boundingBox t = case svgBoundingPoints t of@@ -76,36 +78,36 @@ svgBoundingPoints :: Tree -> [RPoint] svgBoundingPoints t = map (Transform.transformPoint m) $ case t of- None -> []- UseTree{} -> []- GroupTree g -> concatMap svgBoundingPoints (g^.groupChildren)- SymbolTree g -> concatMap svgBoundingPoints (g^.groupChildren)- FilterTree{} -> []+ None -> []+ UseTree{} -> []+ GroupTree g -> concatMap svgBoundingPoints (g ^. groupChildren)+ SymbolTree g -> concatMap svgBoundingPoints (g ^. groupChildren)+ FilterTree{} -> [] DefinitionTree{} -> []- PathTree p -> linePoints $ toLineCommands (p^.pathDefinition)- CircleTree c -> circleBoundingPoints c- PolyLineTree pl -> pl ^. polyLinePoints- EllipseTree e -> ellipseBoundingPoints e- LineTree line -> map pointToRPoint [line^.linePoint1, line^.linePoint2]- RectangleTree rect ->- case pointToRPoint (rect^.rectUpperLeftCorner) of- V2 x y -> V2 x y :- case mapTuple (fmap $ toUserUnit defaultDPI) (rect^.rectWidth, rect^.rectHeight) of- (Just (Num w), Just (Num h)) -> [V2 (x+w) (y+h)]- _ -> []- TextTree{} -> []- ImageTree img ->- case (img^.imageCornerUpperLeft, img^.imageWidth, img^.imageHeight) of- ((Num x, Num y), Num w, Num h) ->- [V2 x y, V2 (x+w) (y+h)]- _ -> []+ PathTree p -> linePoints $ toLineCommands (p ^. pathDefinition)+ CircleTree c -> circleBoundingPoints c+ PolyLineTree pl -> pl ^. polyLinePoints+ EllipseTree e -> ellipseBoundingPoints e+ LineTree l -> map pointToRPoint [l ^. linePoint1, l ^. linePoint2]+ RectangleTree r ->+ let p = pointToRPoint (r ^. rectUpperLeftCorner)+ mDims = (r ^. rectWidth, r ^. rectHeight)+ in rectPoints p mDims+ TextTree{} -> []+ ImageTree img ->+ let p = pointToRPoint (img ^. imageCornerUpperLeft)+ dims = (img ^. imageWidth, img ^. imageHeight)+ in rectPoints' p dims MeshGradientTree{} -> []- _ -> []+ SvgTree d -> let mDims = (d ^. documentWidth, d ^. documentHeight)+ in rectPoints (V2 0 0) mDims+ _ -> [] where- m = Transform.mkMatrix (t^.transform)+ m = Transform.mkMatrix (t ^. transform) mapTuple f = f *** f+ toUserUnit' = toUserUnit defaultDPI pointToRPoint p =- case mapTuple (toUserUnit defaultDPI) p of+ case mapTuple toUserUnit' p of (Num x, Num y) -> V2 x y _ -> error "Reanimate.Svg.svgBoundingPoints: Unrecognized number format." @@ -113,7 +115,7 @@ let (xnum, ynum) = circ ^. circleCenter rnum = circ ^. circleRadius in case mapMaybe unpackNumber [xnum, ynum, rnum] of- [x, y, r] -> [ V2 (x + r * cos angle) (y + r * sin angle) | angle <- [0, pi/10 .. 2 * pi]]+ [x, y, r] -> ellipsePoints x y r r _ -> [] ellipseBoundingPoints e =@@ -121,10 +123,23 @@ xrnum = e ^. ellipseXRadius yrnum = e ^. ellipseYRadius in case mapMaybe unpackNumber [xnum, ynum, xrnum, yrnum] of- [x,y,xr,yr] -> [V2 (x + xr * cos angle) (y + yr * sin angle) | angle <- [0, pi/10 .. 2 * pi]]- _ -> []+ [x, y, xr, yr] -> ellipsePoints x y xr yr+ _ -> [] + ellipsePoints x y xr yr = [ V2 (x + xr * cos angle) (y + yr * sin angle)+ | angle <- [0, pi/10 .. 2 * pi] ]++ rectPoints p mDims = case mDims of+ (Just w, Just h) -> rectPoints' p (w, h)+ _ -> [p]++ rectPoints' p@(V2 x y) dims =+ p : case mapTuple toUserUnit' dims of+ ((Num w), (Num h)) -> let (x', y') = (x + w, y + h)+ in [V2 x' y, V2 x' y', V2 x y']+ _ -> []+ unpackNumber n =- case toUserUnit defaultDPI n of+ case toUserUnit' n of Num d -> Just d _ -> Nothing
src/Reanimate/Svg/Constructors.hs view
@@ -20,6 +20,7 @@ , withId , withStrokeColor , withStrokeColorPixel+ , withStrokeOpacity , withStrokeDashArray , withStrokeLineJoin , withFillColor@@ -192,10 +193,12 @@ where (x, y, w, h) = boundingBox a --- | Create 'Texture' based on SVG color name.--- See <https://en.wikipedia.org/wiki/Web_colors#X11_color_names> for the list of available names.--- If the provided name doesn't correspond to valid SVG color name, white-ish color is used.+-- | Create 'Texture' based on a SVG color name or @\"none\"@. If the provided+-- 'String' is not a valid value, a white-ish color is used.+-- See <https://en.wikipedia.org/wiki/Web_colors#X11_color_names> for the list+-- of available color names. mkColor :: String -> Texture+mkColor "none" = FillNone mkColor name = case Map.lookup (T.pack name) svgNamedColors of Nothing -> ColorRef (PixelRGBA8 240 248 255 255)@@ -209,6 +212,10 @@ withStrokeColorPixel :: PixelRGBA8 -> Tree -> Tree withStrokeColorPixel color = strokeColor .~ pure (ColorRef color) +-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-opacity>+withStrokeOpacity :: Double -> Tree -> Tree+withStrokeOpacity opacity = strokeOpacity ?~ realToFrac opacity+ -- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/stroke-dasharray> withStrokeDashArray :: [Double] -> Tree -> Tree withStrokeDashArray arr = strokeDashArray .~ pure (map Num arr)@@ -217,7 +224,10 @@ withStrokeLineJoin :: LineJoin -> Tree -> Tree withStrokeLineJoin ljoin = strokeLineJoin .~ pure ljoin --- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>+-- | See <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/fill>.+--+-- @withFillColor color@ takes the same approach to @color@ as 'mkColor'. For+-- RGB color values, use 'withFillColorPixel'. withFillColor :: String -> Tree -> Tree withFillColor color = fillColor .~ pure (mkColor color)
+ unix/POVRay.hs view
@@ -0,0 +1,16 @@+module POVRay+ ( povrayApp+ , runPOVRay+ ) where++import Reanimate.Misc (requireExecutable, runCmd)++-- | Name of the POV-Ray executable+povrayApp :: String+povrayApp = "povray"++-- | Run the POV-Ray executable with arguments+runPOVRay :: [String] -> IO ()+runPOVRay args = do+ exec <- requireExecutable povrayApp+ runCmd exec args
+ windows/POVRay.hs view
@@ -0,0 +1,50 @@+module POVRay+ ( povrayApp+ , runPOVRay+ ) where++import Reanimate.Misc (requireExecutable, runCmd)+import System.IO (hClose, hPutStrLn)+import System.IO.Temp (withSystemTempFile)++-- | Name of the POV-Ray executable+povrayApp :: String+povrayApp = "pvengine64" -- Assumes 64 bit Windows++-- | Run the POV-Ray executable with arguments+runPOVRay :: [String] -> IO ()+runPOVRay args = do+ exec <- requireExecutable povrayApp+ let exec' = '"' : exec ++ "\"" -- Wrap exec in "" because the path is likely+ -- to includes spaces+ args' = "/EXIT" : args -- Note [/EXIT special command-line option]+ command = concatMap (' ':) (exec' : args')+ -- Note [Use of a batch file]+ withSystemTempFile "pvcommand.bat" $ \path h -> do+ hPutStrLn h command+ hClose h+ runCmd path []++{-+Note [/EXIT special command-line option]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++"The /EXIT command tells POV-Ray to perform the render given by the other+command-line options, combined with previously-set options such as internal+command-line settings, INI file, source file, and so forth, and then to exit. By+default, if this switch is not present, POV-Ray for Windows will remain running+after the render is complete. This switch only applies to renders started by+other options on the command-line. It will not affect renders started manually+from within POV-Ray for Windows itself."+source: https://www.povray.org/documentation/view/3.6.1/603/++Note [Use of batch file]+~~~~~~~~~~~~~~~~~~~~~~~~++POV-Ray for Windows assumes that anything on the command-line that is not a+switch is the name of an INI file. Switches are preceded by a plus or minus.+However, System.Process.createProcess_ wraps all arguments in "". POV_Ray for+Windows appears to interpret a switch wrapped in "" as the name of an INI file.++The work around used here is to write the POV-Ray command line to a batch file.+-}