From 5736ae0a30c2a4844c0f26d6847356193482ee61 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Fri, 17 Jan 2014 03:55:49 -0500
Subject: pretty close to live key display

---
 axis.hs | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)

(limited to 'axis.hs')

diff --git a/axis.hs b/axis.hs
index a31199e..3108779 100644
--- a/axis.hs
+++ b/axis.hs
@@ -14,6 +14,8 @@ import Data.String
 import Graphics.UI.SDL.Keysym as SDL.Keysym
 import Graphics.UI.SDL.Primitives as SDL.Primitive
 import Data.Int (Int16)
+import qualified System.Exit as Exit
+import Data.List (elemIndex, elemIndices)
 
 netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String
 netwireIsCool =
@@ -61,7 +63,8 @@ main =
 
   forM_ [0 .. length axis_key_locations - 1] $ \i -> do
     let (centerx, centery) = axis_key_locations !! i
-    centerText videoSurface centerx centery font (show i)
+    centerText videoSurface centerx centery font (showPitch $ pitchIndex !! i)
+--  centerText videoSurface centerx centery font (show i)
 
   putStrLn "Initialized."
 
@@ -78,18 +81,19 @@ main =
           return ()
 
         Control.Monad.when (midiKeysDown' /= midiKeysDown) $ do
-          let chord = showChord midiKeysDown'
+          --let chord = showChord midiKeysDown'
+          --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
           return ()
 
         Control.Monad.when (keysDown' /= keysDown) $ do
           let chord = unwords $ map (\k -> drop 5 (show k)) $ Set.toList keysDown'
           textBand videoSurface videoClipRect (SDL.Rect 0 210 0 70) font chord
+          textBand videoSurface videoClipRect (SDL.Rect 0 280 0 70) font $
+            if keyDown SDL.SDLK_a keysDown' then "arpeggiate" else ""
           return ()
 
-        textBand videoSurface videoClipRect (SDL.Rect 0 280 0 70) font $
-          if keyDown SDL.SDLK_a keysDown' then "arpeggiate" else ""
-
         Control.Monad.when(False) $ do
 
           mouse <- SDL.getRelativeMouseState
@@ -121,13 +125,16 @@ drawHexagonSDL videoSurface centerx centery radius pixel = do
   return ()
 
 centerText videoSurface x y font text = do
-  fontSurface <- SDL.TTF.renderUTF8Shaded font text (SDL.Color 0 255 0) (SDL.Color 80 80 80)
+--fontSurface <- SDL.TTF.renderUTF8Shaded font text (SDL.Color 0 255 0) (SDL.Color 80 80 80) -- useful for testing
+  fontSurface <- SDL.TTF.renderUTF8Shaded font text (SDL.Color 0 255 0) (SDL.Color 0 0 0)
   fontClipRect <- SDL.getClipRect fontSurface
   let (SDL.Rect _ _ w h) = fontClipRect
   _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just (SDL.Rect (fromIntegral(x) - w `div` 2) (fromIntegral(y) - h `div` 2) w h))
---_ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just (SDL.Rect (fromIntegral(x) + w) (fromIntegral(y) + h `div` 2) w h))
   return ()
 
+colfrom top = map (+ top) $ map (* (-7)) [0 .. 6]
+pitchIndex = (\x -> x ++ x) $ concat $ map colfrom [81, 78, 82, 79, 83, 80, 84]
+
 getKeyLocations (SDL.Rect offx offy totalw totalh) =
   let (key_height, key_width, xys) = getKeyLocationsAbs
 
@@ -160,7 +167,7 @@ getKeyLocationsAbs =
       kb_cols = 14 :: Double
       -- the edges of the hexagon are equal in length to its "radius"
       -- if the radius is 1, then horizontal movement is 1.5 and vertical movement is sqrt(3) from one center to the next
-      -- or else it is 2*sqrt(3) to move up
+      -- or else it is 2*sqrt(3) to move down
 
       kw = 1 :: Double
       kh = kw/2 * sqrt(3) -- hexagon ratio
-- 
cgit v1.2.3