1 module RMCA.Global.Clock where
3 import Control.Concurrent
6 import Data.ReactiveValue
11 -- The absolute beat is the beat number of the global clock, there are
12 -- 16 starting from 1.
18 -- The global system tempo beats every 16th note, each beat is tagged
19 -- with a beat number modulo sixteen. Each layer is then beating at
20 -- its own fraction, discarding the unecessary beats.
21 metronome :: SF Tempo (Event AbsBeat)
22 metronome = accumBy (\pb _ -> nextBeatNo maxAbsBeat pb) 1 <<<
23 repeatedlyS () <<^ (/4) <<^ tempoToQNoteIvl
25 -- Tempo is the number of quarter notes per minute.
26 tempoToQNoteIvl :: Tempo -> DTime
27 tempoToQNoteIvl = (15/) . fromIntegral
29 type TickingClock = (CBMVar (), ThreadId)
31 -- Make a clock that will execute any IO when it updates.
32 mkClockGeneric :: IO () -> DTime -> IO TickingClock
33 mkClockGeneric io d = do
35 tid <- forkIO $ forever $ do
40 where dInt = floor $ d * 1000
42 -- Ticking clock in the IO monad, sending callbacks every t milliseconds.
43 mkClock :: DTime -> IO TickingClock
44 mkClock = mkClockGeneric (return ())
46 -- For debugging purposes.
47 mkClockDebug :: DTime -> IO TickingClock
48 mkClockDebug = mkClockGeneric (putStrLn "Ping !")
50 clockRV :: TickingClock -> ReactiveFieldRead IO ThreadId
51 clockRV (mvar, tid) = ReactiveFieldRead (return tid)
52 (installCallbackCBMVar mvar)
54 mkClockRV :: DTime -> IO (ReactiveFieldRead IO ThreadId)
55 mkClockRV d = clockRV <$> mkClock d
57 stopClock :: TickingClock -> IO ()
58 stopClock (_,t) = killThread t