1 {-# LANGUAGE MultiParamTypeClasses #-}
3 module RMCA.Global.Clock ( AbsBeat
12 import Control.Concurrent
15 import Data.ReactiveValue
20 -- The absolute beat is the beat number of the global clock, there are
21 -- 16 starting from 1.
27 -- The global system tempo beats every 16th note, each beat is tagged
28 -- with a beat number modulo sixteen. Each layer is then beating at
29 -- its own fraction, discarding the unecessary beats.
30 metronome :: SF Tempo (Event AbsBeat)
31 metronome = accumBy (\pb _ -> nextBeatNo maxAbsBeat pb) 1 <<<
32 repeatedlyS () <<^ (15*) <<^ (1/) <<^ fromIntegral
34 -- Tempo is the number of quarter notes per minute.
35 tempoToQNoteIvl :: Tempo -> DTime
36 tempoToQNoteIvl = (15/) . fromIntegral
38 type TickingClock = (CBMVar (), ThreadId)
40 -- Make a clock that will execute any IO when it updates.
41 mkClockGeneric :: IO () -> DTime -> IO TickingClock
42 mkClockGeneric io d = do
44 tid <- forkIO $ forever $ do
49 where dInt = floor $ d * 1000
51 -- Ticking clock in the IO monad, sending callbacks every t milliseconds.
52 mkClock :: DTime -> IO TickingClock
53 mkClock = mkClockGeneric (return ())
55 -- For debugging purposes.
56 mkClockDebug :: DTime -> IO TickingClock
57 mkClockDebug = mkClockGeneric (putStrLn "Ping !")
59 clockRV :: TickingClock -> ReactiveFieldRead IO ThreadId
60 clockRV (mvar, tid) = ReactiveFieldRead (return tid)
61 (installCallbackCBMVar mvar)
63 mkClockRV :: DTime -> IO (ReactiveFieldRead IO ThreadId)
64 mkClockRV d = clockRV <$> mkClock d
66 stopClock :: TickingClock -> IO ()
67 stopClock (_,t) = killThread t
69 -- | A clock that can be written to.
70 newtype TickableClock = TickableClock (CBMVar ())
72 tickClock :: TickableClock -> IO ()
73 tickClock (TickableClock cl) = writeCBMVar cl ()
75 newTickableClock :: IO TickableClock
76 newTickableClock = TickableClock <$> newCBMVar ()
78 instance ReactiveValueRead TickableClock () IO where
79 reactiveValueRead _ = return ()
80 reactiveValueOnCanRead (TickableClock tc) = installCallbackCBMVar tc