reanimate 0.4.0.0 → 0.4.1.0

raw patch · 7 files changed

+112/−50 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• examples/tut_glue_blender.hs +27/−10
• reanimate.cabal +1/−1
• src/Reanimate/Driver.hs +9/−5
• src/Reanimate/Driver/Compile.hs +21/−13
• src/Reanimate/Driver/Server.hs +23/−11
• src/Reanimate/Render.hs +5/−1
• src/Reanimate/Svg/LineCommand.hs +26/−9

@@ -6,13 +6,14 @@ module Main (main) where  import           Reanimate+import           Reanimate.Builtin.Documentation  import           Codec.Picture.Types-import           Control.Lens          ((^.))+import           Control.Lens                    ((^.)) import           Control.Monad import           Data.Monoid-import qualified Data.Text             as T-import           Graphics.SvgTree      hiding (text)+import qualified Data.Text                       as T+import           Graphics.SvgTree                hiding (text) import           NeatInterpolation import           System.Random import           System.Random.Shuffle@@ -20,7 +21,7 @@ -- spritePercent = (/) <$> spriteT <*> spriteDur  main :: IO ()-main = seq texture $ reanimate $ pauseAtEnd 1 $ parA bg $ sceneAnimation $ do+main = seq texture $ reanimate $ pauseAtEnd 1 $ addStatic bg $ sceneAnimation $ do     bend <- newVar 0     trans <- newVar 0     rotX <- newVar 0@@ -50,7 +51,7 @@     wait 1     wait 2   where-    bg = animate $ const $ mkBackgroundPixel (PixelRGBA8 252 252 252 0xFF)+    bg = mkBackgroundPixel rtfdBackgroundColor  texture :: Double -> FilePath texture t = svgAsPngFile $ mkGroup@@ -66,12 +67,20 @@       rotX_ = T.pack $ show rotX       rotY_ = T.pack $ show rotY       yScale_ = T.pack $ show (fromToS (9/2) 4 bend)+      pWidthT = T.pack $ show (max 800 pWidth)+      pHeightT = T.pack $ show (max 450 pHeight)   in [text| import os import math  import bpy +light = bpy.data.objects['Light']+bpy.ops.object.select_all(action='DESELECT')+light.select_set(True)+bpy.ops.object.delete()++ cam = bpy.data.objects['Camera'] cam.location = (0,0,22.25 + ${transZ_}) cam.rotation_euler = (0, 0, 0)@@ -99,10 +108,13 @@ bpy.context.object.active_material = bpy.data.materials['Material'] mat = bpy.context.object.active_material image_node = mat.node_tree.nodes.new('ShaderNodeTexImage')-texture = mat.node_tree.nodes['Principled BSDF']-texture.inputs['Roughness'].default_value = 1-mat.node_tree.links.new(image_node.outputs['Color'], texture.inputs['Base Color'])+output = mat.node_tree.nodes['Material Output']+#texture = mat.node_tree.nodes['Principled BSDF']+#texture.inputs['Roughness'].default_value = 1+#mat.node_tree.links.new(image_node.outputs['Color'], texture.inputs['Base Color'])+mat.node_tree.links.new(image_node.outputs['Color'], output.inputs['Surface']) + image_node.image = bpy.data.images.load('${img_}')  @@ -141,9 +153,14 @@  scn = bpy.context.scene +scn.view_settings.view_transform = 'Standard'+ #scn.render.engine = 'CYCLES' #scn.render.resolution_percentage = 10 +scn.render.resolution_x = ${pWidthT} #3200+scn.render.resolution_y = ${pHeightT} #1800+ scn.render.film_transparent = True  bpy.ops.render.render( write_still=True )@@ -151,11 +168,11 @@  checker :: Int -> Int -> SVG checker w h =-  withStrokeColor "lightblue" $+  withStrokeColor "lightgrey" $   withStrokeWidth (defaultStrokeWidth/2) $   mkGroup   [ withStrokeWidth 0 $-    withFillOpacity 1 $ mkBackground "grey"+    withFillOpacity 1 $ mkBackground "darkgrey"   , mkGroup     [ translate (stepX*x-offsetX + stepX/2) 0 $       mkLine (0, -screenHeight/2*0.9) (0, screenHeight/2*0.9)

@@ -3,7 +3,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                reanimate-version:             0.4.0.0+version:             0.4.1.0 -- synopsis: -- description: license:             PublicDomain

@@ -65,6 +65,11 @@ formatHeight RenderGif  = 180 formatHeight RenderWebm = 1440 +formatExtension :: Format -> String+formatExtension RenderMp4  = "mp4"+formatExtension RenderGif  = "gif"+formatExtension RenderWebm = "webm"+ {-| Main entry-point for accessing an animation. Creates a program that takes the following command-line arguments:@@ -126,11 +131,10 @@        target <- case renderTarget of         Nothing -> do-          self <- findOwnSource-          pure $ case fmt of-            RenderMp4  -> replaceExtension self "mp4"-            RenderGif  -> replaceExtension self "gif"-            RenderWebm -> replaceExtension self "webm"+          mbSelf <- findOwnSource+          let ext = formatExtension fmt+              self = fromMaybe "output" mbSelf+          pure $ replaceExtension self ext         Just target -> makeAbsolute target        let

@@ -5,22 +5,30 @@ import           System.Exit import           System.FilePath import           System.Process+import           System.IO  compile :: [String] -> IO () compile opts = do-  self <- findOwnSource-  let selfDir = takeDirectory self-      selfName = takeBaseName self-      outDir = selfDir </> ".reanimate" </> selfName-      target = outDir </> selfName-      ghcOptions =-          ["-rtsopts", "--make", "-threaded", "-O2"] ++-          ["-odir", outDir, "-hidir", outDir] ++-          [self, "-o", target]-  createDirectoryIfMissing True outDir-  withCurrentDirectory selfDir $ do-    checkExitCode =<< rawSystem "stack" (["ghc", "--"] ++ ghcOptions)-    checkExitCode =<< rawSystem target opts+  mbSelf <- findOwnSource+  case mbSelf of+    Nothing -> do+      hPutStrLn stderr+        "Failed to find source code. Did you already compile the animations?\n\+        \Try running again without the --compile flag."+      exitFailure+    Just self -> do+      let selfDir = takeDirectory self+          selfName = takeBaseName self+          outDir = selfDir </> ".reanimate" </> selfName+          target = outDir </> selfName+          ghcOptions =+              ["-rtsopts", "--make", "-threaded", "-O2"] +++              ["-odir", outDir, "-hidir", outDir] +++              [self, "-o", target]+      createDirectoryIfMissing True outDir+      withCurrentDirectory selfDir $ do+        checkExitCode =<< rawSystem "stack" (["ghc", "--"] ++ ghcOptions)+        checkExitCode =<< rawSystem target opts  checkExitCode :: ExitCode -> IO () checkExitCode ExitSuccess     = return ()

@@ -37,7 +37,7 @@ serve :: Bool -> Maybe FilePath -> [String] -> Maybe FilePath -> IO () serve verbose mbGHCPath extraGHCOpts mbSelfPath = withManager $ \watch -> do   hSetBuffering stdin NoBuffering-  self <- maybe findOwnSource pure mbSelfPath+  self <- maybe requireOwnSource pure mbSelfPath   when verbose $     putStrLn $ "Found own source code at: " ++ self   hasConnectionVar <- newMVar False@@ -176,20 +176,32 @@     ["-odir", tmpDir, "-hidir", tmpDir]  -- FIXME: Move to a different module--- FIXME: Gracefully disable code reloading if source is missing.-findOwnSource :: IO FilePath+requireOwnSource :: IO FilePath+requireOwnSource = do+  mbSelf <- findOwnSource+  case mbSelf of+    Nothing -> do+      hPutStrLn stderr+        "Rendering in browser window is only available when interpreting.\n\+        \To render a video file, use the 'render' command or run again with --help\n\+        \to see all available options."+      exitFailure+    Just self -> pure self++findOwnSource :: IO (Maybe FilePath) findOwnSource = do   fullArgs <- getFullArgs   stackSource <- makeAbsolute (last fullArgs)   exist <- doesFileExist stackSource-  if exist-    then return stackSource+  if exist && isHaskellFile stackSource+    then return (Just stackSource)     else do       prog <- getProgName+      let hsProg+            | isHaskellFile prog = prog+            | otherwise = replaceExtension prog "hs"       lst <- listDirectory "."-      mbSelf <- findFile ("." : lst) prog-      case mbSelf of-        Nothing -> do-          hPutStrLn stderr "Failed to find own source code."-          exitFailure-        Just self -> pure self+      findFile ("." : lst) hsProg++isHaskellFile :: FilePath -> Bool+isHaskellFile path = takeExtension path `elem` [".hs", ".lhs"]

@@ -246,7 +246,7 @@         writeFile (frameName n) $ renderSvg width height $ nthFrame n         modifyMVar_ done $ \nDone -> return (nDone + 1) -  when (raster /= RasterNone)+  when (isValidRaster raster)     $ progressPrinter "rastered" frameCount     $ \done -> handle h $ concurrentForM_ frames $ \n -> do         applyRaster raster (frameName n)@@ -254,6 +254,9 @@    action (tmp </> rasterTemplate raster)  where+  isValidRaster RasterNone = False+  isValidRaster RasterAuto = False+  isValidRaster _ = True    width  = Just $ Px $ fromIntegral width_   height = Just $ Px $ fromIntegral height_@@ -284,6 +287,7 @@  rasterTemplate :: Raster -> String rasterTemplate RasterNone = "render-%05d.svg"+rasterTemplate RasterAuto = "render-%05d.svg" rasterTemplate _          = "render-%05d.png"  requireRaster :: Raster -> IO Raster

@@ -1,16 +1,15 @@ module Reanimate.Svg.LineCommand where -import           Control.Lens                 ((%~), (&), (.~))+import           Control.Lens        ((%~), (&), (.~)) import           Control.Monad.Fix import           Control.Monad.State-import Data.Functor-import           Graphics.SvgTree             hiding (height, line, path, use,-                                               width)+import           Data.Functor+import qualified Data.Vector.Unboxed as V+import qualified Geom2D.CubicBezier  as Bezier+import           Graphics.SvgTree    hiding (height, line, path, use, width) import           Linear.Metric-import           Linear.V2                    hiding (angle)+import           Linear.V2           hiding (angle) import           Linear.Vector-import qualified Data.Vector.Unboxed as V-import qualified Geom2D.CubicBezier           as Bezier  type CmdM a = State RPoint a @@ -67,9 +66,27 @@ lineLength cmd =   case cmd of     LineMove to       -> 0 <$ put to-    -- LineDraw to       -> gets (distance to) <* put to-    LineBezier points -> gets (distance (last points)) <* put (last points)+    -- Straight line:+    LineBezier [dst] -> gets (distance dst) <* put dst+    -- Some kind of curve:+    LineBezier lst -> do+      from <- get+      let bezier = rpointsToBezier (from:lst)+          tol = 0.0001+      put (last lst)+      pure $ Bezier.arcLength bezier 1 tol     LineEnd to        -> gets (distance to) <* put to++rpointsToBezier :: [RPoint] -> Bezier.CubicBezier Double+rpointsToBezier lst =+  case map toBezierPoint lst of+    [a,b] -> Bezier.CubicBezier a a b b+    [a,b,c] -> Bezier.quadToCubic (Bezier.QuadBezier a b c)+    [a,b,c,d] -> Bezier.CubicBezier a b c d+    _ -> error $ "rpointsToBezier: Invalid list of points: " ++ show lst++toBezierPoint :: RPoint -> Bezier.Point Double+toBezierPoint (V2 a b) = Bezier.Point a b  toLineCommands :: [PathCommand] -> [LineCommand] toLineCommands ps = evalState (worker zero Nothing ps) zero