diff options
author | Andrew Cady <d@jerkface.net> | 2015-12-03 06:59:16 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2015-12-03 06:59:16 -0500 |
commit | 9d8e1b9b82c1a905a0014fd5b9c5d08f7ce347f0 (patch) | |
tree | 56b153e33b8ee6b6b763ff08d54e8202869e3fed /midi-dump.hs | |
parent | b9bd6a28fddaf52c8a3a480bb5844b44742fce98 (diff) |
keep track of time
Diffstat (limited to 'midi-dump.hs')
-rw-r--r-- | midi-dump.hs | 13 |
1 files changed, 10 insertions, 3 deletions
diff --git a/midi-dump.hs b/midi-dump.hs index 7d6d238..b345531 100644 --- a/midi-dump.hs +++ b/midi-dump.hs | |||
@@ -7,6 +7,7 @@ import qualified Sound.ALSA.Sequencer.Event as Event | |||
7 | import Control.Monad.RWS.Strict | 7 | import Control.Monad.RWS.Strict |
8 | import Data.Maybe | 8 | import Data.Maybe |
9 | import Data.List | 9 | import Data.List |
10 | import System.Clock | ||
10 | 11 | ||
11 | main = main' `AlsaExc.catch` handler | 12 | main = main' `AlsaExc.catch` handler |
12 | where | 13 | where |
@@ -14,7 +15,8 @@ main = main' `AlsaExc.catch` handler | |||
14 | 15 | ||
15 | data LoopState = LoopState { | 16 | data LoopState = LoopState { |
16 | keysDown :: MidiPitchSet, | 17 | keysDown :: MidiPitchSet, |
17 | inputHistory :: [Maybe Event.T] | 18 | inputHistory :: [Maybe Event.T], |
19 | lastTick :: TimeSpec | ||
18 | } | 20 | } |
19 | 21 | ||
20 | emptyLoopState = LoopState Set.empty [] | 22 | emptyLoopState = LoopState Set.empty [] |
@@ -23,12 +25,14 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do | |||
23 | cmdlineAlsaConnect h public | 25 | cmdlineAlsaConnect h public |
24 | 26 | ||
25 | putStrLn "Rock on!" | 27 | putStrLn "Rock on!" |
28 | startTime <- getTime Monotonic | ||
26 | 29 | ||
27 | (_, ()) <- execRWST loop (h, public, private, q, publicAddr, privateAddr) emptyLoopState | 30 | (_, ()) <- execRWST loop (startTime, h, public, private, q, publicAddr, privateAddr) (emptyLoopState startTime) |
28 | return () | 31 | return () |
29 | 32 | ||
30 | loop = do | 33 | loop = do |
31 | (h, _, _, q, publicAddr, _) <- ask | 34 | (startTime, h, _, _, q, publicAddr, _) <- ask |
35 | |||
32 | oldKeys <- gets keysDown | 36 | oldKeys <- gets keysDown |
33 | let forwardNOW = forwardNoteEvent h q publicAddr | 37 | let forwardNOW = forwardNoteEvent h q publicAddr |
34 | (events, newKeys) <- liftIO $ parseAlsaEvents' h oldKeys forwardNOW | 38 | (events, newKeys) <- liftIO $ parseAlsaEvents' h oldKeys forwardNOW |
@@ -36,6 +40,8 @@ loop = do | |||
36 | if (oldKeys == newKeys) then | 40 | if (oldKeys == newKeys) then |
37 | liftIO $ threadDelay 15000 -- 15ms. Seems like a lot, but it sounds OK. Cuts CPU down to 2%. | 41 | liftIO $ threadDelay 15000 -- 15ms. Seems like a lot, but it sounds OK. Cuts CPU down to 2%. |
38 | else do | 42 | else do |
43 | now <- liftIO $ getTime Monotonic | ||
44 | let delta = now - startTime | ||
39 | let newEvents = map Just events | 45 | let newEvents = map Just events |
40 | 46 | ||
41 | liftIO $ printChordLn newKeys | 47 | liftIO $ printChordLn newKeys |
@@ -46,4 +52,5 @@ loop = do | |||
46 | liftIO $ print hist | 52 | liftIO $ print hist |
47 | modify $ \s -> s { inputHistory = Nothing:inputHistory s } | 53 | modify $ \s -> s { inputHistory = Nothing:inputHistory s } |
48 | 54 | ||
55 | modify $ \s -> s { lastTick = now } | ||
49 | loop | 56 | loop |