From a51f15c2b6b2ece23883c7ca46b97e7f58025e56 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Fri, 17 Jan 2014 06:00:04 -0500
Subject: increase number of rows to 7+4

---
 axis.hs | 27 +++++++++++++++++----------
 1 file changed, 17 insertions(+), 10 deletions(-)

(limited to 'axis.hs')

diff --git a/axis.hs b/axis.hs
index bfbe169..8f2f3ce 100644
--- a/axis.hs
+++ b/axis.hs
@@ -44,6 +44,11 @@ _drawHexircle f v x y s c =
 drawHexircle  = _drawHexircle False
 drawFilledHexircle = _drawHexircle True
 
+_AXIS_ROWS = 7 + 4
+_AXIS_UNIQUE_COLS = 7
+_AXIS_TOP_PITCH = 81 + (7 * (_AXIS_ROWS - 7) `div` 2)
+_AXIS_BOTTOM_PITCH = 81 - (7 * _AXIS_ROWS) - 3
+
 _KEY_COLOR = (SDL.Color 0 0 255)
 _KEY_BG_COLOR = (SDL.Color 0 0 0)
 _KEY_TEXT_COLOR = (SDL.Color 128 128 0)
@@ -81,15 +86,16 @@ main =
       warpMouse = do
         _ <- SDL.warpMouse (fromIntegral (width `div` 2)) (fromIntegral (height `div` 2))
         return ()
-  screen <- SDL.setVideoMode width height 32 [SDL.SWSurface, SDL.Fullscreen]
+--screen <- SDL.setVideoMode width height 32 [SDL.SWSurface, SDL.Fullscreen]
+  screen <- SDL.setVideoMode width height 32 [SDL.SWSurface]
 
   _ <- SDL.TTF.init
   font <- SDL.TTF.openFont "LiberationMono-Bold.ttf" 30
   videoSurface <- SDL.getVideoSurface
   videoClipRect <- SDL.getClipRect videoSurface
-  _ <- SDL.showCursor False
-  _ <- SDL.grabInput True
-  warpMouse
+--_ <- SDL.showCursor False
+--_ <- SDL.grabInput True
+--warpMouse
 
 --let pixelFormat = SDL.surfaceGetPixelFormat videoSurface
   pixelFormat <- SDL.surfaceGetPixelFormat <$> SDL.createRGBSurfaceEndian [] 1 1 24
@@ -97,7 +103,7 @@ main =
 
   let (axis_key_size, axis_key_locations) = getKeyLocations videoClipRect
 
-  let allPitches = map (+ 35) [0 .. 49]
+  let allPitches = [_AXIS_BOTTOM_PITCH .. _AXIS_TOP_PITCH]
 --drawKeys allPitches videoSurface font blue axis_key_locations axis_key_size
   eraseKeys allPitches videoSurface font axis_key_locations axis_key_size
 
@@ -173,9 +179,10 @@ centerText videoSurface x y font fgColor bgColor text = do
   _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just (SDL.Rect (fromIntegral(x) - w `div` 2) (fromIntegral(y) - h `div` 2) w h))
   return ()
 
--- TODO: make this generalize to different grid sizes
-colfrom top = map (+ top) $ map (* (-7)) [0 .. 6]
-pitchIndex = (\x -> x ++ x) $ concat $ map colfrom [81, 78, 82, 79, 83, 80, 84]
+pitchIndex = (\x -> x ++ x) $ concat $ map colfrom toprow
+  where
+    toprow = map (\i -> if (i `mod` 2) == 0 then (_AXIS_TOP_PITCH + i `div` 2) else (_AXIS_TOP_PITCH - 3 + i `div` 2)) [0 .. _AXIS_UNIQUE_COLS - 1]
+    colfrom top = map (+ top) $ map (* (-7)) [0 .. _AXIS_ROWS - 1]
 
 getKeyLocations (SDL.Rect offx offy totalw totalh) =
   let (key_height, key_width, xys) = getKeyLocationsAbs
@@ -205,8 +212,8 @@ getKeyLocations (SDL.Rect offx offy totalw totalh) =
       (floor(kw/2 * 15/16), map (\(x, y) -> (floor(scale * x + centerx + kw/2), floor(scale * y + centery + kh/2))) $ concat $ zipzip xys)
 
 getKeyLocationsAbs =
-  let kb_rows = 7 :: Double
-      kb_cols = 14 :: Double
+  let kb_rows = (fromIntegral _AXIS_ROWS) :: Double
+      kb_cols = 2 * (fromIntegral _AXIS_UNIQUE_COLS) :: 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 down
-- 
cgit v1.2.3