Allow programming triads that do not include the triad's core notes

Right now this is accomplished via a pretty ugly solution that moves the
event forwarding for all events into the triad logic.

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
   h <- asks _h
   oldKeys <- gets _keysDown
   forwardNOW <- getMidiSender
-  (events, newKeys) <- liftIO $ parseAlsaEvents'' h oldKeys forwardNOW
+  (events, newKeys) <- liftIO $ parseAlsaEvents'' h oldKeys (const $ return ())
 
   when (oldKeys /= newKeys) $ do
     now <- gets _lastTick
@@ -428,9 +428,11 @@ processMidi = do
 
     whenFlag _printChordKeys $ liftIO $ printChordLn' newKeys
 
+    let sendKeys = liftIO (mapM_ forwardNOW events)
+
     triadRecording <- gets _triadRecording
     case triadRecording of
-      TriadNotRecording -> filterTriads newKeys
+      TriadNotRecording -> filterTriads newKeys >>= bool sendKeys (return ())
       AwaitingTriad -> do
         let detected = snd <$> listToMaybe (detectTriads newKeys)
         forM_ detected $ \t@(Triad _ p _) ->
@@ -445,8 +447,9 @@ processMidi = do
             pc = toPitchClass pitch
         let detected = triadPitch . snd <$> detectTriads newKeys
             detected :: [Event.Pitch]
-        if pitch `elem` detected then
+        if pitch `elem` detected then do
           modify $ \s -> s { _triadRecording = TriadNotRecording }
+          liftIO $ putStrLn "Recorded triad"
         else
           modify $ \s -> s { _triadMap = Map.insertWith Set.union (pc, ttype) (f newKeys) (_triadMap s) }
 
@@ -465,7 +468,7 @@ processMidi = do
 
     modify $ \s -> s { _replay = recordEvents (_replay s) newEvents }
 
-filterTriads :: MidiPitchMap -> MidiController ()
+filterTriads :: MidiPitchMap -> MidiController Bool
 filterTriads newKeys = do
   let newTriad = Set.fromList $ map snd $ detectTriads newKeys -- TODO: handle each channel
   oldTriad <- gets _triad
@@ -473,6 +476,7 @@ filterTriads newKeys = do
     forM_ (Set.difference oldTriad newTriad) $ triadOff >>> sendTriadEvents
     forM_ (Set.difference newTriad oldTriad) sendTriadEvents
     modify $ \s -> s { _triad = newTriad }
+  return $ not $ Set.null newTriad
 
 triadOff :: Triad -> Triad
 triadOff (Triad t p _) = Triad t p (Event.Velocity 0)
@@ -480,12 +484,13 @@ triadOff (Triad t p _) = Triad t p (Event.Velocity 0)
 sendTriadEvents :: Triad -> MidiController ()
 sendTriadEvents t@(Triad ttype (Event.Pitch base) vel) = do
   mappedNotes <- Map.lookup (tonic t, ttype) <$> gets _triadMap
-  when (isJust mappedNotes) $ notesOn $ notes (map fromIntegral . Set.toList <$> mappedNotes)
+  notesOn $ notes (map fromIntegral . Set.toList <$> mappedNotes)
 
   where
     notesOn n = forM_ n (delayNoteEv (TimeSpec 0 0))
     notes :: Maybe [Word8] -> [Event.Data]
-    notes mappedNotes = fromVel vel <$> map (base +) (fromMaybe [12, -12, 7+12, 7-12] mappedNotes)
+    notes mappedNotes = fromVel vel <$> map (base +) (fromMaybe [0, third, 7, 12, -12, 7+12, 7-12] mappedNotes)
+    third = if ttype == Major then 4 else 3
     fromVel (Event.Velocity 0) pitch = Event.NoteEv Event.NoteOff $ Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) (Event.Velocity 0)
     fromVel v pitch = Event.NoteEv Event.NoteOn $ Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) v