diff options
-rw-r--r-- | axis.hs | 27 |
1 files changed, 17 insertions, 10 deletions
@@ -44,6 +44,11 @@ _drawHexircle f v x y s c = | |||
44 | drawHexircle = _drawHexircle False | 44 | drawHexircle = _drawHexircle False |
45 | drawFilledHexircle = _drawHexircle True | 45 | drawFilledHexircle = _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 | 182 | pitchIndex = (\x -> x ++ x) $ concat $ map colfrom toprow |
177 | colfrom top = map (+ top) $ map (* (-7)) [0 .. 6] | 183 | where |
178 | pitchIndex = (\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 | ||
180 | getKeyLocations (SDL.Rect offx offy totalw totalh) = | 187 | getKeyLocations (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 | ||
207 | getKeyLocationsAbs = | 214 | getKeyLocationsAbs = |
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 |