summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2015-12-03 06:29:29 -0500
committerAndrew Cady <d@jerkface.net>2015-12-03 06:44:13 -0500
commitb9bd6a28fddaf52c8a3a480bb5844b44742fce98 (patch)
tree460ec733105af60bc4382ca1e21d62fdf83e1744
parentc74a2049a1677293c67b49b8a23e0c53d8f47636 (diff)
cleaner
-rw-r--r--midi-dump.hs19
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
5import qualified Haskore.Basic.Pitch as Pitch 5import qualified Haskore.Basic.Pitch as Pitch
6import qualified Sound.ALSA.Sequencer.Event as Event 6import qualified Sound.ALSA.Sequencer.Event as Event
7import Control.Monad.RWS.Strict 7import Control.Monad.RWS.Strict
8import Data.Maybe
9import Data.List
8 10
9main = main' `AlsaExc.catch` handler 11main = 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
28loop = do 30loop = 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