From 78745bbb7436a220a469dbf3cae79ceefd41b971 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Thu, 16 Jan 2014 17:47:43 -0500 Subject: count the hexagons --- axis.hs | 37 ++++++++++++++++++------------------- 1 file changed, 18 insertions(+), 19 deletions(-) (limited to 'axis.hs') diff --git a/axis.hs b/axis.hs index ac62624..d6a76a6 100644 --- a/axis.hs +++ b/axis.hs @@ -92,6 +92,10 @@ main = --SDL.Primitive.filledCircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) blue >>= return drawHexagonSDL videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) blue >>= return + forM_ [0 .. length axis_key_locations - 1] $ \i -> do + let (centerx, centery) = axis_key_locations !! i + centerText videoSurface centerx centery font (show i) + _ <- SDL.updateRect videoSurface videoClipRect -- draw it all! let framerate = 30 @@ -110,14 +114,6 @@ drawHexagonSDL videoSurface centerx centery radius pixel = do map (\i -> (r * cos(pi/3 * (i)), r * sin(pi/3 * (i)))) $ map fromIntegral [0 .. 5] --filledPolygon :: Surface -> [(Int16, Int16)] -> Pixel -> IO Bool SDL.Primitive.polygon videoSurface points pixel >>= return - - let pixelFormat = SDL.surfaceGetPixelFormat videoSurface - blue <- SDL.mapRGB pixelFormat 0 255 255 -- why is it blue??? - SDL.Primitive.filledCircle videoSurface (fromIntegral centerx) (fromIntegral centery) 10 blue >>= return - SDL.Primitive.filledCircle videoSurface 0 0 10 blue >>= return - - font <- SDL.TTF.openFont "LiberationMono-Bold.ttf" 30 - centerText videoSurface centerx centery font "OK!" return () centerText videoSurface x y font text = do @@ -132,26 +128,29 @@ centerText videoSurface x y font text = do getKeyLocations (SDL.Rect offx offy totalw totalh) = let (key_height, key_width, xys) = getKeyLocationsAbs + screenw = fromIntegral(totalw) + screenh = fromIntegral(totalh) + kb_rows = length xys kb_cols = length (head xys) - -- there are 14 keys (13 steps) from the far left to the far right of the axis, each step is 1.5 horizontal, plus 2 halfs to fill to the edges - -- thus the keyboard is radius * (numkeys - 1) * 1.5 + 1) - keyboard_width = (fromIntegral(kb_cols - 1) * 1.5 + 2) * key_width + -- there are 14 keys (13 steps) from the far left to the far right of the axis; if the radius is 1 each step is 1.5 horizontal, plus 2 halfs to fill to the edges + -- thus the keyboard is radius * ((numkeys - 1) * 1.5 + 2) + keyboard_width = (fromIntegral(kb_cols - 1) * 1.5 + 2) * key_width / 2 keyboard_height = fromIntegral(kb_rows + 1) * key_height -- half of the keyboard is offset down one key - fit_width = fromIntegral(totalh) / fromIntegral(totalw) > keyboard_height / keyboard_width + fit_width = screenh / screenw > keyboard_height / keyboard_width scale = if fit_width - then fromIntegral(totalw) / keyboard_width - else fromIntegral(totalh) / keyboard_height + then screenw / keyboard_width + else screenh / keyboard_height kh = key_height * scale kw = key_width * scale - centerx = (fromIntegral(totalw) - keyboard_width * scale) / 2 - centery = (fromIntegral(totalh) - keyboard_height * scale) / 2 + centerx = (screenw - keyboard_width * scale) / 2 + centery = (screenh - keyboard_height * scale) / 2 in - (floor(kw * 15/16), map (\(x, y) -> (floor(scale * x + centerx + kw), floor(scale * y + centery + kh/2))) $ concat xys) + (floor(kw/2 * 15/16), map (\(x, y) -> (floor(scale * x + centerx + kw/2), floor(scale * y + centery + kh/2))) $ concat xys) getKeyLocationsAbs = let kb_rows = 7 :: Double @@ -161,12 +160,12 @@ getKeyLocationsAbs = -- or else it is 2*sqrt(3) to move up kw = 1 :: Double - kh = kw * sqrt(3) -- hexagon ratio + kh = kw/2 * sqrt(3) -- hexagon ratio xys = map (\y -> map (\i -> ( - fromInteger(i) * kw * 3 / 2, + fromInteger(i) * kw * 3 / 4, y + kh / 2 * fromInteger(i `mod` 2) + -- cgit v1.2.3