diff options
author | Andrew Cady <d@jerkface.net> | 2015-12-03 06:29:29 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2015-12-03 06:44:13 -0500 |
commit | b9bd6a28fddaf52c8a3a480bb5844b44742fce98 (patch) | |
tree | 460ec733105af60bc4382ca1e21d62fdf83e1744 /midi-dump.hs | |
parent | c74a2049a1677293c67b49b8a23e0c53d8f47636 (diff) |
cleaner
Diffstat (limited to 'midi-dump.hs')
-rw-r--r-- | midi-dump.hs | 19 |
1 files changed, 12 insertions, 7 deletions
diff --git a/midi-dump.hs b/midi-dump.hs index 1a331e8..7d6d238 100644 --- a/midi-dump.hs +++ b/midi-dump.hs | |||
@@ -5,6 +5,8 @@ import qualified Data.Set as Set | |||
5 | import qualified Haskore.Basic.Pitch as Pitch | 5 | import qualified Haskore.Basic.Pitch as Pitch |
6 | import qualified Sound.ALSA.Sequencer.Event as Event | 6 | import qualified Sound.ALSA.Sequencer.Event as Event |
7 | import Control.Monad.RWS.Strict | 7 | import Control.Monad.RWS.Strict |
8 | import Data.Maybe | ||
9 | import Data.List | ||
8 | 10 | ||
9 | main = main' `AlsaExc.catch` handler | 11 | main = main' `AlsaExc.catch` handler |
10 | where | 12 | where |
@@ -22,23 +24,26 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do | |||
22 | 24 | ||
23 | putStrLn "Rock on!" | 25 | putStrLn "Rock on!" |
24 | 26 | ||
25 | (s, ()) <- execRWST loop (h, public, private, q, publicAddr, privateAddr) emptyLoopState | 27 | (_, ()) <- execRWST loop (h, public, private, q, publicAddr, privateAddr) emptyLoopState |
26 | return () | 28 | return () |
27 | 29 | ||
28 | loop = do | 30 | loop = do |
29 | (h, public, private, q, publicAddr, privateAddr) <- ask | 31 | (h, _, _, q, publicAddr, _) <- ask |
30 | loopState <- get | ||
31 | oldKeys <- gets keysDown | 32 | oldKeys <- gets keysDown |
32 | let forwardNOW = forwardNoteEvent h q publicAddr | 33 | let forwardNOW = forwardNoteEvent h q publicAddr |
33 | |||
34 | (events, newKeys) <- liftIO $ parseAlsaEvents' h oldKeys forwardNOW | 34 | (events, newKeys) <- liftIO $ parseAlsaEvents' h oldKeys forwardNOW |
35 | 35 | ||
36 | if (oldKeys == newKeys) then | 36 | if (oldKeys == newKeys) then |
37 | liftIO $ threadDelay 15000 -- 15ms. Seems like a lot, but it sounds OK. Cuts CPU down to 2%. | 37 | liftIO $ threadDelay 15000 -- 15ms. Seems like a lot, but it sounds OK. Cuts CPU down to 2%. |
38 | else do | 38 | else do |
39 | let newHistory = if Set.null oldKeys then Nothing:newEvents else newEvents | 39 | let newEvents = map Just events |
40 | newEvents = map Just events | 40 | |
41 | liftIO $ printChordLn newKeys | 41 | liftIO $ printChordLn newKeys |
42 | put loopState { keysDown = newKeys, inputHistory = newHistory ++ inputHistory loopState } | 42 | modify $ \s -> s { keysDown = newKeys, inputHistory = newEvents ++ inputHistory s } |
43 | |||
44 | when (Set.null newKeys) $ do | ||
45 | hist <- gets (takeWhile isJust . inputHistory) | ||
46 | liftIO $ print hist | ||
47 | modify $ \s -> s { inputHistory = Nothing:inputHistory s } | ||
43 | 48 | ||
44 | loop | 49 | loop |