summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--axis.hs27
1 files changed, 17 insertions, 10 deletions
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 =
44drawHexircle = _drawHexircle False 44drawHexircle = _drawHexircle False
45drawFilledHexircle = _drawHexircle True 45drawFilledHexircle = _drawHexircle True
46 46
47_AXIS_ROWS = 7 + 4
48_AXIS_UNIQUE_COLS = 7
49_AXIS_TOP_PITCH = 81 + (7 * (_AXIS_ROWS - 7) `div` 2)
50_AXIS_BOTTOM_PITCH = 81 - (7 * _AXIS_ROWS) - 3
51
47_KEY_COLOR = (SDL.Color 0 0 255) 52_KEY_COLOR = (SDL.Color 0 0 255)
48_KEY_BG_COLOR = (SDL.Color 0 0 0) 53_KEY_BG_COLOR = (SDL.Color 0 0 0)
49_KEY_TEXT_COLOR = (SDL.Color 128 128 0) 54_KEY_TEXT_COLOR = (SDL.Color 128 128 0)
@@ -81,15 +86,16 @@ main =
81 warpMouse = do 86 warpMouse = do
82 _ <- SDL.warpMouse (fromIntegral (width `div` 2)) (fromIntegral (height `div` 2)) 87 _ <- SDL.warpMouse (fromIntegral (width `div` 2)) (fromIntegral (height `div` 2))
83 return () 88 return ()
84 screen <- SDL.setVideoMode width height 32 [SDL.SWSurface, SDL.Fullscreen] 89--screen <- SDL.setVideoMode width height 32 [SDL.SWSurface, SDL.Fullscreen]
90 screen <- SDL.setVideoMode width height 32 [SDL.SWSurface]
85 91
86 _ <- SDL.TTF.init 92 _ <- SDL.TTF.init
87 font <- SDL.TTF.openFont "LiberationMono-Bold.ttf" 30 93 font <- SDL.TTF.openFont "LiberationMono-Bold.ttf" 30
88 videoSurface <- SDL.getVideoSurface 94 videoSurface <- SDL.getVideoSurface
89 videoClipRect <- SDL.getClipRect videoSurface 95 videoClipRect <- SDL.getClipRect videoSurface
90 _ <- SDL.showCursor False 96--_ <- SDL.showCursor False
91 _ <- SDL.grabInput True 97--_ <- SDL.grabInput True
92 warpMouse 98--warpMouse
93 99
94--let pixelFormat = SDL.surfaceGetPixelFormat videoSurface 100--let pixelFormat = SDL.surfaceGetPixelFormat videoSurface
95 pixelFormat <- SDL.surfaceGetPixelFormat <$> SDL.createRGBSurfaceEndian [] 1 1 24 101 pixelFormat <- SDL.surfaceGetPixelFormat <$> SDL.createRGBSurfaceEndian [] 1 1 24
@@ -97,7 +103,7 @@ main =
97 103
98 let (axis_key_size, axis_key_locations) = getKeyLocations videoClipRect 104 let (axis_key_size, axis_key_locations) = getKeyLocations videoClipRect
99 105
100 let allPitches = map (+ 35) [0 .. 49] 106 let allPitches = [_AXIS_BOTTOM_PITCH .. _AXIS_TOP_PITCH]
101--drawKeys allPitches videoSurface font blue axis_key_locations axis_key_size 107--drawKeys allPitches videoSurface font blue axis_key_locations axis_key_size
102 eraseKeys allPitches videoSurface font axis_key_locations axis_key_size 108 eraseKeys allPitches videoSurface font axis_key_locations axis_key_size
103 109
@@ -173,9 +179,10 @@ centerText videoSurface x y font fgColor bgColor text = do
173 _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just (SDL.Rect (fromIntegral(x) - w `div` 2) (fromIntegral(y) - h `div` 2) w h)) 179 _ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just (SDL.Rect (fromIntegral(x) - w `div` 2) (fromIntegral(y) - h `div` 2) w h))
174 return () 180 return ()
175 181
176-- TODO: make this generalize to different grid sizes 182pitchIndex = (\x -> x ++ x) $ concat $ map colfrom toprow
177colfrom top = map (+ top) $ map (* (-7)) [0 .. 6] 183 where
178pitchIndex = (\x -> x ++ x) $ concat $ map colfrom [81, 78, 82, 79, 83, 80, 84] 184 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]
185 colfrom top = map (+ top) $ map (* (-7)) [0 .. _AXIS_ROWS - 1]
179 186
180getKeyLocations (SDL.Rect offx offy totalw totalh) = 187getKeyLocations (SDL.Rect offx offy totalw totalh) =
181 let (key_height, key_width, xys) = getKeyLocationsAbs 188 let (key_height, key_width, xys) = getKeyLocationsAbs
@@ -205,8 +212,8 @@ getKeyLocations (SDL.Rect offx offy totalw totalh) =
205 (floor(kw/2 * 15/16), map (\(x, y) -> (floor(scale * x + centerx + kw/2), floor(scale * y + centery + kh/2))) $ concat $ zipzip xys) 212 (floor(kw/2 * 15/16), map (\(x, y) -> (floor(scale * x + centerx + kw/2), floor(scale * y + centery + kh/2))) $ concat $ zipzip xys)
206 213
207getKeyLocationsAbs = 214getKeyLocationsAbs =
208 let kb_rows = 7 :: Double 215 let kb_rows = (fromIntegral _AXIS_ROWS) :: Double
209 kb_cols = 14 :: Double 216 kb_cols = 2 * (fromIntegral _AXIS_UNIQUE_COLS) :: Double
210 -- the edges of the hexagon are equal in length to its "radius" 217 -- the edges of the hexagon are equal in length to its "radius"
211 -- if the radius is 1, then horizontal movement is 1.5 and vertical movement is sqrt(3) from one center to the next 218 -- if the radius is 1, then horizontal movement is 1.5 and vertical movement is sqrt(3) from one center to the next
212 -- or else it is 2*sqrt(3) to move down 219 -- or else it is 2*sqrt(3) to move down