diff options
author | Andrew Cady <d@jerkface.net> | 2015-12-03 20:37:33 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2015-12-03 20:55:45 -0500 |
commit | 0eb9c9ae700704332a088c394159889ecedac6e0 (patch) | |
tree | 83d4841e5280315a58ed5121c52831792b414044 /midi-dump.hs | |
parent | 80c9f83af0885969967bec2540362ed8ba89447f (diff) |
use real clock time (adjusted from the monotonic clock)
Diffstat (limited to 'midi-dump.hs')
-rw-r--r-- | midi-dump.hs | 17 |
1 files changed, 12 insertions, 5 deletions
diff --git a/midi-dump.hs b/midi-dump.hs index c7cd5e1..69f8480 100644 --- a/midi-dump.hs +++ b/midi-dump.hs | |||
@@ -30,6 +30,12 @@ data LoopState = LoopState { | |||
30 | lastTick :: TimeSpec | 30 | lastTick :: TimeSpec |
31 | } | 31 | } |
32 | 32 | ||
33 | getAbsTime = do | ||
34 | (startTime, startTimeReal, _, _, _, _, _, _) <- ask | ||
35 | now <- liftIO $ getTime Monotonic | ||
36 | return $ now - startTime + startTimeReal | ||
37 | |||
38 | |||
33 | emptyLoopState = LoopState Set.empty [] | 39 | emptyLoopState = LoopState Set.empty [] |
34 | 40 | ||
35 | main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do | 41 | main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do |
@@ -37,12 +43,13 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do | |||
37 | 43 | ||
38 | putStrLn "Rock on!" | 44 | putStrLn "Rock on!" |
39 | startTime <- getTime Monotonic | 45 | startTime <- getTime Monotonic |
46 | startTimeReal <- getTime Realtime | ||
40 | 47 | ||
41 | (_, ()) <- execRWST loop (startTime, h, public, private, q, publicAddr, privateAddr) (emptyLoopState startTime) | 48 | (_, ()) <- execRWST loop (startTime, startTimeReal, h, public, private, q, publicAddr, privateAddr) (emptyLoopState startTime) |
42 | return () | 49 | return () |
43 | 50 | ||
44 | loop = do | 51 | loop = do |
45 | (startTime, h, _, _, q, publicAddr, _) <- ask | 52 | (startTime, startTimeReal, h, _, _, q, publicAddr, _) <- ask |
46 | 53 | ||
47 | oldKeys <- gets keysDown | 54 | oldKeys <- gets keysDown |
48 | let forwardNOW = forwardNoteEvent h q publicAddr | 55 | let forwardNOW = forwardNoteEvent h q publicAddr |
@@ -51,15 +58,15 @@ loop = do | |||
51 | if (oldKeys == newKeys) then | 58 | if (oldKeys == newKeys) then |
52 | liftIO $ threadDelay 15000 -- 15ms. Seems like a lot, but it sounds OK. Cuts CPU down to 2%. | 59 | liftIO $ threadDelay 15000 -- 15ms. Seems like a lot, but it sounds OK. Cuts CPU down to 2%. |
53 | else do | 60 | else do |
54 | now <- liftIO $ getTime Monotonic | 61 | now <- getAbsTime |
55 | let delta = now - startTime | ||
56 | let newEvents = map (MidiEvent now) events | 62 | let newEvents = map (MidiEvent now) events |
57 | 63 | ||
58 | liftIO $ printChordLn newKeys | 64 | liftIO $ printChordLn newKeys |
59 | modify $ \s -> s { keysDown = newKeys, inputHistory = newEvents ++ inputHistory s } | 65 | modify $ \s -> s { keysDown = newKeys, inputHistory = newEvents ++ inputHistory s } |
60 | 66 | ||
61 | when (Set.null newKeys) $ do | 67 | when (Set.null newKeys) $ do |
62 | hist <- gets $ takeWhile (not . isSilence) . inputHistory | 68 | -- hist <- gets $ takeWhile (not . isSilence) . inputHistory |
69 | hist <- gets $ filter (not . isSilence) . inputHistory | ||
63 | liftIO $ print $ map (`div` 1000000) $ tsDeltas $ map getTS $ reverse hist | 70 | liftIO $ print $ map (`div` 1000000) $ tsDeltas $ map getTS $ reverse hist |
64 | liftIO $ print $ mapMaybe getMidiDesc $ reverse hist | 71 | liftIO $ print $ mapMaybe getMidiDesc $ reverse hist |
65 | modify $ \s -> s { inputHistory = Silence now:inputHistory s } | 72 | modify $ \s -> s { inputHistory = Silence now:inputHistory s } |