reanimate 0.2.0.2 → 0.3.0.0

raw patch · 23 files changed

+775/−247 lines, 23 filesdep ~vectorbinary-addedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: vector

API changes (from Hackage documentation)

Files

• ChangeLog.md +28/−0
• docs/gifs/doc_cubicBezierS.gif binary
• examples/demo_tangent.hs +110/−0
• examples/doc_cubicBezierS.golden +50/−0
• examples/doc_cubicBezierS.hs +9/−0
• examples/image.hs +0/−22
• examples/tut_glue_fourier.hs +3/−4
• examples/tut_glue_latex.hs +1/−1
• examples/tut_glue_potrace.hs +3/−6
• examples/tut_glue_povray.hs +10/−11
• reanimate.cabal +2/−2
• src/Reanimate.hs +23/−12
• src/Reanimate/Builtin/Documentation.hs +3/−0
• src/Reanimate/Cache.hs +5/−4
• src/Reanimate/Driver.hs +6/−3
• src/Reanimate/GeoProjection.hs +374/−147
• src/Reanimate/Memo.hs +4/−0
• src/Reanimate/Misc.hs +17/−5
• src/Reanimate/Parameters.hs +42/−2
• src/Reanimate/Raster.hs +24/−2
• src/Reanimate/Render.hs +45/−25
• src/Reanimate/Signal.hs +14/−0
• src/Reanimate/Svg/BoundingBox.hs +2/−1

@@ -1,5 +1,33 @@ # Revision history for reanimate +## 0.3.0.0 -- 2020-05-11++* Improve README.md with better examples at a higher framerate.+* Improve canvas documentation, courtesy of William Yao.+* Fix 'renameFile' bug when moving files between different file-systems.+* Improve GeoJSON performance.+* Improve SVG rendering performance.+* CLI: Show time spent and time remaining when rendering.+* Better support for external images.+* Support external raster engines (inkscape, image magick, rsvg).+* Fix framerate bug affecting GIFs.+* Improve boundingbox performance.+* Add generalized cubic bezier signal.++## 0.2.0.2 -- 2020-02-25++* Rewrite viewer from javascript to elm.+* Improve API documentation.+* Support for GeoJSON files (rendering borders, etc).+* Fix bug affecting GIF frame rates.+* Improve SVG serialization performance.+* Add support for transitions (ie. functions that merge animations).+* Properly handle ctrl-c when rendering.+* Improve accuracy of bounding-box approximation.+* Rewrite the API for building animations sequentially.+* Expand 'pathify' to work on a larger subset of SVG.+* Respect aspect ratio when 'height' or 'width' is specified but not both.+ ## 0.1.6.0 -- 2019-09-14  * Test suite.

binary file changed (absent → 11940 bytes)

@@ -0,0 +1,110 @@+#!/usr/bin/env stack+-- stack runghc --package reanimate+{-# LANGUAGE OverloadedStrings #-}+module Main(main) where++import           Control.Lens                    ((^.))+import           Control.Monad.State+import qualified Data.Vector.Unboxed             as V+import           Geom2D.CubicBezier              (AnyBezier (..), Point (..),+                                                  evalBezierDeriv)+import           Graphics.SvgTree                (Coord, Tree (..), mapTree,+                                                  pathDefinition)+import           Linear.Metric+import           Linear.V2                       (V2 (..))+import           Linear.Vector+import           Reanimate+import           Reanimate.Builtin.Documentation++main :: IO ()+main = reanimate $ docEnv $ mkAnimation 30 $ \t ->+  let piSvg = pathify $ lowerTransformations $ center $ scale 10 $ latex "s" in+  mkGroup+  [ mkBackgroundPixel rtfdBackgroundColor+  , piSvg+  , drawTangent t piSvg ]++drawTangent :: Double -> SVG -> SVG+drawTangent alpha | alpha >= 1 = id+drawTangent alpha = mapTree worker+  where+    worker (PathTree path) =+      let (V2 posX posY, tangent) =+            atPartial alpha $ toLineCommands $ path^.pathDefinition+          normed@(V2 tangentX tangentY) = normalize tangent ^* 4+          V2 midX midY = lerp 0.5 0 normed+          V2 normVectX normVectY = normalize tangent ^* (svgWidth normalTxt*1.1)+          tangentSvg =+            translate (posX) (posY) $+            rotate (unangle normed/pi*180 + 180) $+            translate 0 (svgHeight tangentTxt/2) $+            tangentTxt+          normalSvg =+            translate (posX) (posY) $+            rotate (unangle normed/pi*180 + 90) $+            translate (svgWidth normalTxt/2*1.1) (svgHeight normalTxt/2*1.3) $+            normalTxt+      in mkGroup+      [ withStrokeWidth (defaultStrokeWidth) $+        withStrokeColor "black" $+        translate (posX-midX) (posY-midY) $+        mkLine (0, 0) (tangentX, tangentY)+      , withStrokeWidth (defaultStrokeWidth) $+        withStrokeColor "black" $+        translate (posX) (posY) $+        mkLine (0, 0) (-normVectY, normVectX)+      , withStrokeWidth (defaultStrokeWidth*2) $+        withStrokeColor "white" $+        tangentSvg+      , withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0 $+        tangentSvg+      , withStrokeWidth (defaultStrokeWidth*2) $+        withStrokeColor "white" $+        normalSvg+      , withFillOpacity 1 $ withFillColor "black" $ withStrokeWidth 0 $+        normalSvg+      ]+    worker t = t+    tangentTxt = scale 1.1 $ center $ latex "tangent"+    normalTxt = scale 1.1 $ center $ latex "normal"++atPartial :: Double -> [LineCommand] -> (V2 Double, V2 Double)+atPartial alpha cmds = evalState (worker 0 cmds) zero+  where+    worker _d [] = pure (0, 0)+    worker d (cmd:xs) = do+      from <- get+      len <- lineLength cmd+      let frac = (targetLen-d) / len+      if len == 0 || frac >= 1+        then worker (d+len) xs+        else do+          let bezier = lineCommandToBezier from cmd+              (pos, tangent) = evalBezierDeriv bezier frac+          pure $ (fromPoint pos, fromPoint tangent)+    totalLen = evalState (sum <$> mapM lineLength cmds) zero+    targetLen = totalLen * alpha++lineCommandToBezier :: V2 Coord -> LineCommand -> AnyBezier Coord+lineCommandToBezier from line =+  case line of+    LineBezier [a] ->+      AnyBezier $ V.fromList [toTuple from, toTuple a]+    LineBezier [a,b] ->+      AnyBezier $ V.fromList [toTuple from, toTuple a, toTuple b]+    LineBezier [a,b,c] ->+      AnyBezier $ V.fromList [toTuple from, toTuple a, toTuple b, toTuple c]+    _ -> error (show line)++fromPoint :: Point a -> V2 a+fromPoint (Point x y) = V2 x y++toTuple :: V2 a -> (a,a)+toTuple (V2 x y) = (x, y)++unangle :: (Floating a, Ord a) => V2 a -> a+unangle a@(V2 ax ay) =+  let alpha = asin $ ay / norm a+  in if ax < 0+       then pi - alpha+       else alpha

@@ -0,0 +1,50 @@+0<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-6.4, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+1<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-5.78418, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+2<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-5.190295, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+3<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-4.617885, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+4<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-4.066496, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+5<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-3.53567, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+6<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-3.024949, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+7<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-2.533878, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+8<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-2.061998, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+9<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-1.608853, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+10<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-1.173987, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+11<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-0.756942, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+12<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(-0.357261, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+13<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(0.025513, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+14<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(0.391837, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+15<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(0.742167, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+16<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(1.076961, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+17<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(1.396675, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+18<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(1.701767, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+19<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(1.992694, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+20<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(2.269911, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+21<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(2.533878, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+22<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(2.785049, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+23<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(3.023883, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+24<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(3.250836, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+25<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(3.466365, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+26<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(3.670928, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+27<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(3.86498, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+28<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(4.04898, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+29<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(4.223383, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+30<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(4.388648, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+31<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(4.54523, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+32<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(4.693587, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+33<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(4.834176, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+34<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(4.967454, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+35<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(5.093878, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+36<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(5.213904, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+37<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(5.32799, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+38<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(5.436592, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+39<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(5.540168, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+40<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(5.639174, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+41<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(5.734068, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+42<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(5.825306, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+43<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(5.913346, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+44<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(5.998643, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+45<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(6.081656, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+46<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(6.162842, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+47<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(6.242656, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+48<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(6.321556, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>+49<svg viewBox="-8 -4.5 16 9" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" version="1.1" preserveAspectRatio="none"><g stroke-width="0.05" transform="scale(1, -1)"><g><g stroke-width="0" fill="#FFFFFF" transform="translate(-8, -4.5)" fill-opacity="1"><rect width="16" height="9" /></g><g stroke-width="0.1" stroke="#000000" fill-opacity="0"><g><line x1="-6.4" x2="6.4" /><g transform="translate(6.4, 0)"><circle fill-opacity="1" r="0.5" /></g></g></g></g></g></svg>

@@ -0,0 +1,9 @@+#!/usr/bin/env stack+-- stack runghc --package reanimate+module Main(main) where++import Reanimate+import Reanimate.Builtin.Documentation++main :: IO ()+main = reanimate $ docEnv $ signalA (cubicBezierS (0.0, 0.8, 0.9, 1.0)) drawProgress

@@ -1,22 +0,0 @@-#!/usr/bin/env stack--- stack runghc --package reanimate-module Main (main) where--import           Reanimate-import qualified Graphics.SvgTree            as Svg-import           Control.Lens                ((&), (.~))-import           Graphics.SvgTree--main :: IO ()-main = reanimate $ animate $ const $-    ImageTree $ defaultSvg-          & Svg.imageCornerUpperLeft .~ (Svg.Num (-w/2), Svg.Num (-h/2))-          & Svg.imageWidth .~ Svg.Num w-          & Svg.imageHeight .~ Svg.Num h-          & Svg.imageHref .~ ("file://"++src)---  where-    w = screenWidth-    h = screenHeight-    src = "/home/lemmih/Coding/Haskell/reanimate/examples/haskell.svg"

@@ -12,8 +12,9 @@  -- layer 3 main :: IO ()-main = reanimate $ parA bg $ sceneAnimation $ do-    play $ fourierA (fromToS 0 15)      -- Rotate 15 times+main = reanimate $ setDuration 30 $ sceneAnimation $ do+    _ <- newSpriteSVG $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)+    play $ fourierA (fromToS 0 5)      -- Rotate 15 times       # setDuration 50       # signalA (reverseS . powerS 2 . reverseS) -- Start fast, end slow       # pauseAtEnd 2@@ -22,8 +23,6 @@       # reverseA       # signalA (powerS 2)                       -- Start slow, end fast       # pauseAtEnd 2-  where-    bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)  -- layer 2 fourierA :: (Double -> Double) -> Animation

@@ -25,7 +25,7 @@     -- Draw equation     play $ drawAnimation strokedSvg     sprites <- forM glyphs $ \(fn, _, elt) ->-      newSpriteA $ animate $ const $ fn elt+      newSpriteSVG $ fn elt     -- Yoink each glyph     forM_ (reverse sprites) $ \sprite -> do       spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)

@@ -18,13 +18,10 @@     xRot <- newVar (-45)     yRot <- newVar 220     wf <- newSprite $ wireframe <$> unVar xRot <*> unVar yRot-    tweenVar yRot spinDur (\t v -> fromToS v (v+60*3) $ curveS 2 (t/spinDur))+    fork $ tweenVar yRot spinDur $ \v -> fromToS v (v+60*3) . curveS 2     replicateM_ wobbles $ do-      tweenVar xRot (wobbleDur/2) (\t v -> fromToS v (v+90) $ curveS 2 (t/(wobbleDur/2)))-      fork $ do-        wait (wobbleDur/2)-        tweenVar xRot (wobbleDur/2) (\t v -> fromToS v (v-90) $ curveS 2 (t/(wobbleDur/2)))-      wait wobbleDur+      tweenVar xRot (wobbleDur/2) $ \v -> fromToS v (v+90) . curveS 2+      tweenVar xRot (wobbleDur/2) $ \v -> fromToS v (v-90) . curveS 2     destroySprite wf     play $ mkAnimation drawDuration (\t -> partialSvg t (wireframe (-45) 220))       # reverseA

@@ -6,7 +6,8 @@ module Main (main) where  import           Reanimate-import           Reanimate.Povray      (povraySlow)+import           Reanimate.Povray      (povraySlow')+import           Reanimate.Raster  import           Codec.Picture import           Codec.Picture.Types@@ -21,7 +22,8 @@   main :: IO ()-main = reanimate $ parA bg $ sceneAnimation $ do+main = reanimate $ sceneAnimation $ do+    newSpriteSVG $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF     zPos <- newVar 0     xRot <- newVar 0     zRot <- newVar 0@@ -32,17 +34,14 @@       t <- spriteT       dur <- spriteDuration       pure $-        povraySlow [] $+        mkImage screenWidth screenHeight $ povraySlow' [] $         script (svgAsPngFile (texture (t/dur))) transZ getX getZ     wait 2-    tweenVar zPos 9 (\t v -> fromToS v 8 (t/9))-    tweenVar xRot 9 (\t v -> fromToS v 360 $ curveS 2 (t/9))-    tweenVar zRot 9 (\t v -> fromToS v 360 $ curveS 2 (t/9))+    fork $ tweenVar zPos 9 $ \v -> fromToS v 8+    fork $ tweenVar xRot 9 $ \v -> fromToS v 360 . curveS 2+    fork $ tweenVar zRot 9 $ \v -> fromToS v 360 . curveS 2     wait 10-    tweenVar zPos 2 (\t v -> fromToS v 0 $ curveS 3 (t/2))-    wait 2-  where-    bg = animate $ const $ mkBackgroundPixel $ PixelRGBA8 252 252 252 0xFF+    tweenVar zPos 2 $ \v -> fromToS v 0 . curveS 3  texture :: Double -> SVG texture t = frameAt (t*duration latexExample) latexExample@@ -92,7 +91,7 @@     -- Draw equation     play $ drawAnimation strokedSvg     sprites <- forM glyphs $ \(fn, _, elt) ->-      newSpriteA $ animate $ const $ fn elt+      newSpriteSVG $ fn elt     -- Yoink each glyph     forM_ (reverse sprites) $ \sprite -> do       spriteE sprite (overBeginning 1 $ aroundCenterE $ highlightE)

@@ -3,7 +3,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                reanimate-version:             0.2.0.2+version:             0.3.0.0 -- synopsis: -- description: license:             PublicDomain@@ -91,7 +91,7 @@                        JuicyPixels, attoparsec, parallel,                        cubicbezier, websockets,                        hashable, fsnotify, open-browser, random-shuffle, base64-bytestring,-                       vector, colour, cassava, ansi-wl-pprint, here, temporary,+                       vector >= 0.12.0.0, colour, cassava, ansi-wl-pprint, here, temporary,                        optparse-applicative, chiphunk >= 0.1.2.1,                        geojson, aeson >= 1.3.0.0   ghc-options: -Wall

@@ -11,20 +11,30 @@ between external components such as 'latex', 'ffmpeg', 'gnuplot', 'diagrams', and 'povray'. += Canvas++Reanimate uses its own internal, Cartesian coordinate system for animations,+with a fixed canvas size of 16x9, where X and Y are real numbers. (0, 0) is+located in the center of the canvas, with positive X going to the right, and+positive Y going up. This means that e.g. (8, 4.5) is the top right corner+and (-8, -4.5) is the bottom left corner. Note that this canvas size does not+affect how large or small output resolution will be, although it /does/ affect+aspect ratio.++= Driver++Reanimate features a web-based viewer which is opened by default if+no other parameters are given. Key features:++  * This viewer listens for changes to the source file and recompiles the+    code automatically as needed.+  * Animations are rendered with increasing fidelity until the frame+    rate reaches 60 fps.+  * Key commands for pausing, frame stepping, forward/rewind.+    To pause press SPACE, to move -1\/+1\/-10\/+10 frames use LEFT\/RIGHT\/DOWN\/UP arrow keys. -} module Reanimate-  ( -- * Driver-    ---    -- | Reanimate features a web-based viewer which is opened by default if-    --   no other parameters are given. Key features:-    ---    --   * This viewer listens for changes to the source file and recompiles the-    --     code automatically as needed.-    --   * Animations are rendered with increasing fidelity until the frame-    --     rate reaches 60 fps.-    --   * Key commands for pausing, frame stepping, forward/rewind.-    --     To pause press SPACE, to move -1\/+1\/-10\/+10 frames use LEFT\/RIGHT\/DOWN\/UP arrow keys.-    reanimate,+  ( reanimate,     -- * Animations     SVG,     Time,@@ -62,6 +72,7 @@     bellS,     oscillateS,     fromListS,+    cubicBezierS,     -- ** Scenes     (#),     Scene

@@ -48,3 +48,6 @@     height = 1     img = generateImage pixelRenderer width height     pixelRenderer x _y = f (fromIntegral x / fromIntegral (width-1))++rtfdBackgroundColor :: PixelRGBA8+rtfdBackgroundColor = PixelRGBA8 252 252 252 0xFF

@@ -7,6 +7,7 @@   , cacheDiskLines   ) where +import           Control.Exception import           Control.Monad       (unless) import           Data.Hashable import           Data.IORef@@ -17,13 +18,13 @@ import qualified Data.Text.IO        as T import           Graphics.SvgTree    (Tree (..), unparse) import           Reanimate.Animation (renderTree)+import           Reanimate.Misc      (renameOrCopyFile) import           System.Directory import           System.FilePath import           System.IO-import           Control.Exception+import           System.IO.Temp import           System.IO.Unsafe import           Text.XML.Light      (Content (..), parseXML)-import System.IO.Temp  -- Memory cache and disk cache @@ -36,7 +37,7 @@     unless hit $ withSystemTempFile template $ \tmp h -> do       hClose h       gen tmp-      renameFile tmp path+      renameOrCopyFile tmp path     evaluate path  cacheDisk :: (T.Text -> Maybe a) -> (a -> T.Text) -> (Text -> IO a) -> (Text -> IO a)@@ -58,7 +59,7 @@       new <- gen key       T.hPutStr tmpHandle (render new)       hClose tmpHandle-      renameFile tmpPath path+      renameOrCopyFile tmpPath path       return new  cacheDiskKey :: Text -> IO Tree -> IO Tree

@@ -145,6 +145,8 @@             ,"--target", target             ,"+RTS", "-N", "-RTS"]         else do+          raster <- selectRaster renderRaster+          setRaster raster           setFPS fps           setWidth width           setHeight height@@ -153,9 +155,10 @@                  \  width:  %d\n\                  \  height: %d\n\                  \  fmt:    %s\n\-                 \  target: %s\n"-            fps width height (showFormat fmt) target-          raster <- selectRaster renderRaster+                 \  target: %s\n\+                 \  raster: %s\n"+            fps width height (showFormat fmt) target (show raster)+           render animation target raster fmt width height fps  selectRaster :: Raster -> IO Raster

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash    #-} {-# LANGUAGE MultiWayIf   #-} module Reanimate.GeoProjection   ( Projection(..)@@ -6,6 +7,7 @@   , LonLat(..)   , project   , interpP+  , interpBBP   , mergeP   , isValidP   , scaleP@@ -17,6 +19,7 @@   , mercatorP   , mollweideP   , hammerP+  , cylindricalEqualAreaP   , lambertP   , bottomleyP   , sinusoidalP@@ -42,22 +45,33 @@  import           Codec.Picture import           Codec.Picture.Types-import           Control.Lens        ((^.))+import           Control.Lens            ((^.)) import           Control.Monad import           Control.Monad.ST+import           Control.Monad.ST.Unsafe import           Data.Aeson import           Data.Foldable-import           Data.Geospatial     hiding (LonLat)+import           Data.Geospatial         hiding (LonLat)+import           Data.Hashable import           Data.LinearRing-import qualified Data.LineString     as Line+import qualified Data.LineString         as Line+import           Data.Vector.Storable    (unsafeWith)+import qualified Data.Vector.Unboxed     as V import           Debug.Trace-import           Graphics.SvgTree    (Tree (None))-import           Linear              (distance, lerp)-import           Linear.V2           hiding (angle)+import           Foreign+import           GHC.Exts                (Double (..), cosDouble#, sinDouble#,+                                          (*##), (+##), (-##), (/##))+import           Graphics.SvgTree        (Tree (None))+import           Linear                  (distance, lerp)+import           Linear.V2               hiding (angle) import           Reanimate import           System.IO.Unsafe -+{-# INLINE halfPi #-}+{-# INLINE sqrtPi #-}+{-# INLINE sqrt2 #-}+{-# INLINE epsilon #-}+{-# INLINE tau #-} -- Constants halfPi, sqrtPi, sqrt2, epsilon, tau :: Double halfPi = pi/2@@ -70,136 +84,294 @@ toRads dec = dec/180 * pi cot = recip . tan + srcPixel :: Pixel pixel => Image pixel -> LonLat -> pixel srcPixel src (LonLat lam phi) =-    pixelAt src xPx yPx+    -- pixelAt src xPx yPx+    unsafePixelAt (imageData src) (pixelBaseIndex src xPx yPx)   where     !xPx = round $ ((lam+pi)/tau) * fromIntegral (imageWidth src-1)     !yPx = round $ (1-((phi+halfPi)/pi)) * fromIntegral (imageHeight src-1) -{- HLINT ignore -}-findValidCoord :: Image pixel -> Projection -> XYCoord -> XYCoord-findValidCoord !src !p (XYCoord x y) = foldr const (XYCoord x y)-    [ XYCoord x' y'-    | let !xi = round $ x * wMax-          !yi = round $ y * hMax-    , !ax <- [xi, xi-1, xi+1]-    , ax >= 0-    , ax < w-    , let !x' = fromIntegral ax / wMax-    , !ay <- [yi, yi-1, yi+1]-    , ay >= 0-    , ay < h-    , let !y' = fromIntegral ay / hMax-    , validLonLat $! projectionInverse p $! XYCoord x' y'-    ]++srcPixelFast :: Image PixelRGBA8 -> Double -> Double -> LonLat -> ST s PixelRGBA8+srcPixelFast src wMax hMax (LonLat lam phi) = unsafeIOToST $+    unsafeWith (imageData src) $ \ptr -> do+      let ptr' = plusPtr ptr idx+      r <- peek ptr'+      g <- peek $ plusPtr ptr' 1+      b <- peek $ plusPtr ptr' 2+      a <- peek $ plusPtr ptr' 3+      return $ PixelRGBA8 r g b a   where-    !w = imageWidth src-    !h = imageHeight src-    !wMax = fromIntegral (w-1)-    !hMax = fromIntegral (h-1)+    !idx = pixelBaseIndex src xPx yPx+    !xPx = round $ ((lam+pi)/tau) * wMax+    !yPx = round $ (1-((phi+halfPi)/pi)) * hMax -isInWorld :: Projection -> XYCoord -> Bool-isInWorld p coord =-    odd $ length $ isInWorld' p coord+{- HLINT ignore -}+-- findValidCoord :: Int -> Int -> Double -> Double -> (XYCoord -> LonLat) -> XYCoord -> XYCoord+-- findValidCoord !w !h !wMax !hMax !p_inv (XYCoord x y) = foldr const (XYCoord x y)+--     [ XYCoord x' y'+--     | let !xi = round $ x * wMax+--           !yi = round $ y * hMax+--     , !ax <- [xi, xi-1, xi+1]+--     , ax >= 0+--     , ax < w+--     , let !x' = fromIntegral ax / wMax+--     , !ay <- [yi, yi-1, yi+1]+--     , ay >= 0+--     , ay < h+--     , let !y' = fromIntegral ay / hMax+--     , validLonLat $! p_inv $! XYCoord x' y'+--     ] -isInWorld' :: Projection -> XYCoord -> [(Double, Double)]-isInWorld' p (XYCoord x y) =-    [ (x1, y1)-    | (XYCoord x1 y1, XYCoord x2 y2) <- world-    , (y1 > y) /= (y2 > y) -- y is between y1 and y2-    , x < (x2 - x1) * (y - y1) / (y2 - y1) + x1 -- x is to the left of the line-    ]-  where-    world = worldPolygon p+-- isInWorld :: Projection -> XYCoord -> Bool+-- isInWorld p coord =+--     odd $ length $ isInWorld' p coord+--+-- isInWorld' :: Projection -> XYCoord -> [(Double, Double)]+-- isInWorld' p (XYCoord x y) =+--     [ (x1, y1)+--     | (XYCoord x1 y1, XYCoord x2 y2) <- world+--     , (y1 > y) /= (y2 > y) -- y is between y1 and y2+--     , x < (x2 - x1) * (y - y1) / (y2 - y1) + x1 -- x is to the left of the line+--     ]+--   where+--     world = worldPolygon p+--+-- worldPolygon :: Projection -> [(XYCoord, XYCoord)]+-- worldPolygon p =+--     interp (-pi, -halfPi) (-pi, halfPi) +++--     interp (-pi, halfPi) (pi, halfPi) +++--     interp (pi, halfPi) (pi, -halfPi) +++--     interp (pi, -halfPi) (-pi, -halfPi)+--   where+--     apply (lam, phi) = projectionForward p $ LonLat lam phi+--     steps = 100+--     interp (x1, y1) (x2,y2) =+--       [ ( apply (fromToS x1 x2 (n/steps), fromToS y1 y2 (n/steps))+--         , apply (fromToS x1 x2 ((n+1)/steps), fromToS y1 y2 ((n+1)/steps)))+--       | n <- [0..steps-1]] -worldPolygon :: Projection -> [(XYCoord, XYCoord)]-worldPolygon p =-    interp (-pi, -halfPi) (-pi, halfPi) ++-    interp (-pi, halfPi) (pi, halfPi) ++-    interp (pi, halfPi) (pi, -halfPi) ++-    interp (pi, -halfPi) (-pi, -halfPi)-  where-    apply (lam, phi) = projectionForward p $ LonLat lam phi-    steps = 100-    interp (x1, y1) (x2,y2) =-      [ ( apply (fromToS x1 x2 (n/steps), fromToS y1 y2 (n/steps))-        , apply (fromToS x1 x2 ((n+1)/steps), fromToS y1 y2 ((n+1)/steps)))-      | n <- [0..steps-1]]+-- findNearestPixel :: MutableImage s PixelRGBA8 -> Int -> Int -> Int -> Int -> ST s PixelRGBA8+-- findNearestPixel src w h srcX srcY = worker $ take 20+--     [ (x, y)+--     | n <- [1..]+--     , x <- [srcX-n .. srcY+n]+--     , y <- if x == srcX-n || x == srcX+n then [srcY-n,srcY+n] else [srcY-n .. srcY+n]+--     , x >= 0+--     , y >= 0+--     , x < w+--     , y < h+--     ]+--   where+--     worker [] = pure $ PixelRGBA8 0xFF 0x00 0x00 0xFF+--     worker ((x,y):rest) = do+--       this <- readPixel src x y+--       if this == blank+--         then worker rest+--         else return this+--     blank = PixelRGBA8 0x00 0x00 0x00 0x00 -findNearestPixel :: MutableImage s PixelRGBA8 -> Int -> Int -> Int -> Int -> ST s PixelRGBA8-findNearestPixel src w h srcX srcY = worker $ take 20-    [ (x, y)-    | n <- [1..]-    , x <- [srcX-n .. srcY+n]-    , y <- if x == srcX-n || x == srcX+n then [srcY-n,srcY+n] else [srcY-n .. srcY+n]-    , x >= 0-    , y >= 0-    , x < w-    , y < h-    ]-  where-    worker [] = pure $ PixelRGBA8 0xFF 0x00 0x00 0xFF-    worker ((x,y):rest) = do-      this <- readPixel src x y-      if this == blank-        then worker rest-        else return this-    blank = PixelRGBA8 0x00 0x00 0x00 0x00 +-- Original version:        134,925 pixels/second+-- Inlined projections:     136,332 pixels/second+-- TEST: no write pixels:   134,288 pixels/second !!!+-- Fast theta:            1,489,719 pixels/second+-- Cached theta:          3,622,254 pixels/second++-- to equirectangularP:   9,015,326 pixels/second+--                        9,680,217+--                        9,466,744+--                       14,830,330+-- to lambertP:           6,735,973+-- to mercatorP:          4,248,927+-- to mollweideP:         3,593,545+-- to hammerP:            3,237,699+-- to bottomleyP:         3,864,848+-- to sinusoidalP:        7,020,756+-- to wernerP:            4,433,295+-- to bonneP:             4,071,187+-- to augustP:            2,553,177+-- to collignonP:         5,486,849+-- to eckert1P:           7,428,849+-- to eckert3P:           6,666,936+-- to eckert5P:           6,106,492+-- to faheyP:             5,137,291+-- to foucautP:           3,983,151+-- to lagrangeP:          3,850,611+-- interpFastP :: Image PixelRGBA8 -> Projection -> Projection -> Double -> Image PixelRGBA8+-- interpFastP !src (Projection _ p1 p1_inv) (Projection _ p2 p2_inv) !t = runST $ do+--     unsafeIOToST $ putStrLn "Allocating new array"+--     !img <- newMutableImage w h+--     unsafeIOToST $ putStrLn "done"+--     start <- unsafeIOToST $ getCurrentTime+--     let factor = 2+--         total = w*factor * h*factor+--     let l1 =+--           loopTo (w*factor) $ \x -> do+--             loopTo (h*factor) $ \y -> do+--               let thisIndex = (x*h*factor+y)+--               when (thisIndex `mod` 1000000 == 0) $ unsafeIOToST $ do+--                 now <- getCurrentTime+--                 let diff = realToFrac (diffUTCTime now start):: Double+--                 printf "%.2f pixels/second\n" (fromIntegral (total-thisIndex) / diff)+--               let !x1' = fromIntegral x / (wMax*fromIntegral factor)+--                   !y1' = fromIntegral y / (hMax*fromIntegral factor)+--                   !lonlat = p1_inv $! XYCoord x1' y1'+--                   -- p = srcPixel src lonlat+--               -- unsafeIOToST (evaluate lonlat)+--+--               when (validLonLat lonlat) $ do+--                 p <- srcPixelFast src wMax hMax lonlat+--                 when (pixelOpacity p /= 0) $ do+--                   let XYCoord !x1 !y1 = p1 lonlat+--                       -- !coord = p2 lonlat+--                       XYCoord !x2 !y2 = p2 lonlat -- findValidCoord w h wMax hMax p2_inv $ p2 lonlat+--                       !x3 = round $ fromToS x1 x2 t * wMax+--                       !y3 = round $ (1 - fromToS y1 y2 t) * hMax :: Int+--                   -- unsafeIOToST (evaluate coord)+--                   -- return ()+--                   when (x3 >= 0 && x3 < w && y3 >= 0 && y3 < h) $+--                     writePixel img x3 y3 p+--     l1+--     unsafeFreezeImage img+--   where+--     loopTo m fn = go m+--       where go 0 = return ()+--             go n = fn (n-1) >> go (n-1)+--     !w = imageWidth src+--     !h = imageHeight src+--     !wMax = fromIntegral (w-1)+--     !hMax = fromIntegral (h-1)+ interpP :: Image PixelRGBA8 -> Projection -> Projection -> Double -> Image PixelRGBA8-interpP !src !p1 !p2 !t = runST $ do+interpP src p1 _ 0 = project src p1+interpP src _ p2 1 = project src p2+interpP !src (Projection _label1 p1 p1_inv) !(Projection _label2 p2 p2_inv) !t = runST $ do     !img <- newMutableImage w h-    let blank = PixelRGBA8 0x00 0x00 0x00 0x00-    let isBlank pixel = pixel == blank-    -- forM_ [0..w-1] $ \x ->-    --   forM_ [0..h-1] $ \y -> do-    --     let x1 = fromIntegral x / (wMax)-    --         y1 = 1 - fromIntegral y / (hMax)-    --     when (isInWorld (mergeP p1 p2 t) (XYCoord x1 y1)) $-    --       writePixel img x y $ PixelRGBA8 0xFF 0x00 0x00 0xFF+     let factor = 2+        -- total = w*factor * h*factor+    let l1 = do+          -- start <- unsafeIOToST $ getCurrentTime+          loopTo (w*factor) $ \x -> do+            loopTo (h*factor) $ \y -> do+              -- let thisIndex = (x*h*factor+y)+              -- when (thisIndex `mod` 1000000 == 0) $ unsafeIOToST $ do+              --   now <- getCurrentTime+              --   let diff = realToFrac (diffUTCTime now start):: Double+              --   printf "%.2f pixels/second: %s\n" (fromIntegral (total-thisIndex) / diff) label1+              let !x1' = fromIntegral x / (wMax*fromIntegral factor)+                  !y1' = fromIntegral y / (hMax*fromIntegral factor)+                  !lonlat = p1_inv $! XYCoord x1' y1'+                  -- p = srcPixel src lonlat++              when (validLonLat lonlat) $ do+                p <- srcPixelFast src wMax hMax lonlat+                when (pixelOpacity p /= 0) $ do+                  let XYCoord x1 y1 = p1 lonlat+                      -- XYCoord x2 y2 = findValidCoord w h wMax hMax p2_inv $ p2 lonlat+                      XYCoord x2 y2 = p2 lonlat+                      !x3 = round $ fromToS x1 x2 t * wMax+                      !y3 = round $ (1 - fromToS y1 y2 t) * hMax+                  when (x3 >= 0 && x3 < w && y3 >= 0 && y3 < h) $+                    writePixel img x3 y3 p+        l2 = do+          -- start <- unsafeIOToST $ getCurrentTime+          loopTo (w*factor) $ \x ->+            loopTo (h*factor) $ \y -> do+              -- let thisIndex = (x*h*factor+y)+              -- when (thisIndex `mod` 1000000 == 0) $ unsafeIOToST $ do+              --   now <- getCurrentTime+              --   let diff = realToFrac (diffUTCTime now start):: Double+              --   printf "%.2f pixels/second: %s\n" (fromIntegral (total-thisIndex) / diff) label2+              let !x2' = fromIntegral x / (wMax*fromIntegral factor)+                  !y2' = fromIntegral y / (hMax*fromIntegral factor)+                  !lonlat = p2_inv (XYCoord x2' y2')+                  -- p = srcPixel src lonlat+              when (validLonLat lonlat) $ do+                p <- srcPixelFast src wMax hMax lonlat+                when (pixelOpacity p /= 0) $ do+                  let XYCoord x2 y2 = p2 lonlat+                      -- XYCoord x1 y1 = findValidCoord w h wMax hMax p1_inv $ p1 lonlat+                      XYCoord x1 y1 = p1 lonlat+                      !x3 = round $ fromToS x1 x2 t * wMax+                      !y3 = round $ (1 - fromToS y1 y2 t) * hMax+                  when (x3 >= 0 && x3 < w && y3 >= 0 && y3 < h) $ do+                    writePixel img x3 y3 p+    if t < 0.5+      then l1 >> l2+      else l2 >> l1+    unsafeFreezeImage img+  where+    loopTo m fn = go m+      where go 0 = return ()+            go n = fn (n-1) >> go (n-1)+    !w = imageWidth src+    !h = imageHeight src+    !wMax = fromIntegral (w-1)+    !hMax = fromIntegral (h-1)++interpBBP :: Image PixelRGBA8 -> Projection -> Projection ->+            (Double,Double,Double,Double) -> (Double,Double,Double,Double) -> Double -> Image PixelRGBA8+interpBBP !src (Projection _ p1 p1_inv) !(Projection _ p2 p2_inv) (fx,fy,fw,fh) (tx, ty, tw, th) !t = runST $ do+    !img <- newMutableImage w h+    let factor = 2     let l1 =           loopTo (w*factor) $ \x -> do             loopTo (h*factor) $ \y -> do               let !x1' = fromIntegral x / (wMax*fromIntegral factor)                   !y1' = fromIntegral y / (hMax*fromIntegral factor)-                  !lonlat = projectionInverse p1 $! XYCoord x1' y1'-                  p = srcPixel src lonlat-              when (validLonLat lonlat && pixelOpacity p /= 0) $ do-                let XYCoord x1 y1 = projectionForward p1 lonlat-                    XYCoord x2 y2 = findValidCoord src p2 $ projectionForward p2 lonlat-                    !x3 = round $ fromToS x1 x2 t * wMax-                    !y3 = round $ (1 - fromToS y1 y2 t) * hMax-                when (x3 >= 0 && x3 < w && y3 >= 0 && y3 < h) $-                  writePixel img x3 y3 p+              when (x1' >= fx && x1' <= fx+fw && y1' >= fy && y1' <= fy+fh) $ do+                let !lonlat = p1_inv $! XYCoord x1' y1'+                      -- p = srcPixel src lonlat++                when (validLonLat lonlat) $ do+                    -- let LonLat lam phi = lonlat+                    --     !xPx = ((lam+pi)/tau)+                    --     !yPx = (((phi+halfPi)/pi))+                    -- when (xPx >= fx && xPx <= fx+fw && yPx >= fy && yPx <= fy+fh) $ do+                    p <- srcPixelFast src wMax hMax lonlat+                    when (pixelOpacity p /= 0) $ do+                      let XYCoord x1 y1 = p1 lonlat+                          XYCoord x2 y2 = p2 lonlat+                          -- XYCoord x2 y2 = findValidCoord w h wMax hMax p2_inv $ p2 lonlat+                          !x3 = round $ fromToS x1 x2 t * wMax+                          !y3 = round $ (1 - fromToS y1 y2 t) * hMax+                      when (x3 >= 0 && x3 < w && y3 >= 0 && y3 < h) $+                        writePixel img x3 y3 p         l2 =           loopTo (w*factor) $ \x ->             loopTo (h*factor) $ \y -> do               let !x2' = fromIntegral x / (wMax*fromIntegral factor)                   !y2' = fromIntegral y / (hMax*fromIntegral factor)-                  !lonlat = projectionInverse p2 (XYCoord x2' y2')-                  p = srcPixel src lonlat-              when (validLonLat lonlat && pixelOpacity p /= 0) $ do-                let XYCoord x2 y2 = projectionForward p2 lonlat-                    XYCoord x1 y1 = findValidCoord src p1 $ projectionForward p1 lonlat-                    !x3 = round $ fromToS x1 x2 t * wMax-                    !y3 = round $ (1 - fromToS y1 y2 t) * hMax-                when (x3 >= 0 && x3 < w && y3 >= 0 && y3 < h) $ do-                  writePixel img x3 y3 p+              when (x2' >= tx && x2' <= tx+tw && y2' >= ty && y2' <= ty+th) $ do+                let !lonlat = p2_inv (XYCoord x2' y2')+                    -- p = srcPixel src lonlat+                when (validLonLat lonlat) $ do+                  p <- srcPixelFast src wMax hMax lonlat+                  when (pixelOpacity p /= 0) $ do+                    let XYCoord x2 y2 = p2 lonlat+                        -- XYCoord x1 y1 = findValidCoord w h wMax hMax p1_inv $ p1 lonlat+                        XYCoord x1 y1 = p1 lonlat+                        !x3 = round $ fromToS x1 x2 t * wMax+                        !y3 = round $ (1 - fromToS y1 y2 t) * hMax+                    when (x3 >= 0 && x3 < w && y3 >= 0 && y3 < h) $ do+                      writePixel img x3 y3 p     if t < 0.5       then l1 >> l2       else l2 >> l1 -    when False $-      forM_ [0..w-1] $ \x ->-        forM_ [0..h-1] $ \y -> do-          let x1 = fromIntegral x / (wMax)-              y1 = 1 - fromIntegral y / (hMax)-          this <- readPixel img x y-          when (isBlank this) $-            when (isInWorld (mergeP p1 p2 t) (XYCoord x1 y1)) $-              writePixel img x y =<< findNearestPixel img w h x y+    -- when False $+    --   forM_ [0..w-1] $ \x ->+    --     forM_ [0..h-1] $ \y -> do+    --       let x1 = fromIntegral x / (wMax)+    --           y1 = 1 - fromIntegral y / (hMax)+    --       this <- readPixel img x y+    --       when (isBlank this) $+    --         when (isInWorld (mergeP p1 p2 t) (XYCoord x1 y1)) $+    --           writePixel img x y =<< findNearestPixel img w h x y     unsafeFreezeImage img   where     loopTo m fn = go m@@ -210,6 +382,7 @@     !wMax = fromIntegral (w-1)     !hMax = fromIntegral (h-1) + eqLonLat :: LonLat -> LonLat -> Bool eqLonLat (LonLat x1 y1) (LonLat x2 y2)   = eqDouble x1 x2 && eqDouble y1 y2@@ -225,14 +398,19 @@   deriving (Read,Show,Eq,Ord) data LonLat = LonLat !Double !Double -- -pi to +pi, -halfPi to +halfPi   deriving (Read,Show,Eq,Ord)+instance Hashable LonLat where+  hashWithSalt s (LonLat a b) = hashWithSalt s (a,b) data Projection = Projection-  { projectionForward :: !(LonLat -> XYCoord)+  { projectionLabel   :: String+  , projectionForward :: !(LonLat -> XYCoord)+    --+    -- (Double# -> Double# -> (# Double#, Double# #))   , projectionInverse :: !(XYCoord -> LonLat)   }  -- FIXME: Verify that 'src' has an aspect ratio of 2:1. project :: Image PixelRGBA8 -> Projection -> Image PixelRGBA8-project src (Projection _ pInv) = generateImage fn w h+project src (Projection _label _ pInv) = generateImage fn w h   where     w = imageWidth src     h = imageHeight src@@ -253,7 +431,7 @@ _validXYCoord (XYCoord x y) = x >= 0 && x <= 1 && y >= 0 && y <= 1  isValidP :: Projection -> Bool-isValidP (Projection p pInv) = and+isValidP (Projection _label p pInv) = and     [ check x y     | x <- [0..w-1::Int]     , y <- [0..h-1::Int] ]@@ -269,7 +447,7 @@           || trace (show (lonlat, lonlat2)) False  moveBottomP :: Double -> Projection -> Projection-moveBottomP offset (Projection p pInv) = Projection p' pInv'+moveBottomP offset (Projection label p pInv) = Projection label p' pInv'   where     p' (LonLat lon lat) =       case p (LonLat lon lat) of@@ -280,7 +458,7 @@ moveTopP offset = flipYAxisP . moveBottomP offset . flipYAxisP  flipYAxisP :: Projection -> Projection-flipYAxisP (Projection p pInv) = Projection p' pInv'+flipYAxisP (Projection label p pInv) = Projection label p' pInv'   where     p' (LonLat lam phi) =       let XYCoord x y = p (LonLat lam (negate phi))@@ -290,18 +468,17 @@       in LonLat lam (negate phi)  scaleP :: Double -> Double -> Projection -> Projection-scaleP xScale yScale (Projection p pInv) = Projection forward inverse+scaleP xScale yScale (Projection label p pInv) = Projection label forward inverse   where     forward lonlat =       case p lonlat of         XYCoord x y -> XYCoord ((x-0.5)*xScale+0.5) ((y-0.5)*yScale+0.5)     inverse (XYCoord x y) =-      let new = XYCoord ((x-0.5)/xScale+0.5) ((y-0.5)/yScale+0.5)-      in pInv new+      pInv $ XYCoord ((x-0.5)/xScale+0.5) ((y-0.5)/yScale+0.5)   mergeP :: Projection -> Projection -> Double -> Projection-mergeP p1 p2 t = Projection p pInv+mergeP p1 p2 t = Projection (projectionLabel p1 ++ "/" ++ projectionLabel p2) p pInv   where     p lonlat =       let XYCoord x1 y1 = projectionForward p1 lonlat@@ -317,7 +494,7 @@  -- | <<docs/gifs/doc_equirectangularP.gif>> equirectangularP :: Projection-equirectangularP = Projection forward inverse+equirectangularP = Projection "equirectangular" forward inverse   where     forward (LonLat lam phi) = XYCoord ((lam+pi)/tau) ((phi+pi/2)/pi)     inverse (XYCoord x y) = LonLat xPi yPi@@ -327,7 +504,7 @@  -- | <<docs/gifs/doc_mercatorP.gif>> mercatorP :: Projection-mercatorP = Projection forward inverse+mercatorP = Projection "mercator" forward inverse   where     forward (LonLat lam phi) =       XYCoord ((lam+pi)/tau)@@ -337,33 +514,65 @@         xPi = fromToS (-pi) pi x         yPi = fromToS (-pi) pi y +thetas :: V.Vector Double+thetas = V.fromList $+  map (find_theta_fast . fromIndex) [0 .. granularity]++granularity :: Int+granularity = 50000++toIndex :: Double -> Int+toIndex phi = round ((phi+halfPi)/pi * fromIntegral granularity)+fromIndex :: Int -> Double+fromIndex x = fromToS (-halfPi) halfPi (fromIntegral x / fromIntegral granularity)+granualize :: Double -> Double+granualize = fromIndex . toIndex++{-# INLINE mollweideP #-} -- | <<docs/gifs/doc_mollweideP.gif>> mollweideP :: Projection-mollweideP = Projection forward inverse+mollweideP = Projection "mollweide" forward inverse   where-    forward (LonLat lam phi) =+    forward (LonLat !lam !phi) =         XYCoord ((x+sqrt2*2)/(4*sqrt2)) ((y+sqrt2)/(2*sqrt2))       where         x = (2*sqrt2)/pi * lam * cos theta         y = sqrt2*sin theta-        theta = find_theta 100-        find_theta :: Int -> Double-        find_theta 0 = phi-        find_theta _ | abs phi == pi/2 = signum phi * pi/2-        find_theta n =-          let sub = find_theta (n-1)-          in sub - (2*sub+sin (2*sub)-pi*sin phi)/(2+2*cos(2*sub))+        theta = thetas V.! toIndex phi+        -- find_theta :: Int -> Double+        -- find_theta 0 = phi+        -- find_theta _ | abs phi == pi/2 = signum phi * pi/2+        -- find_theta n =+        --   let !sub = find_theta (n-1)+        --   in sub - (2*sub+sin (2*sub)-pi*sin phi)/(2+2*cos(2*sub))     inverse (XYCoord x' y') = LonLat lam phi       where         x = fromToS (-2*sqrt2) (2*sqrt2) x'-        y = fromToS (-sqrt2) sqrt2 y'-        theta = asin (y/sqrt2)+        y = fromToS (-1) 1 y'+        theta = granualize (asin y)         lam = pi*x/(2*sqrt2*cos theta)         phi = asin ((2*theta+sin(2*theta))/pi) +find_theta_fast :: Double -> Double+find_theta_fast !phi | abs phi == pi/2 = signum phi * halfPi+find_theta_fast !(D# phi) = go phi+  where+    !(D# pi#) = pi+    go acc =+      let c = cosDouble# (acc +## acc)+          s = sinDouble# (acc +## acc)+          next =+            acc -##+            (acc +## acc +## s -## pi# *## (sinDouble# phi))+            /## (2.0## +## c +## c) in+      if abs (D# (next -## acc)) < epsilon+        then D# next+        else go next++ -- | <<docs/gifs/doc_hammerP.gif>> hammerP :: Projection-hammerP = Projection forward inverse+hammerP = Projection "hammer" forward inverse   where     forward (LonLat lam phi) =         XYCoord ((x+sqrt2*2)/(4*sqrt2)) ((y+sqrt2)/(2*sqrt2))@@ -378,9 +587,20 @@         lam = 2 * atan2 (z*x) (2*(2*z**2-1))         phi = asin (z*y) +cylindricalEqualAreaP :: Double -> Projection+cylindricalEqualAreaP phi0 = Projection "lambert" forward inverse+  where+    cosPhi0 = cos phi0+    forward (LonLat lam phi) =+      XYCoord ((lam+pi)/tau) ((sin phi/cosPhi0+1/cosPhi0)/2/cosPhi0)+    inverse (XYCoord x' y') = LonLat x (asin y / (asin cosPhi0 / halfPi))+      where+        x = fromToS (-pi) pi x'+        y = fromToS (-1) 1 y' * cosPhi0+ -- | <<docs/gifs/doc_lambertP.gif>> lambertP :: Projection-lambertP = Projection forward inverse+lambertP = Projection "lambert" forward inverse   where     forward (LonLat lam phi) =       XYCoord ((lam+pi)/tau) ((sin phi+1)/2)@@ -391,7 +611,7 @@  -- | <<docs/gifs/doc_bottomleyP.gif>> bottomleyP :: Double -> Projection-bottomleyP !phi_1 = Projection forward inverse+bottomleyP !phi_1 = Projection "bottomley" forward inverse   where     forward (LonLat lam phi) =         XYCoord ((x+pi)/tau) ((y+pi/2)/pi)@@ -413,7 +633,7 @@  -- | <<docs/gifs/doc_sinusoidalP.gif>> sinusoidalP :: Projection-sinusoidalP = Projection forward inverse+sinusoidalP = Projection "sinusoidal" forward inverse   where     forward (LonLat lam phi) =         XYCoord ((x+pi)/tau) ((y+pi/2)/pi)@@ -427,7 +647,7 @@  -- | <<docs/gifs/doc_wernerP.gif>> wernerP :: Projection-wernerP = moveTopP 0.23 $ Projection forward inverse+wernerP = moveTopP 0.23 $ Projection "werner" forward inverse   where     forward (LonLat lam phi) =         XYCoord ((x+pi)/tau) ((y+pi/2)/pi)@@ -449,7 +669,8 @@ -- | <<docs/gifs/doc_bonneP.gif>> bonneP :: Double -> Projection bonneP 0 = sinusoidalP-bonneP phi_0 = moveTopP (-0.17*factor) $ scaleP 1 (fromToS 1 0.65 factor) $ Projection forward inverse+bonneP phi_0 = moveTopP (-0.17*factor) $ scaleP 1 (fromToS 1 0.65 factor) $+    Projection "bonne" forward inverse   where     factor = sin phi_0 / sin (pi/4)     forward (LonLat lam phi ) = XYCoord ((x+pi)/tau) ((y+halfPi)/pi)@@ -471,7 +692,7 @@  -- | <<docs/gifs/doc_orthoP.gif>> orthoP :: LonLat -> Projection-orthoP (LonLat lam_0 phi_0) = Projection forward inverse+orthoP (LonLat lam_0 phi_0) = Projection "ortho" forward inverse   where     forward (LonLat lam phi)         | cosc < 0  =@@ -503,7 +724,7 @@           | otherwise = v  cassiniP :: Projection-cassiniP = Projection forward inverse+cassiniP = Projection "cassini" forward inverse   where     forward (LonLat lam phi) =       XYCoord ((asin (cos phi * sin lam)+halfPi)/pi) ((atan2 (tan phi) (cos lam)+pi)/tau)@@ -514,8 +735,9 @@         lam = atan2 (tan x) (cos y)         phi = asin (sin y * cos x) + augustP :: Projection-augustP = scaleP 0.70 0.70 $ Projection forward inverse+augustP = scaleP 0.70 0.70 $ Projection "august"  forward inverse   where     xHi = 16/3     xLo = -xHi@@ -550,7 +772,7 @@  -- | <<docs/gifs/doc_collignonP.gif>> collignonP :: Projection-collignonP = Projection forward inverse+collignonP = Projection "collignon" forward inverse   where     yHi = sqrtPi     yLo = sqrtPi * (1 - sqrt2)@@ -571,7 +793,7 @@  -- | <<docs/gifs/doc_eckert1P.gif>> eckert1P :: Projection-eckert1P = Projection forward inverse+eckert1P = Projection "eckert1" forward inverse   where     alpha = sqrt (8 / (3*pi))     yLo = -alpha * halfPi@@ -591,7 +813,7 @@  -- | <<docs/gifs/doc_eckert3P.gif>> eckert3P :: Projection-eckert3P = Projection forward inverse+eckert3P = Projection "eckert3" forward inverse   where     k = sqrt (pi * (4 + pi))     yLo = negate yHi@@ -611,7 +833,7 @@  -- | <<docs/gifs/doc_eckert5P.gif>> eckert5P :: Projection-eckert5P = Projection forward inverse+eckert5P = Projection "eckert5" forward inverse   where     k = sqrt (2 + pi)     yLo = negate yHi@@ -629,9 +851,10 @@         lam = k * x / (1 + cos phi)         phi = y * k / 2 +{-# INLINE faheyP #-} -- | <<docs/gifs/doc_faheyP.gif>> faheyP :: Projection-faheyP = Projection forward inverse+faheyP = Projection "fahey" forward inverse   where     faheyK = cos (toRads 35)     yLo = negate yHi@@ -651,8 +874,9 @@         lam = x / (faheyK * sqrt (1 - t*t))         phi = 2 * atan2 y (1 + faheyK) +{-# INLINE foucautP #-} foucautP :: Projection-foucautP = Projection forward inverse+foucautP = Projection "foucaut" forward inverse   where     yLo = negate yHi     yHi = sqrtPi * tan (halfPi/2)@@ -673,8 +897,9 @@         phi = 2 * k         lam = x * sqrtPi / 2 / (cos phi * cosk * cosk) +{-# INLINE lagrangeP #-} lagrangeP :: Projection-lagrangeP = Projection forward inverse+lagrangeP = Projection "lagrange" forward inverse   where     yLo = negate yHi     yHi = 2@@ -691,7 +916,9 @@         x = 2 * sin (lam*n) / c         y = (v - 1/v) /c     inverse (XYCoord x' y')-        | abs (abs y'-1) < epsilon = LonLat 0 (signum y * halfPi)+        | abs (y'-1) < epsilon+          -- = LonLat 0 (signum y * halfPi)+          = LonLat 100 100         | otherwise = LonLat lam phi       where         x = fromToS xLo xHi x' / 2

@@ -38,6 +38,10 @@ emptyCacheMap :: CacheMap emptyCacheMap = CacheMap Map.empty Map.empty +-- sizeCacheMap :: CacheMap -> Int+-- sizeCacheMap (CacheMap sub vals) =+--   sum (map sizeCacheMap (Map.elems sub)) + Map.size vals+ cacheMapLookup :: [DynamicName] -> CacheMap -> Maybe Dynamic cacheMapLookup [] _ = Nothing cacheMapLookup [k] (CacheMap _ vals) = Map.lookup k vals

@@ -5,13 +5,17 @@   , runCmdLazy   , withTempDir   , withTempFile+  , renameOrCopyFile   ) where -import           Control.Exception (evaluate, finally)+import           Control.Exception (evaluate, finally, throw, catch) import qualified Data.Text         as T import qualified Data.Text.IO      as T-import           System.Directory  (createDirectory, findExecutable,-                                    getTemporaryDirectory, removeFile)+import           Foreign.C.Error+import           GHC.IO.Exception+import           System.Directory  (copyFile, createDirectory, findExecutable,+                                    getTemporaryDirectory, removeFile,+                                    renameFile) import           System.Exit       (ExitCode (..)) import           System.FilePath   ((<.>), (</>)) import           System.IO         (hClose, hGetContents, hIsEOF, openTempFile)@@ -19,6 +23,7 @@                                     runInteractiveProcess, showCommandForUser,                                     terminateProcess, waitForProcess) + requireExecutable :: String -> IO FilePath requireExecutable exec = do   mbPath <- findExecutable exec@@ -31,7 +36,7 @@   ret <- runCmd_ exec args   case ret of     Left err -> error $ showCommandForUser exec args ++ ":\n" ++ err-    Right{} -> return ()+    Right{}  -> return ()  runCmd_ :: FilePath -> [String] -> IO (Either String String) runCmd_ exec args = do@@ -61,7 +66,7 @@             _ <- evaluate (length stderr)             ret <- waitForProcess pid             case ret of-              ExitSuccess -> return (Left "")+              ExitSuccess   -> return (Left "")               ExitFailure{} -> return (Left stderr)               {-ExitFailure errMsg -> do                 return $ Left $@@ -75,6 +80,13 @@     terminateProcess pid     _ <- waitForProcess pid     return ()++renameOrCopyFile :: FilePath -> FilePath -> IO ()+renameOrCopyFile src dst = renameFile src dst `catch` exdev+  where+    exdev e = if fmap Errno (ioe_errno e) == Just eXDEV+                then copyFile src dst >> removeFile src+                else throw e  withTempDir :: (FilePath -> IO a) -> IO a withTempDir action = do

@@ -1,18 +1,48 @@ module Reanimate.Parameters-  ( pFPS+  ( Raster(..)+  , Width+  , Height+  , FPS+  , pRaster+  , pFPS   , pWidth   , pHeight   , pNoExternals+  , pRootDirectory+  , setRaster   , setFPS   , setWidth   , setHeight   , setNoExternals+  , setRootDirectory   ) where  import System.IO.Unsafe import Data.IORef-import Reanimate.Render +type Width = Int+type Height = Int+type FPS = Int++data Raster+  = RasterNone+  | RasterAuto+  | RasterInkscape+  | RasterRSvg+  | RasterConvert+  deriving (Show)++{-# NOINLINE pRasterRef #-}+pRasterRef :: IORef Raster+pRasterRef = unsafePerformIO (newIORef RasterNone)++{-# NOINLINE pRaster #-}+pRaster :: Raster+pRaster = unsafePerformIO (readIORef pRasterRef)++setRaster :: Raster -> IO ()+setRaster = writeIORef pRasterRef+ {-# NOINLINE pFPSRef #-} pFPSRef :: IORef FPS pFPSRef = unsafePerformIO (newIORef 0)@@ -58,3 +88,13 @@ setNoExternals :: Bool -> IO () setNoExternals = writeIORef pNoExternalsRef +{-# NOINLINE pRootDirectoryRef #-}+pRootDirectoryRef :: IORef FilePath+pRootDirectoryRef = unsafePerformIO (newIORef (error "root directory not set"))++{-# NOINLINE pRootDirectory #-}+pRootDirectory :: FilePath+pRootDirectory = unsafePerformIO (readIORef pRootDirectoryRef)++setRootDirectory :: FilePath -> IO ()+setRootDirectory = writeIORef pRootDirectoryRef

@@ -1,5 +1,7 @@ module Reanimate.Raster-  ( embedImage+  ( mkImage+  , cacheImage+  , embedImage   , embedDynamicImage   , embedPng   , raster@@ -35,7 +37,27 @@ import           System.IO.Temp import           System.IO.Unsafe +-- FIXME: Embed the image data as inline base64 iff no raster engine is specified.+mkImage :: Double -> Double -> FilePath -> SVG+mkImage width height path = unsafePerformIO $ do+    exists <- doesFileExist target+    unless exists $ copyFile path target+    return $ flipYAxis $ ImageTree $ defaultSvg+      & Svg.imageWidth .~ Svg.Num width+      & Svg.imageHeight .~ Svg.Num height+      & Svg.imageHref .~ ("file://"++target)+      & Svg.imageCornerUpperLeft .~ (Svg.Num (-width/2), Svg.Num (-height/2))+      & Svg.imageAspectRatio .~ Svg.PreserveAspectRatio False Svg.AlignNone Nothing+  where+    target = pRootDirectory </> show hashPath <.> takeExtension path+    hashPath = hash path +cacheImage :: (PngSavable pixel, Hashable a) => a -> Image pixel -> FilePath+cacheImage key gen = unsafePerformIO $ cacheFile template $ \path ->+    writePng path gen+  where+    template = show (hash key) <.> "png"+ {-# INLINE embedImage #-} embedImage :: PngSavable a => Image a -> Tree embedImage img = embedPng width height (encodePng img)@@ -119,7 +141,7 @@         convert <- requireExecutable "convert"         runCmd convert [ path, "-flatten", tmpBmpPath ]         runCmd potrace (args ++ ["--svg", "--output", tmpSvgPath, tmpBmpPath])-        renameFile tmpSvgPath svgPath+        renameOrCopyFile tmpSvgPath svgPath     svg_data <- B.readFile svgPath     case parseSvgFile svgPath svg_data of       Nothing  -> do

@@ -10,16 +10,18 @@  import           Control.Concurrent import           Control.Exception-import           Control.Monad       (forM_, void)+import           Control.Monad       (forM_, void, unless, forever) import qualified Data.Text           as T import qualified Data.Text.IO        as T+import           Data.Time import           Graphics.SvgTree    (Number (..)) import           Numeric import           Reanimate.Animation import           Reanimate.Misc-import           System.FilePath     ((</>))-import           System.FilePath    (replaceExtension)+import           Reanimate.Parameters import           System.Exit+import           System.FilePath     ((</>))+import           System.FilePath     (replaceExtension) import           System.IO import           Text.Printf         (printf) @@ -71,21 +73,9 @@   where     isSeen x = any (\y -> x `mod` y == 0) seen -data Raster-  = RasterNone-  | RasterAuto-  | RasterInkscape-  | RasterRSvg-  | RasterConvert-  deriving (Show)- data Format = RenderMp4 | RenderGif | RenderWebm   deriving (Show) -type Width = Int-type Height = Int-type FPS = Int- render :: Animation        -> FilePath        -> Raster@@ -131,18 +121,35 @@  generateFrames :: Raster -> Animation -> Width -> Height -> FPS -> (FilePath -> IO a) -> IO a generateFrames raster ani width_ height_ rate action = withTempDir $ \tmp -> do+    setRootDirectory tmp     done <- newMVar (0::Int)     let frameName nth = tmp </> printf nameTemplate nth-    putStr $ "\r0/" ++ show frameCount+    putStr $ "\rFrames rendered: 0/" ++ show frameCount ++ "\27[K\r"     hFlush stdout-    handle h $ concurrentForM_ frames $ \n -> do-      writeFile (frameName n) $ renderSvg width height $ nthFrame n-      applyRaster raster (frameName n)-      modifyMVar_ done $ \nDone -> do-        putStr $ "\r" ++ show (nDone+1) ++ "/" ++ show frameCount-        hFlush stdout-        return (nDone+1)-    putStrLn "\n"+    start <- getCurrentTime+    let statusPrinter = forever $ do+          nDone <- readMVar done+          now <- getCurrentTime+          let spent = diffUTCTime now start+              remaining = (spent / (fromIntegral nDone / fromIntegral frameCount)) - spent+          putStr $ "\rFrames rendered: " ++ show nDone ++ "/" ++ show frameCount+          putStr $ ", time spent: " ++ ppDiff spent+          unless (nDone==0) $ do+            putStr $ ", time remaining: " ++ ppDiff remaining+            putStr $ ", total time: " ++ ppDiff (remaining+spent)+          putStr $ "\27[K\r"+          hFlush stdout+          threadDelay 1000000+    withBackgroundThread statusPrinter $ do+      handle h $ concurrentForM_ frames $ \n -> do+        writeFile (frameName n) $ renderSvg width height $ nthFrame n+        applyRaster raster (frameName n)+        modifyMVar_ done $ \nDone -> return (nDone+1)+    now <- getCurrentTime+    let spent = diffUTCTime now start+    putStr $ "\rFrames rendered: " ++ show frameCount ++ "/" ++ show frameCount+    putStr $ ", time spent: " ++ ppDiff spent+    putStr $ "\27[K\n"     action (tmp </> rasterTemplate raster)   where     width = Just $ Px $ fromIntegral width_@@ -152,11 +159,24 @@                        \Hit ctrl-c again to abort."       return ()     h other = throwIO other-    frames = [0..frameCount-1]+    -- frames = [0..frameCount-1]+    frames = frameOrder rate frameCount     nthFrame nth = frameAt (recip (fromIntegral rate) * fromIntegral nth) ani     frameCount = round (duration ani * fromIntegral rate) :: Int     nameTemplate :: String     nameTemplate = "render-%05d.svg"++withBackgroundThread :: IO () -> IO a -> IO a+withBackgroundThread t = bracket (forkIO t) killThread . const++ppDiff :: NominalDiffTime -> String+ppDiff diff+  | hours == 0 && mins == 0 = show secs ++ "s"+  | hours == 0 = printf "%.2d:%.2d" mins secs+  | otherwise  = printf "%.2d:%.2d:%.2d" hours mins secs+  where+    (osecs, secs) = round diff `divMod` (60::Int)+    (hours, mins) = osecs `divMod` 60  rasterTemplate :: Raster -> String rasterTemplate RasterNone = "render-%05d.svg"

@@ -8,6 +8,7 @@   , bellS   , oscillateS   , fromListS+  , cubicBezierS   ) where  -- | Signals are time-varying variables. Signals can be composed using function@@ -91,3 +92,16 @@ --   <<docs/gifs/doc_bellS.gif>> bellS :: Double -> Signal bellS steepness = curveS steepness . oscillateS++-- | Cubic Bezier signal. Gives you a fair amount of control over how the+--   signal will 'curve'.+--+--   Example:+--+--   > signalA (cubicBezierS (0.0, 0.8, 0.9, 1.0)) drawProgress+--   +--   <<docs/gifs/doc_cubicBezierS.gif>>+cubicBezierS :: (Double, Double, Double, Double) -> Signal+cubicBezierS (x1, x2, x3, x4) s = +  let ms = 1-s+  in x1*ms^(3::Int) + 3*x2*ms^(2::Int)*s + 3*x3*ms*s^(2::Int) + x4*s^(3::Int)

@@ -44,7 +44,8 @@       case x of         LineMove to     -> worker to xs         -- LineDraw to     -> from:to:worker to xs-        -- FIXME: Use approximation from Geom2D.Bezier+        LineBezier [p] ->+          p : worker p xs         LineBezier ctrl -> -- approximation           [ last (partialBezierPoints (from:ctrl) 0 (recip chunks*i)) | i <- [0..chunks]] ++           worker (last ctrl) xs