get ready to recognize midi channels

2 files changed, 14 insertions, 5 deletions

diff --git a/AlsaSeq.hs b/AlsaSeq.hs
index d6e3816..a3905c8 100644
--- a/AlsaSeq.hs
+++ b/AlsaSeq.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE NondecreasingIndentation #-}
-module AlsaSeq (withAlsaInit, parseAlsaEvents, forwardNoteEvent, cmdlineAlsaConnect, printChordLn, showChord, pitchList, showPitch) where
+module AlsaSeq (withAlsaInit, parseAlsaEvents, forwardNoteEvent, cmdlineAlsaConnect, printChordLn, showChord, pitchList, showPitch, unPitch) where
 import qualified Sound.ALSA.Exception as AlsaExc
 import qualified Sound.ALSA.Sequencer.Address as Addr
 import qualified Sound.ALSA.Sequencer as SndSeq
@@ -26,6 +26,8 @@ import Haskore.Basic.Pitch
 import Foreign.C.Error (Errno(Errno))
 import Control.Exception.Base (try)
 
+unPitch = Event.unPitch
+
 printChordLn set = printWords $ pitchWords set
 
 joinWords [] = ""
diff --git a/axis.hs b/axis.hs
index f7ec772..c14c0a7 100644
--- a/axis.hs
+++ b/axis.hs
@@ -68,6 +68,14 @@ drawKeys pitches videoSurface font axis_key_locations axis_key_size = do
 reallyEraseKeys = eraseKeys_ True
 eraseKeys = eraseKeys_ False
 
+smartDrawKeys really drawSet eraseSet videoSurface font axis_key_locations axis_key_size = do
+
+  let drawList  = map (\ (_, n) -> unPitch n) $ Set.toList drawSet
+  let eraseList = map (\ (_, n) -> unPitch n) $ Set.toList eraseSet
+
+  drawKeys           drawList videoSurface font axis_key_locations axis_key_size
+  eraseKeys_ really eraseList videoSurface font axis_key_locations axis_key_size
+
 eraseKeys_ really pitches videoSurface font axis_key_locations axis_key_size = do
 
   forM_ pitches $ \pitch -> do
@@ -133,11 +141,10 @@ main =
 --        let chord = show $ map (\i->elemIndices i pitchIndex) $ pitchList midiKeysDown'
 --        textBand videoSurface videoClipRect (SDL.Rect 0 70 0 70) font chord
           let ignoreThese = Set.intersection midiKeysDown' midiKeysDown
-          let drawThese = pitchList $ Set.difference midiKeysDown' ignoreThese
-          let eraseThese = pitchList $ Set.difference midiKeysDown ignoreThese
+          let drawThese = Set.difference midiKeysDown' ignoreThese
+          let eraseThese = Set.difference midiKeysDown ignoreThese
 
-          drawKeys  drawThese  videoSurface font axis_key_locations axis_key_size
-          eraseKeys eraseThese videoSurface font axis_key_locations axis_key_size
+          smartDrawKeys False drawThese eraseThese videoSurface font axis_key_locations axis_key_size
           return ()
 
         Control.Monad.when (keysDown' /= keysDown && keyDown SDL.SDLK_BACKSPACE keysDown') allKeysOFF