diff options
-rw-r--r-- | midi-dump.hs | 17 |
1 files changed, 11 insertions, 6 deletions
diff --git a/midi-dump.hs b/midi-dump.hs index 7b7bf8b..cca4e5c 100644 --- a/midi-dump.hs +++ b/midi-dump.hs | |||
@@ -418,7 +418,7 @@ processMidi = do | |||
418 | h <- asks _h | 418 | h <- asks _h |
419 | oldKeys <- gets _keysDown | 419 | oldKeys <- gets _keysDown |
420 | forwardNOW <- getMidiSender | 420 | forwardNOW <- getMidiSender |
421 | (events, newKeys) <- liftIO $ parseAlsaEvents'' h oldKeys forwardNOW | 421 | (events, newKeys) <- liftIO $ parseAlsaEvents'' h oldKeys (const $ return ()) |
422 | 422 | ||
423 | when (oldKeys /= newKeys) $ do | 423 | when (oldKeys /= newKeys) $ do |
424 | now <- gets _lastTick | 424 | now <- gets _lastTick |
@@ -428,9 +428,11 @@ processMidi = do | |||
428 | 428 | ||
429 | whenFlag _printChordKeys $ liftIO $ printChordLn' newKeys | 429 | whenFlag _printChordKeys $ liftIO $ printChordLn' newKeys |
430 | 430 | ||
431 | let sendKeys = liftIO (mapM_ forwardNOW events) | ||
432 | |||
431 | triadRecording <- gets _triadRecording | 433 | triadRecording <- gets _triadRecording |
432 | case triadRecording of | 434 | case triadRecording of |
433 | TriadNotRecording -> filterTriads newKeys | 435 | TriadNotRecording -> filterTriads newKeys >>= bool sendKeys (return ()) |
434 | AwaitingTriad -> do | 436 | AwaitingTriad -> do |
435 | let detected = snd <$> listToMaybe (detectTriads newKeys) | 437 | let detected = snd <$> listToMaybe (detectTriads newKeys) |
436 | forM_ detected $ \t@(Triad _ p _) -> | 438 | forM_ detected $ \t@(Triad _ p _) -> |
@@ -445,8 +447,9 @@ processMidi = do | |||
445 | pc = toPitchClass pitch | 447 | pc = toPitchClass pitch |
446 | let detected = triadPitch . snd <$> detectTriads newKeys | 448 | let detected = triadPitch . snd <$> detectTriads newKeys |
447 | detected :: [Event.Pitch] | 449 | detected :: [Event.Pitch] |
448 | if pitch `elem` detected then | 450 | if pitch `elem` detected then do |
449 | modify $ \s -> s { _triadRecording = TriadNotRecording } | 451 | modify $ \s -> s { _triadRecording = TriadNotRecording } |
452 | liftIO $ putStrLn "Recorded triad" | ||
450 | else | 453 | else |
451 | modify $ \s -> s { _triadMap = Map.insertWith Set.union (pc, ttype) (f newKeys) (_triadMap s) } | 454 | modify $ \s -> s { _triadMap = Map.insertWith Set.union (pc, ttype) (f newKeys) (_triadMap s) } |
452 | 455 | ||
@@ -465,7 +468,7 @@ processMidi = do | |||
465 | 468 | ||
466 | modify $ \s -> s { _replay = recordEvents (_replay s) newEvents } | 469 | modify $ \s -> s { _replay = recordEvents (_replay s) newEvents } |
467 | 470 | ||
468 | filterTriads :: MidiPitchMap -> MidiController () | 471 | filterTriads :: MidiPitchMap -> MidiController Bool |
469 | filterTriads newKeys = do | 472 | filterTriads newKeys = do |
470 | let newTriad = Set.fromList $ map snd $ detectTriads newKeys -- TODO: handle each channel | 473 | let newTriad = Set.fromList $ map snd $ detectTriads newKeys -- TODO: handle each channel |
471 | oldTriad <- gets _triad | 474 | oldTriad <- gets _triad |
@@ -473,6 +476,7 @@ filterTriads newKeys = do | |||
473 | forM_ (Set.difference oldTriad newTriad) $ triadOff >>> sendTriadEvents | 476 | forM_ (Set.difference oldTriad newTriad) $ triadOff >>> sendTriadEvents |
474 | forM_ (Set.difference newTriad oldTriad) sendTriadEvents | 477 | forM_ (Set.difference newTriad oldTriad) sendTriadEvents |
475 | modify $ \s -> s { _triad = newTriad } | 478 | modify $ \s -> s { _triad = newTriad } |
479 | return $ not $ Set.null newTriad | ||
476 | 480 | ||
477 | triadOff :: Triad -> Triad | 481 | triadOff :: Triad -> Triad |
478 | triadOff (Triad t p _) = Triad t p (Event.Velocity 0) | 482 | triadOff (Triad t p _) = Triad t p (Event.Velocity 0) |
@@ -480,12 +484,13 @@ triadOff (Triad t p _) = Triad t p (Event.Velocity 0) | |||
480 | sendTriadEvents :: Triad -> MidiController () | 484 | sendTriadEvents :: Triad -> MidiController () |
481 | sendTriadEvents t@(Triad ttype (Event.Pitch base) vel) = do | 485 | sendTriadEvents t@(Triad ttype (Event.Pitch base) vel) = do |
482 | mappedNotes <- Map.lookup (tonic t, ttype) <$> gets _triadMap | 486 | mappedNotes <- Map.lookup (tonic t, ttype) <$> gets _triadMap |
483 | when (isJust mappedNotes) $ notesOn $ notes (map fromIntegral . Set.toList <$> mappedNotes) | 487 | notesOn $ notes (map fromIntegral . Set.toList <$> mappedNotes) |
484 | 488 | ||
485 | where | 489 | where |
486 | notesOn n = forM_ n (delayNoteEv (TimeSpec 0 0)) | 490 | notesOn n = forM_ n (delayNoteEv (TimeSpec 0 0)) |
487 | notes :: Maybe [Word8] -> [Event.Data] | 491 | notes :: Maybe [Word8] -> [Event.Data] |
488 | notes mappedNotes = fromVel vel <$> map (base +) (fromMaybe [12, -12, 7+12, 7-12] mappedNotes) | 492 | notes mappedNotes = fromVel vel <$> map (base +) (fromMaybe [0, third, 7, 12, -12, 7+12, 7-12] mappedNotes) |
493 | third = if ttype == Major then 4 else 3 | ||
489 | fromVel (Event.Velocity 0) pitch = Event.NoteEv Event.NoteOff $ Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) (Event.Velocity 0) | 494 | fromVel (Event.Velocity 0) pitch = Event.NoteEv Event.NoteOff $ Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) (Event.Velocity 0) |
490 | fromVel v pitch = Event.NoteEv Event.NoteOn $ Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) v | 495 | fromVel v pitch = Event.NoteEv Event.NoteOn $ Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) v |
491 | 496 | ||