-- | -- Module : System.Metronome.Practical -- Copyright : (c) Paolo Veronelli 2012 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : paolo.veronelli@gmail.com -- Stability : unstable -- Portability : not portable (requires STM) -- -- A wrapper module around "System.Metronome" with easy functions. -- -- -- In this snippet we run a metronome and attach 4 tracks to it. -- -- First track ticks every 2 metronome ticks printing \".\" 5 times. -- -- Second track ticks at each metronome tick. Forever it reads a string from a variable, -- it checks first track for actions finished, and push other 5 actions on the first, each printing the string read. -- -- Third track ticks every 14 metronome ticks and forever modifies the string in the variable. -- -- Fourth track ticks every 100 metronome ticks , it does nothing on first action , kill all tracks , including itself and the metronome, -- and wake up main thread on the second. -- -- > {-# LANGUAGE DoRec #-} -- > -- > import System.IO -- > import System.Metronome.Practical -- > import Control.Concurrent.STMOrIO -- > import Control.Monad -- > -- > main = do -- > hSetBuffering stdout NoBuffering -- > (m,f) <- dummyMetronome 0.1 -- > c <- dummyTrack f 2 0 $ replicate 5 $ return $ putStr "." -- > v <- var "!" -- > c2 <- dummyTrack f 1 0 . repeat . noIO $ do -- > as <- getActions c -- > vl <- rd v -- > when (null as) . setActions c . replicate 5 . return $ putStr vl -- > c3 <- dummyTrack f 14 0 . repeat . noIO . md v $ map succ -- > end <- chan () -- > rec {c4 <- dummyTrack f 100 0 . map noIO $ [return (), mapM_ kill [c,c2,c3,c4] >> kill m >> wr end ()]} -- > mapM_ run [c,c2,c3,c4] -- > rd end -- > hSetBuffering stdout LineBuffering -- module System.Metronome.Practical ( -- * Thread kill , stop , run , modRunning -- * Metronome , setTicks , modScheduled -- * Track , modPhase , setFrequency , getActions , setActions , setPriority , modMute -- * Dummy , dummyMetronome , dummyTrack -- * Practical , noIO ) where import Control.Concurrent.STMOrIO import Control.Concurrent.STM import Sound.OpenSoundControl import System.Metronome import Data.Lens.Lazy -- | no IO as result of the STM action noIO :: STM () -> STM (IO ()) noIO f = f >> return (return ()) -- | kill a thread kill :: STMOrIO m => Control a -> m () kill x = md x $ alive `setL` False -- | stop a thread stop :: STMOrIO m => Control a -> m () stop x = md x $ running `setL` False -- | run a thread run :: STMOrIO m => Control a -> m () run x = md x $ running `setL` True -- | invert the running flag of a thread modRunning :: STMOrIO m => Control a -> m () modRunning x = md x $ running `modL` not -- | set the next ticking times for a metronome setTicks :: STMOrIO m => Control Metronome -> [MTime] -> m () setTicks x = md x . modL core . setL ticks -- | change the actions scheduled for the next metronome tick modScheduled :: STMOrIO m => Control Metronome -> ([(Priority,Action)] -> [(Priority, Action)]) -> m () modScheduled x = md x . modL core . modL schedule -- | modify the ticks count from track start, shifting the next ticks relative to metronome ticks modPhase :: STMOrIO m => Control Track -> (Ticks -> Ticks) -> m () modPhase x = md x . modL core . modL sync -- | set the track frequency setFrequency :: STMOrIO m => Control Track -> Frequency -> m () setFrequency x = md x . modL core . setL frequency -- | set the track actions setActions :: STMOrIO m => Control Track -> [Action] -> m () setActions x = md x . modL core . setL actions -- | read the remaining actions of a track getActions :: STMOrIO m => Control Track -> m [Action] getActions x = (getL actions . getL core) `fmap` rd x -- | set a track priority setPriority :: STMOrIO m => Control Track -> Priority -> m () setPriority x = md x . modL core . setL priority -- | mute / unmute a track modMute :: STMOrIO m => Control Track -> m () modMute x = md x . modL core $ muted `modL` not -- | create and fork a running metronome. dummyMetronome :: MTime -- ^ time between ticks, in seconds -> IO (Control Metronome, TrackForker) -- ^ metronome control structure and a function to fork tracks dummyMetronome d = utcr >>= \t0 -> var (Thread True True $ Metronome [t0, t0 + d ..] []) >>= \m -> metronome m >>= \f -> return (m,f) -- | create and fork a stopped track by a metronome dummyTrack :: TrackForker -- ^ a track forking action from a metronome fork -> Frequency -- ^ ratio of track ticks and metronome ticks -> Priority -- ^ priority among the track peers -> [Action] -- ^ actions to be executed, each on a separate track tick -> IO (Control Track) -- ^ track control structure dummyTrack tf fr pr as = var (Thread False True $ Track 0 fr as pr False) >>= \t -> tf t >> return t