show currently-playing midi notes in real-time through sdl!

1 files changed, 27 insertions, 4 deletions

diff --git a/axis.hs b/axis.hs
index 37b187f..3e0b8b1 100644
--- a/axis.hs
+++ b/axis.hs
@@ -53,13 +53,28 @@ main =
           putStrLn x'
           fontSurface <- SDL.TTF.renderUTF8Blended font x' (SDL.Color 0 255 0)
           fontClipRect <- SDL.getClipRect fontSurface
---        _ <- SDL.fillRect videoSurface (Just fontClipRect) (SDL.Pixel 0)
-          _ <- SDL.fillRect videoSurface (Just videoClipRect) (SDL.Pixel 0)
+          _ <- SDL.fillRect videoSurface (Just (widenRect fontClipRect videoClipRect)) (SDL.Pixel 0) -- clear a horizontal band
           _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just fontClipRect)
---        _ <- SDL.updateRect videoSurface fontClipRect
-          _ <- SDL.updateRect videoSurface videoClipRect
           return ()
 
+        Control.Monad.when (midiKeysDown' /= midiKeysDown) $ do
+          let chord = showChord midiKeysDown'
+          putStrLn chord
+          if (chord /= "")
+          then do
+            chordFontSurface <- SDL.TTF.renderUTF8Blended font chord (SDL.Color 0 255 0)
+            chordFontClipRect <- SDL.getClipRect chordFontSurface
+            let r = chordFontClipRect `underNeath` (SDL.Rect 0 0 0 70)
+            _ <- SDL.fillRect videoSurface (Just (widenRect r videoClipRect)) (SDL.Pixel 0) -- clear a horizontal band
+            _ <- SDL.blitSurface chordFontSurface (Just chordFontClipRect) videoSurface (Just r)
+            return ()
+          else do
+            _ <- SDL.fillRect videoSurface (Just (widenRect (SDL.Rect 0 70 0 70) videoClipRect)) (SDL.Pixel 0) -- clear a horizontal band
+            return ()
+          return ()
+
+        _ <- SDL.updateRect videoSurface videoClipRect
+
         let framerate = 30
         let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds)
         SDL.delay (delay)
@@ -68,6 +83,14 @@ main =
 
   loop Set.empty Set.empty clockSession_ netwireIsCool ""
 
+widenRect a b =
+  let ((SDL.Rect x1 y1 w1 h1), (SDL.Rect x2 _ w2 _)) = (a, b) in
+    (SDL.Rect x2 y1 w2 h1)
+
+underNeath a b =
+  let ((SDL.Rect x1 y1 w1 h1), (SDL.Rect _ _ _ h2)) = (a, b) in
+    (SDL.Rect x1 (y1+h2) w1 h1)
+
 parseSDLEvents :: Set.Set SDL.Keysym -> IO (Set.Set SDL.Keysym)
 parseSDLEvents keysDown = do
   event <- SDL.pollEvent