reanimate 0.1.4.0 → 0.1.4.1
raw patch · 5 files changed
+72/−55 lines, 5 filesdep +fsnotifydep −hinotify
Dependencies added: fsnotify
Dependencies removed: hinotify
Files
- posix/Reanimate/FileWatch.hs +0/−18
- reanimate.cabal +2/−12
- src/Reanimate/Driver.hs +22/−15
- src/Reanimate/Svg.hs +48/−0
- unix/Reanimate/FileWatch.hs +0/−10
− posix/Reanimate/FileWatch.hs
@@ -1,18 +0,0 @@-module Reanimate.FileWatch- ( watchFile ) where--import Control.Concurrent-import System.Directory--watchFile :: FilePath -> IO () -> IO ()-watchFile path handler = do- t0 <- getModificationTime path- forkIO $ loop t0- return ()- where- loop lastModTime = do- t1 <- getModificationTime path- if t1 /= lastModTime- then handler >> loop t1- else threadDelay (10^3 * delay) >> loop lastModTime- delay = 1000 -- pool delay in ms.
reanimate.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: reanimate-version: 0.1.4.0+version: 0.1.4.1 -- synopsis: -- description: license: PublicDomain@@ -32,9 +32,6 @@ Type: git Location: git://github.com/lemmih/reanimate.git -Flag inotify- Description: Enable file watching using linux's inotify- library hs-source-dirs: src default-language: Haskell2010@@ -51,7 +48,6 @@ Reanimate.Misc other-modules: Reanimate.Svg.NamedColors Reanimate.Cache- Reanimate.FileWatch Paths_reanimate build-depends: base >=4.10 && <4.13, time, text, unix, filepath, process, directory,@@ -59,13 +55,7 @@ JuicyPixels, attoparsec, parallel, diagrams, diagrams-svg, diagrams-core, diagrams-lib, diagrams-contrib, svg-builder, matrices, cubicbezier, palette, websockets,- hashable- if os(linux) && flag(inotify)- hs-source-dirs: unix- build-depends: hinotify- else- hs-source-dirs: posix-+ hashable, fsnotify Flag server Description: Enable rendering server
src/Reanimate/Driver.hs view
@@ -1,28 +1,31 @@ module Reanimate.Driver ( reanimate ) where -import Control.Concurrent (MVar, forkIO, killThread, modifyMVar_,- newEmptyMVar, putMVar)-import Control.Monad.Fix (fix)-import qualified Data.Text as T+import Control.Concurrent (MVar, forkIO, killThread, modifyMVar_,+ newEmptyMVar, putMVar)+import Control.Exception (finally)+import Control.Monad.Fix (fix)+import qualified Data.Text as T import Network.WebSockets-import Reanimate.FileWatch (watchFile)-import System.Directory (findFile, listDirectory, findExecutable)-import System.Environment (getArgs, getProgName)-import System.IO (BufferMode (..), hPutStrLn, hSetBuffering,- stderr, stdin)+import System.Directory (findExecutable, findFile, listDirectory)+import System.Environment (getArgs, getProgName)+import System.FilePath+import System.FSNotify+import System.IO (BufferMode (..), hPutStrLn, hSetBuffering,+ stderr, stdin) import Data.Maybe import Paths_reanimate-import Reanimate.Misc (runCmd, runCmdLazy, runCmd_, withTempDir,- withTempFile)-import Reanimate.Monad (Animation)-import Reanimate.Render (renderSvgs)+import Reanimate.Misc (runCmd, runCmdLazy, runCmd_, withTempDir,+ withTempFile)+import Reanimate.Monad (Animation)+import Reanimate.Render (renderSvgs) opts = defaultConnectionOptions { connectionCompressionOptions = PermessageDeflateCompression defaultPermessageDeflate } reanimate :: Animation -> IO () reanimate animation = do+ watch <- startManager args <- getArgs hSetBuffering stdin NoBuffering case args of@@ -67,13 +70,17 @@ loop (frame : acc) return tid putStrLn "Found self. Listening."- watchFile self handler+ stop <- watchFile watch self handler putMVar slave =<< forkIO (return ()) let loop = do fps <- receiveData conn :: IO T.Text handler loop- loop+ loop `finally` stop++watchFile watch file action = watchDir watch (takeDirectory file) check (const action)+ where+ check event = takeFileName (eventPath event) == takeFileName file ghcOptions :: FilePath -> [String] ghcOptions tmpDir =
src/Reanimate/Svg.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} module Reanimate.Svg where import Codec.Picture (PixelRGBA8 (..))@@ -494,3 +495,50 @@ if n `elem` target then return $ fn t else return t++pathify :: Tree -> Tree+pathify = mapTree worker+ where+ worker =+ \case+ RectangleTree rect | Just (x,y,w,h) <- unpackRect rect ->+ PathTree $ defaultSvg+ & drawAttributes .~ rect ^. drawAttributes & strokeLineCap .~ pure CapSquare+ & pathDefinition .~+ [MoveTo OriginAbsolute [V2 x y]+ ,HorizontalTo OriginRelative [w]+ ,VerticalTo OriginRelative [h]+ ,HorizontalTo OriginRelative [-w]+ ,EndPath ]+ LineTree line | Just (x1,y1, x2, y2) <- unpackLine line ->+ PathTree $ defaultSvg+ & drawAttributes .~ line ^. drawAttributes+ & pathDefinition .~+ [MoveTo OriginAbsolute [V2 x1 y1]+ ,LineTo OriginAbsolute [V2 x2 y2] ]+ CircleTree circ | Just (x, y, r) <- unpackCircle circ ->+ PathTree $ defaultSvg+ & drawAttributes .~ circ ^. drawAttributes+ & pathDefinition .~+ [MoveTo OriginAbsolute [V2 (x-r) y]+ ,EllipticalArc OriginRelative [(r, r, 0,True,False,(V2 (r*2) 0))+ ,(r, r, 0,True,False,(V2 (-r*2) 0))]]+ t -> t+ unpackCircle circ = do+ let (x,y) = circ ^. circleCenter+ liftM3 (,,) (unpackNumber x) (unpackNumber y) (unpackNumber $ circ ^. circleRadius)+ unpackLine line = do+ let (x1,y1) = line ^. linePoint1+ (x2,y2) = line ^. linePoint2+ liftM4 (,,,) (unpackNumber x1) (unpackNumber y1) (unpackNumber x2) (unpackNumber y2)+ unpackRect rect = do+ let (x', y') = rect ^. rectUpperLeftCorner+ x <- unpackNumber x'+ y <- unpackNumber y'+ w <- unpackNumber =<< rect ^. rectWidth+ h <- unpackNumber =<< rect ^. rectHeight+ return (x,y,w,h)+ unpackNumber n =+ case toUserUnit defaultDPI n of+ Num d -> Just d+ _ -> Nothing
− unix/Reanimate/FileWatch.hs
@@ -1,10 +0,0 @@-module Reanimate.FileWatch- ( watchFile ) where--import System.INotify--watchFile :: FilePath -> IO () -> IO ()-watchFile path handler = do- notify <- initINotify- addWatch notify [Modify] path (const handler)- return ()