animate-preview 0.1.1 → 0.1.2
raw patch · 8 files changed
+59/−25 lines, 8 files
Files
- README.md +2/−0
- animate-preview.cabal +3/−2
- library/Animate/Preview.hs +4/−21
- library/Animate/Preview/Config.hs +1/−0
- library/Animate/Preview/Loader.hs +5/−0
- library/Animate/Preview/Scene.hs +6/−1
- library/Animate/Preview/Watcher.hs +37/−0
- package.yaml +1/−1
README.md view
@@ -7,6 +7,8 @@ It's recommend to use [`sdl2`](https://github.com/haskell-game/sdl2) and [`animate-sdl2`](https://github.com/jxv/animate-sdl2) for graphics. An example can be found [here](https://github.com/jxv/animate-sdl2/tree/master/example). +[Video](https://youtu.be/9DDbeVvkcaE)+  ## Try it!
animate-preview.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: c4d0ff1bbcecbfbc048eaaab5b3fec7f52fb4cc7c0e6aa6e6703f5dd36df83c5+-- hash: 97a9aa8948107d21c298dce29440851ea4b4bae06188f0317a52f4e7706c8ae4 name: animate-preview-version: 0.1.1+version: 0.1.2 synopsis: Preview tool for sprite animation description: Preview tool for sprite animation category: Game@@ -79,6 +79,7 @@ Animate.Preview.SDLRenderer Animate.Preview.State Animate.Preview.Timer+ Animate.Preview.Watcher other-modules: Paths_animate_preview default-language: Haskell2010
library/Animate/Preview.hs view
@@ -11,7 +11,7 @@ import Control.Monad.Reader (MonadReader, ReaderT, runReaderT) import Control.Monad.State (MonadState, StateT, evalStateT) import Control.Monad (when, forever, void)-import Control.Concurrent (threadDelay, forkIO, newMVar)+import Control.Concurrent (threadDelay, forkIO, newMVar, modifyMVar_) import Control.Exception.Safe (MonadThrow, MonadCatch) import Data.Maybe (fromMaybe) import Data.StateVar (get)@@ -31,6 +31,7 @@ import Animate.Preview.Scene import Animate.Preview.State import Animate.Preview.Timer+import Animate.Preview.Watcher data Options = Options { target :: String <?> "File path with sprite information (YAML or JSON)"@@ -61,6 +62,7 @@ resources <- loadResources highDpi' renderer loaded <- newMVar Nothing current <- newMVar Nothing+ reloadVal <- newMVar False winSize <- fmap fromIntegral <$> get (SDL.windowSize window) drawSize <- fmap fromIntegral <$> SDL.glGetDrawableSize window@@ -80,6 +82,7 @@ , cLoaded = loaded , cFps = fps' , cFrameDeltaSeconds = 1.0 / fromIntegral fps'+ , cReload = reloadVal } when (unHelpful $ watch options) $ do@@ -95,17 +98,6 @@ Font.quit SDL.quit -runWatcherAndReloader :: Config -> String -> IO ()-runWatcherAndReloader cfg filename = void $ forkIO $ withManager $ \mgr -> do- -- start a watching job (in the background)- void $ watchDir- mgr- (takeDirectory filename)- (\event -> takeFileName (eventPath event) == takeFileName filename)- (\_ -> runWatcher cfg reload)- -- sleep forever (until interrupted)- forever $ threadDelay 1000000- newtype AnimatePreview a = AnimatePreview (ReaderT Config (StateT Vars IO) a) deriving (Functor, Applicative, Monad, MonadReader Config, MonadState Vars, MonadIO, MonadThrow, MonadCatch) @@ -120,12 +112,3 @@ instance Scene AnimatePreview instance Loader AnimatePreview instance Timer AnimatePreview--newtype Watcher a = Watcher (ReaderT Config IO a)- deriving (Functor, Applicative, Monad, MonadReader Config, MonadIO, MonadThrow, MonadCatch)--instance Logger Watcher-instance Loader Watcher--runWatcher :: Config -> Watcher a -> IO a-runWatcher cfg (Watcher m) = runReaderT m cfg
library/Animate/Preview/Config.hs view
@@ -37,6 +37,7 @@ , cLoaded :: MVar (Maybe Loaded) , cFps :: Int , cFrameDeltaSeconds :: Seconds+ , cReload :: MVar Bool } type R m = MonadReader Config m
library/Animate/Preview/Loader.hs view
@@ -60,8 +60,13 @@ let spriteSheet = Animate.SpriteSheet animations' tex let totalKeys = V.length $ Animate.unAnimations animations' let loaded = Loaded textToInt intToText spriteSheet totalKeys+ oldLoaded <- getLoaded setLoaded (Just loaded) logText $ "Loaded: " `mappend` toText target+ -- delete previous sprite texture+ case Animate.ssImage . lSpriteSheet <$> oldLoaded of+ Nothing -> return ()+ Just i -> SDL.destroyTexture i return True where loadTexture r path c = do
library/Animate/Preview/Scene.hs view
@@ -69,7 +69,12 @@ updateReload :: (S m, R m, HasInput m, Loader m, MonadIO m) => m () updateReload = do input <- getInput- when (isPressed $ iReload input)reload+ mreload <- asks cReload+ watchReload <- liftIO $ readMVar mreload+ when watchReload $ do+ reload+ liftIO $ modifyMVar_ mreload $ \_ -> return False+ when (isPressed $ iReload input) reload reload :: (R m, Loader m, MonadIO m) => m () reload = do
+ library/Animate/Preview/Watcher.hs view
@@ -0,0 +1,37 @@+module Animate.Preview.Watcher where++import Control.Exception.Safe (MonadThrow, MonadCatch)+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)+import Animate.Preview.Config+import Control.Monad (when, forever, void)+import Control.Concurrent (threadDelay, forkIO, newMVar, modifyMVar_)+import Control.Exception.Safe (MonadThrow, MonadCatch)+import Data.Maybe (fromMaybe)+import Data.StateVar (get)+import System.FSNotify (withManager, watchDir, eventPath)+import System.FilePath (takeDirectory, takeFileName)++import Animate.Preview.Loader+import Animate.Preview.Logger+import Animate.Preview.Scene++newtype Watcher a = Watcher (ReaderT Config IO a)+ deriving (Functor, Applicative, Monad, MonadReader Config, MonadIO, MonadThrow, MonadCatch)++instance Logger Watcher+instance Loader Watcher++runWatcher :: Config -> Watcher a -> IO a+runWatcher cfg (Watcher m) = runReaderT m cfg++runWatcherAndReloader :: Config -> String -> IO ()+runWatcherAndReloader cfg filename = void $ forkIO $ withManager $ \mgr -> do+ -- start a watching job (in the background)+ void $ watchDir+ mgr+ (takeDirectory filename)+ (\event -> takeFileName (eventPath event) == takeFileName filename)+ (\_ -> modifyMVar_ (cReload cfg) $ \_ -> return True)+ -- sleep forever (until interrupted)+ forever $ threadDelay 1000000
package.yaml view
@@ -1,5 +1,5 @@ name: animate-preview-version: '0.1.1'+version: '0.1.2' github: jxv/animate-preview license: BSD3 category: Game