change smartDrawKeys interface

1 files changed, 29 insertions, 19 deletions

diff --git a/axis.hs b/axis.hs
index 29ecec8..768e4fa 100644
--- a/axis.hs
+++ b/axis.hs
@@ -116,30 +116,37 @@ pitchToColor p =
     _ -> _CGA !! 8
 
 smartDrawKeys' :: (Integral a, Integral a2, Integral a1) => Bool -> Set.Set (Event.Channel, Event.Pitch) -> Set.Set (Event.Channel, Event.Pitch) -> SDL.Surface -> SDL.TTF.Font -> [(a1, a2)] -> a -> IO ()
-smartDrawKeys' reallyErase drawSet eraseSet videoSurface font axis_key_locations axis_key_size = do
+smartDrawKeys' reallyErase oldKeys nowKeys videoSurface font axis_key_locations axis_key_size = do
   let
+      ignoreThese = Set.intersection nowKeys oldKeys
+      drawThese = Set.difference nowKeys ignoreThese
+      eraseThese = Set.difference oldKeys ignoreThese
+      drawSet = Set.difference nowKeys ignoreThese
+      eraseSet = Set.difference oldKeys ignoreThese
+
       changroup = groupBy (\(_, n1) (_, n2) -> n1 == n2)
       chanfilter = filter (\ (c, _) -> unChannel c /= 9)
       drawList  = changroup . chanfilter $ Set.toList drawSet
       eraseList = changroup . chanfilter $ Set.toList eraseSet
 
+
   forM_ [(eraseList, True), (drawList, False)] $ \ (ls, erase) -> do
     forM_ ls $ \ls' -> do
       let chans = map (\ (c, _) -> unChannel c) ls'
           (_, n) = head ls'
           text = smartShowPitch (unPitch n)
-          pitch = if _OCTAVE_SQUASH then (unPitch n) `mod` 12 + 12 * 6 else (unPitch n)
+          pitch = if _OCTAVE_SQUASH then unPitch n `mod` 12 + 12 * 6 else unPitch n
           onColor = _KEY_ON_COLOR
           offColor = pitchToColor pitch
       forM_ (elemIndices pitch pitchIndex) $ \idx -> do
-        drawKey' idx videoSurface font axis_key_locations axis_key_size
+        drawKey idx videoSurface font axis_key_locations axis_key_size
           offColor
           (if reallyErase then _KB_BG_COLOR_PIXEL else _KEY_BORDER_COLOR_PIXEL)
           (if erase then Nothing else (Just text))
           (if erase then [] else (map fromIntegral chans))
 
-drawKey' :: (Integral a1, Integral a2, Integral a) => Int -> SDL.Surface -> SDL.TTF.Font -> [(a1, a2)] -> a -> SDL.Color -> t -> Maybe String -> [Int] -> IO ()
-drawKey' idx videoSurface font axis_key_locations axis_key_size fillColor borderColor text channels = do
+drawKey :: (Integral a1, Integral a2, Integral a) => Int -> SDL.Surface -> SDL.TTF.Font -> [(a1, a2)] -> a -> SDL.Color -> t -> Maybe String -> [Int] -> IO ()
+drawKey idx videoSurface font axis_key_locations axis_key_size fillColor borderColor text channels = do
   let (x, y) = axis_key_locations !! idx
   drawFilledHexircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) (colorToPixel fillColor)
   let len = length channels
@@ -161,13 +168,6 @@ drawKey' idx videoSurface font axis_key_locations axis_key_size fillColor border
     (Just t) -> centerText videoSurface x y font _KEY_TEXT_COLOR fillColor t
     _ -> return ()
 
-eraseKeys_ really pitches videoSurface font axis_key_locations axis_key_size =
-  let pitchSet = Set.fromList $ map (\p -> (Event.Channel 1, Event.Pitch p)) pitches
-  in
-    smartDrawKeys' really Set.empty pitchSet videoSurface font axis_key_locations axis_key_size
-reallyEraseKeys = eraseKeys_ True
-eraseKeys = eraseKeys_ False
-
 fi = fromIntegral
 rgbColor r g b = SDL.Pixel (shiftL (fi r) 24 .|. shiftL (fi g) 16 .|. shiftL (fi b) 8 .|. (fi 255))
 
@@ -199,9 +199,10 @@ main =
 
   let (axis_key_size, axis_key_locations) = getKeyLocations videoClipRect
 
-  let _ALL_PITCHES = [_AXIS_BOTTOM_PITCH .. _AXIS_TOP_PITCH]
-  let allKeysOFF =             eraseKeys _ALL_PITCHES videoSurface font axis_key_locations axis_key_size
-      allKeysReallyOFF = reallyEraseKeys _ALL_PITCHES videoSurface font axis_key_locations axis_key_size
+  let _ALL_PITCHES = Set.fromList $ map (\p -> (Event.Channel 1, Event.Pitch p)) [_AXIS_BOTTOM_PITCH .. _AXIS_TOP_PITCH]
+      keysOFF really = smartDrawKeys' really _ALL_PITCHES Set.empty videoSurface font axis_key_locations axis_key_size
+      allKeysOFF =  keysOFF False
+      allKeysReallyOFF = keysOFF True
   allKeysOFF
 
   putStrLn "Initialized."
@@ -223,11 +224,20 @@ main =
 --        let chord = show $ pitchList midiKeysDown'
 --        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 = Set.difference midiKeysDown' ignoreThese
-          let eraseThese = Set.difference midiKeysDown ignoreThese
 
-          smartDrawKeys' False drawThese eraseThese videoSurface font axis_key_locations axis_key_size
+          --  gah!  This is all wrong with the channels added!  Unless
+          --  smartDrawKeys gets smarter... but really, this interface
+          --  is awkward now and should be changed.
+          --
+          --  What we actually want here is the set of pitches where
+          --  there has been an event.  Which is simply derived from
+          --  just the Set.difference midiKeys midiKeys'.  But we also
+          --  want the set of channels for each pitch -- which is just
+          --  midiKeysDown' (processed as we are doing already in
+          --  smartDrawKeys).  Then we build up a map of pitches ->
+          --  channels.
+
+          smartDrawKeys' False midiKeysDown midiKeysDown' videoSurface font axis_key_locations axis_key_size
           return ()
 
         Control.Monad.when (keysDown' /= keysDown && keyDown SDL.SDLK_BACKSPACE keysDown') allKeysOFF