diff options
Diffstat (limited to 'midi-dump.hs')
-rw-r--r-- | midi-dump.hs | 17 |
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) | |||
39 | import Data.Time.Clock.POSIX (posixSecondsToUTCTime) | 39 | import Data.Time.Clock.POSIX (posixSecondsToUTCTime) |
40 | import Data.Time.Clock (picosecondsToDiffTime, UTCTime) | 40 | import Data.Time.Clock (picosecondsToDiffTime, UTCTime) |
41 | 41 | ||
42 | import qualified Data.Set as Set | ||
43 | import Data.Set (Set) | ||
44 | |||
42 | verbose :: Bool | 45 | verbose :: Bool |
43 | verbose = False | 46 | verbose = 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 | ||
50 | data TriadType = Major | Minor deriving (Show, Eq) | 53 | data TriadType = Major | Minor deriving (Show, Eq, Ord) |
51 | data Triad = Triad TriadType Event.Pitch Event.Velocity deriving (Show, Eq) | 54 | data Triad = Triad TriadType Event.Pitch Event.Velocity deriving (Show, Eq, Ord) |
52 | 55 | ||
53 | data LoopState = LoopState { | 56 | data 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 | ||
64 | initializeState :: TimeSpec -> LoopState | 67 | initializeState :: TimeSpec -> LoopState |
65 | initializeState now = LoopState False [] Map.empty Nothing createQueue (StartRecording now) (StartRecording now) now | 68 | initializeState now = LoopState False [] Map.empty Set.empty createQueue (StartRecording now) (StartRecording now) now |
66 | 69 | ||
67 | data LoopEnv = LoopEnv { | 70 | data LoopEnv = LoopEnv { |
68 | _saver :: Chan CompleteRecording, | 71 | _saver :: Chan CompleteRecording, |
@@ -358,11 +361,11 @@ processMidi = do | |||
358 | 361 | ||
359 | filterTriads :: MidiPitchMap -> MidiController () | 362 | filterTriads :: MidiPitchMap -> MidiController () |
360 | filterTriads newKeys = do | 363 | filterTriads 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 | ||
368 | triadOff :: Triad -> Triad | 371 | triadOff :: Triad -> Triad |