summaryrefslogtreecommitdiff
path: root/midi-dump.hs
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2015-12-03 06:59:16 -0500
committerAndrew Cady <d@jerkface.net>2015-12-03 06:59:16 -0500
commit9d8e1b9b82c1a905a0014fd5b9c5d08f7ce347f0 (patch)
tree56b153e33b8ee6b6b763ff08d54e8202869e3fed /midi-dump.hs
parentb9bd6a28fddaf52c8a3a480bb5844b44742fce98 (diff)
keep track of time
Diffstat (limited to 'midi-dump.hs')
-rw-r--r--midi-dump.hs13
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
7import Control.Monad.RWS.Strict 7import Control.Monad.RWS.Strict
8import Data.Maybe 8import Data.Maybe
9import Data.List 9import Data.List
10import System.Clock
10 11
11main = main' `AlsaExc.catch` handler 12main = main' `AlsaExc.catch` handler
12 where 13 where
@@ -14,7 +15,8 @@ main = main' `AlsaExc.catch` handler
14 15
15data LoopState = LoopState { 16data 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
20emptyLoopState = LoopState Set.empty [] 22emptyLoopState = 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
30loop = do 33loop = 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