summaryrefslogtreecommitdiff
path: root/midi-dump.hs
diff options
context:
space:
mode:
Diffstat (limited to 'midi-dump.hs')
-rw-r--r--midi-dump.hs17
1 files changed, 10 insertions, 7 deletions
diff --git a/midi-dump.hs b/midi-dump.hs
index 4a403f4..24d0ef1 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -39,6 +39,9 @@ import Data.Time.LocalTime (utcToLocalZonedTime)
39import Data.Time.Clock.POSIX (posixSecondsToUTCTime) 39import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
40import Data.Time.Clock (picosecondsToDiffTime, UTCTime) 40import Data.Time.Clock (picosecondsToDiffTime, UTCTime)
41 41
42import qualified Data.Set as Set
43import Data.Set (Set)
44
42verbose :: Bool 45verbose :: Bool
43verbose = False 46verbose = False
44 47
@@ -47,14 +50,14 @@ main = main' `AlsaExc.catch` handler
47 where 50 where
48 handler e = when verbose $ putStrLn $ "alsa_exception: " ++ AlsaExc.show e 51 handler e = when verbose $ putStrLn $ "alsa_exception: " ++ AlsaExc.show e
49 52
50data TriadType = Major | Minor deriving (Show, Eq) 53data TriadType = Major | Minor deriving (Show, Eq, Ord)
51data Triad = Triad TriadType Event.Pitch Event.Velocity deriving (Show, Eq) 54data Triad = Triad TriadType Event.Pitch Event.Velocity deriving (Show, Eq, Ord)
52 55
53data LoopState = LoopState { 56data LoopState = LoopState {
54 _wantExit :: Bool, 57 _wantExit :: Bool,
55 _waitThreads :: [IO (Thread.Result ())], 58 _waitThreads :: [IO (Thread.Result ())],
56 _keysDown :: MidiPitchMap, 59 _keysDown :: MidiPitchMap,
57 _triad :: Maybe Triad, 60 _triad :: Set Triad,
58 _scheduled :: Q.Queue Event.Data, 61 _scheduled :: Q.Queue Event.Data,
59 _recording :: Recording, 62 _recording :: Recording,
60 _replay :: Recording, 63 _replay :: Recording,
@@ -62,7 +65,7 @@ data LoopState = LoopState {
62} 65}
63 66
64initializeState :: TimeSpec -> LoopState 67initializeState :: TimeSpec -> LoopState
65initializeState now = LoopState False [] Map.empty Nothing createQueue (StartRecording now) (StartRecording now) now 68initializeState now = LoopState False [] Map.empty Set.empty createQueue (StartRecording now) (StartRecording now) now
66 69
67data LoopEnv = LoopEnv { 70data LoopEnv = LoopEnv {
68 _saver :: Chan CompleteRecording, 71 _saver :: Chan CompleteRecording,
@@ -358,11 +361,11 @@ processMidi = do
358 361
359filterTriads :: MidiPitchMap -> MidiController () 362filterTriads :: MidiPitchMap -> MidiController ()
360filterTriads newKeys = do 363filterTriads newKeys = do
361 let newTriad = fmap snd $ listToMaybe $ detectTriads newKeys -- TODO: handle each channel 364 let newTriad = Set.fromList $ map snd $ detectTriads newKeys -- TODO: handle each channel
362 oldTriad <- gets _triad 365 oldTriad <- gets _triad
363 when (newTriad /= oldTriad) $ do 366 when (newTriad /= oldTriad) $ do
364 forM_ oldTriad $ triadOff >>> sendTriadEvents 367 forM_ (Set.difference oldTriad newTriad) $ triadOff >>> sendTriadEvents
365 forM_ newTriad sendTriadEvents 368 forM_ (Set.difference newTriad oldTriad) sendTriadEvents
366 modify $ \s -> s { _triad = newTriad } 369 modify $ \s -> s { _triad = newTriad }
367 370
368triadOff :: Triad -> Triad 371triadOff :: Triad -> Triad