1 files changed, 22 insertions, 20 deletions

diff --git a/midi-dump.hs b/midi-dump.hs
index 52fe6b2..6c2c8b8 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -8,7 +8,7 @@ import           AlsaSeq
 import           Control.Monad.RWS.Strict
 import           Data.List
 import           Data.Maybe
-import qualified Data.Set                       as Set
+import qualified Data.Map.Strict                as Map
 import qualified Sound.ALSA.Exception           as AlsaExc
 import qualified Sound.ALSA.Sequencer.Event     as Event
 import           System.Clock
@@ -43,7 +43,7 @@ data Triad = Major Event.Pitch | Minor Event.Pitch deriving (Show, Eq)
 
 data LoopState = LoopState {
   _wantExit  :: Bool,
-  _keysDown  :: MidiPitchSet,
+  _keysDown  :: MidiPitchMap,
   _triad     :: Maybe Triad,
   _scheduled :: Q.Queue Event.Data,
   _recording :: Recording,
@@ -52,7 +52,7 @@ data LoopState = LoopState {
 }
 
 initializeState :: TimeSpec -> LoopState
-initializeState now = LoopState False Set.empty Nothing createQueue (StartRecording now) (StartRecording now) now
+initializeState now = LoopState False Map.empty Nothing createQueue (StartRecording now) (StartRecording now) now
 
 data LoopEnv = LoopEnv {
   _saver         :: Chan CompleteRecording,
@@ -233,7 +233,7 @@ processMidi = do
   h <- asks _h
   oldKeys <- gets _keysDown
   forwardNOW <- getMidiSender
-  (events, newKeys) <- liftIO $ parseAlsaEvents' h oldKeys forwardNOW
+  (events, newKeys) <- liftIO $ parseAlsaEvents'' h oldKeys forwardNOW
 
 
   if oldKeys == newKeys
@@ -249,18 +249,18 @@ processMidi = do
           , _lastTick = now
           }
 
-      whenFlag _printChordKeys $ liftIO $ printChordLn newKeys
+      whenFlag _printChordKeys $ liftIO $ printChordLn' newKeys
 
       filterTriads newKeys
 
       -- Whenever no keys are pressed, flush any buffered events to the database
-      when (Set.null newKeys) $ do
+      when (Map.null newKeys) $ do
         doSave <- asks _doSave
         when doSave $ gets _recording >>= saveMidi >> return ()
         modify $ \s -> s { _recording = StartRecording now }
 
       -- When a key is pressed after 3+ seconds of silence, overwrite the replay buffer with the new keys
-      when (Set.null oldKeys) $ do
+      when (Map.null oldKeys) $ do
         replay <- gets _replay
         when (latestEvent replay < (now - TimeSpec 3 0)) $ do
           modify $ \s -> s { _replay = StartRecording now }
@@ -268,13 +268,14 @@ processMidi = do
 
       modify $ \s -> s { _replay = recordEvents (_replay s) newEvents }
 
-filterTriads :: MidiPitchSet -> MidiController ()
+filterTriads :: MidiPitchMap -> MidiController ()
 filterTriads newKeys = do
   let newTriad = detectTriad newKeys
+      vel = Event.Velocity 128
   oldTriad <- gets _triad
   when (newTriad /= oldTriad) $ do
-    forM_ oldTriad (sendTriadEvents False)
-    forM_ newTriad (sendTriadEvents True)
+    forM_ oldTriad (sendTriadEvents Nothing)
+    forM_ newTriad (sendTriadEvents $ Just vel)
     modify $ \s -> s { _triad = newTriad }
 
 triadBase :: Triad -> Event.Pitch
@@ -282,26 +283,27 @@ triadBase (Major n) = n
 triadBase (Minor n) = n
 
 -- TODO: set velocity based on average from triad (this requires storing that
--- information, changing the MidiPitchSet type for one more complex than a mere
+-- information, changing the MidiPitchMap type for one more complex than a mere
 -- Set)
-sendTriadEvents :: Bool -> Triad -> MidiController ()
-sendTriadEvents sendOn triad = do
+sendTriadEvents :: Maybe Event.Velocity -> Triad -> MidiController ()
+sendTriadEvents vel triad = do
   forM_ notes (delayNoteEv (TimeSpec 0 0))
   return ()
 
   where
-    onoff = bool Event.NoteOff Event.NoteOn sendOn
     base = Event.unPitch $ triadBase triad
-    notes = (Event.NoteEv onoff . mkNote) <$> fill base
+    notes = fromVel vel <$> fill base
     fill n = [ x + y | x <- [n, n + 7], y <- [12, -12]]
+    fromVel (Just v) pitch = Event.NoteEv Event.NoteOn $ Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) v
+    fromVel Nothing pitch = Event.NoteEv Event.NoteOff $ Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) (Event.Velocity 0)
 
-detectTriad :: MidiPitchSet -> Maybe Triad
-detectTriad pitches = listToMaybe $ concatMap f pitches
+detectTriad :: MidiPitchMap -> Maybe Triad
+detectTriad pitches = listToMaybe $ concatMap f (Map.keys pitches)
   where
     f pitch
-      | not $ Set.member (addPitch 7 pitch) pitches = []
-      | Set.member (addPitch 4 pitch) pitches = [Major $ snd pitch] -- TODO: do not just drop the channel!!
-      | Set.member (addPitch 3 pitch) pitches = [Minor $ snd pitch]
+      | not $ Map.member (addPitch 7 pitch) pitches = []
+      | Map.member (addPitch 4 pitch) pitches = [Major $ snd pitch] -- TODO: do not just drop the channel!!
+      | Map.member (addPitch 3 pitch) pitches = [Minor $ snd pitch]
       | otherwise = []
     addPitch n (c, Event.Pitch p) = (c, Event.Pitch $ p+n)