diff options
author | Andrew Cady <d@jerkface.net> | 2015-12-03 05:35:10 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2015-12-03 05:35:10 -0500 |
commit | 3618430364b04d4283a8e01590cae5476255fc30 (patch) | |
tree | abe8bb46c75b4f188d783f7c892861c781060975 /midi-dump.hs | |
parent | 6b1f45968645c12a31a750e7c1e428ca44ab4172 (diff) |
store midi event history in a simple list
Diffstat (limited to 'midi-dump.hs')
-rw-r--r-- | midi-dump.hs | 22 |
1 files changed, 14 insertions, 8 deletions
diff --git a/midi-dump.hs b/midi-dump.hs index 0f714ed..a5a3d9c 100644 --- a/midi-dump.hs +++ b/midi-dump.hs | |||
@@ -2,26 +2,32 @@ import AlsaSeq | |||
2 | import Control.Concurrent (threadDelay) | 2 | import Control.Concurrent (threadDelay) |
3 | import qualified Sound.ALSA.Exception as AlsaExc | 3 | import qualified Sound.ALSA.Exception as AlsaExc |
4 | import qualified Data.Set as Set | 4 | import qualified Data.Set as Set |
5 | import qualified Haskore.Basic.Pitch as Pitch | ||
6 | import qualified Sound.ALSA.Sequencer.Event as Event | ||
5 | 7 | ||
6 | main = main' `AlsaExc.catch` handler | 8 | main = main' `AlsaExc.catch` handler |
7 | where | 9 | where |
8 | handler e = putStrLn $ "alsa_exception: " ++ AlsaExc.show e | 10 | handler e = putStrLn $ "alsa_exception: " ++ AlsaExc.show e |
9 | 11 | ||
12 | data State = State { | ||
13 | keysDown :: MidiPitchSet, | ||
14 | inputHistory :: [Maybe Event.T] | ||
15 | } | ||
16 | |||
10 | main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do | 17 | main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do |
11 | cmdlineAlsaConnect h public | 18 | cmdlineAlsaConnect h public |
12 | 19 | ||
13 | let | 20 | let |
14 | forwardNOW = forwardNoteEvent h q publicAddr | 21 | forwardNOW = forwardNoteEvent h q publicAddr |
15 | go keysDown = do | 22 | go state = do |
16 | keysDown' <- parseAlsaEvents h keysDown (\ev -> do forwardNOW ev; hook ev) | 23 | (events, keysDown') <- parseAlsaEvents' h (keysDown state) forwardNOW |
17 | if (keysDown == keysDown') then | 24 | if ((keysDown state) == keysDown') then |
18 | threadDelay 15000 -- 15ms. Seems like a lot, but it sounds OK. Cuts CPU down to 2%. | 25 | threadDelay 15000 -- 15ms. Seems like a lot, but it sounds OK. Cuts CPU down to 2%. |
19 | else do | 26 | else do |
27 | let newHistory = if (Set.null $ keysDown state) then Nothing:newEvents else newEvents | ||
28 | newEvents = map Just events | ||
20 | printChordLn keysDown' | 29 | printChordLn keysDown' |
21 | go keysDown' | 30 | go (state { keysDown = keysDown', inputHistory = newHistory ++ inputHistory state }) |
22 | 31 | ||
23 | putStrLn "Rock on!" | 32 | putStrLn "Rock on!" |
24 | go Set.empty | 33 | go (State Set.empty []) |
25 | |||
26 | hook :: MidiHook | ||
27 | hook ev = return () | ||