Make "triadFilter" handle multiple simultaneous triads

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)
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Data.Time.Clock (picosecondsToDiffTime, UTCTime)
 
+import qualified Data.Set as Set
+import Data.Set (Set)
+
 verbose :: Bool
 verbose = False
 
@@ -47,14 +50,14 @@ main = main' `AlsaExc.catch` handler
   where
   handler e = when verbose $ putStrLn $ "alsa_exception: " ++ AlsaExc.show e
 
-data TriadType = Major | Minor deriving (Show, Eq)
-data Triad = Triad TriadType Event.Pitch Event.Velocity deriving (Show, Eq)
+data TriadType = Major | Minor deriving (Show, Eq, Ord)
+data Triad = Triad TriadType Event.Pitch Event.Velocity deriving (Show, Eq, Ord)
 
 data LoopState = LoopState {
   _wantExit  :: Bool,
   _waitThreads :: [IO (Thread.Result ())],
   _keysDown  :: MidiPitchMap,
-  _triad     :: Maybe Triad,
+  _triad     :: Set Triad,
   _scheduled :: Q.Queue Event.Data,
   _recording :: Recording,
   _replay    :: Recording,
@@ -62,7 +65,7 @@ data LoopState = LoopState {
 }
 
 initializeState :: TimeSpec -> LoopState
-initializeState now = LoopState False [] Map.empty Nothing createQueue (StartRecording now) (StartRecording now) now
+initializeState now = LoopState False [] Map.empty Set.empty createQueue (StartRecording now) (StartRecording now) now
 
 data LoopEnv = LoopEnv {
   _saver         :: Chan CompleteRecording,
@@ -358,11 +361,11 @@ processMidi = do
 
 filterTriads :: MidiPitchMap -> MidiController ()
 filterTriads newKeys = do
-  let newTriad = fmap snd $ listToMaybe $ detectTriads newKeys -- TODO: handle each channel
+  let newTriad = Set.fromList $ map snd $ detectTriads newKeys -- TODO: handle each channel
   oldTriad <- gets _triad
   when (newTriad /= oldTriad) $ do
-    forM_ oldTriad $ triadOff >>> sendTriadEvents
-    forM_ newTriad sendTriadEvents
+    forM_ (Set.difference oldTriad newTriad) $ triadOff >>> sendTriadEvents
+    forM_ (Set.difference newTriad oldTriad) sendTriadEvents
     modify $ \s -> s { _triad = newTriad }
 
 triadOff :: Triad -> Triad