diff options
-rw-r--r-- | axis.hs | 39 |
1 files changed, 21 insertions, 18 deletions
@@ -48,11 +48,20 @@ main = | |||
48 | _ <- SDL.showCursor False | 48 | _ <- SDL.showCursor False |
49 | _ <- SDL.grabInput True | 49 | _ <- SDL.grabInput True |
50 | warpMouse | 50 | warpMouse |
51 | |||
52 | let pixelFormat = SDL.surfaceGetPixelFormat videoSurface | ||
53 | blue <- SDL.mapRGB pixelFormat 0 255 255 -- why is it blue??? | ||
51 | -- _ <- SDL.setRelativeMouseMode True -- SDL2. Should I use it? | 54 | -- _ <- SDL.setRelativeMouseMode True -- SDL2. Should I use it? |
52 | 55 | ||
53 | let (axis_key_size, axis_key_locations) = getKeyLocations videoClipRect | 56 | let (axis_key_size, axis_key_locations) = getKeyLocations videoClipRect |
54 | print getKeyLocationsAbs | 57 | |
55 | print axis_key_locations | 58 | forM_ axis_key_locations $ \(x, y) -> do |
59 | --SDL.Primitive.filledCircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) blue >>= return | ||
60 | drawHexagonSDL videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) blue >>= return | ||
61 | |||
62 | forM_ [0 .. length axis_key_locations - 1] $ \i -> do | ||
63 | let (centerx, centery) = axis_key_locations !! i | ||
64 | centerText videoSurface centerx centery font (show i) | ||
56 | 65 | ||
57 | putStrLn "Initialized." | 66 | putStrLn "Initialized." |
58 | 67 | ||
@@ -81,22 +90,15 @@ main = | |||
81 | textBand videoSurface videoClipRect (SDL.Rect 0 280 0 70) font $ | 90 | textBand videoSurface videoClipRect (SDL.Rect 0 280 0 70) font $ |
82 | if keyDown SDL.SDLK_a keysDown' then "arpeggiate" else "" | 91 | if keyDown SDL.SDLK_a keysDown' then "arpeggiate" else "" |
83 | 92 | ||
84 | mouse <- SDL.getRelativeMouseState | 93 | Control.Monad.when(False) $ do |
85 | let (x, y, button) = mouse | ||
86 | textBand videoSurface videoClipRect (SDL.Rect 0 140 0 70) font ((show x) ++ " " ++ (show y) ++ " " ++ (show button)) | ||
87 | Control.Monad.when (x /= 0 || y /= 0) warpMouse | ||
88 | 94 | ||
89 | let pixelFormat = SDL.surfaceGetPixelFormat videoSurface | 95 | mouse <- SDL.getRelativeMouseState |
90 | blue <- SDL.mapRGB pixelFormat 0 255 255 -- why is it blue??? | 96 | let (x, y, button) = mouse |
91 | forM_ axis_key_locations $ \(x, y) -> do | 97 | let text = ((show x) ++ " " ++ (show y) ++ " " ++ (show button)) |
92 | --SDL.Primitive.filledCircle videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) blue >>= return | 98 | textBand videoSurface videoClipRect (SDL.Rect 0 140 0 70) font text |
93 | drawHexagonSDL videoSurface (fromIntegral x) (fromIntegral y) (fromIntegral axis_key_size) blue >>= return | 99 | Control.Monad.when (x /= 0 || y /= 0) warpMouse |
94 | 100 | ||
95 | forM_ [0 .. length axis_key_locations - 1] $ \i -> do | 101 | _ <- SDL.updateRect videoSurface videoClipRect -- draw it all! probably a bad idea |
96 | let (centerx, centery) = axis_key_locations !! i | ||
97 | centerText videoSurface centerx centery font (show i) | ||
98 | |||
99 | _ <- SDL.updateRect videoSurface videoClipRect -- draw it all! | ||
100 | 102 | ||
101 | let framerate = 30 | 103 | let framerate = 30 |
102 | let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds) | 104 | let delay = 1000 `div` framerate - 1000 * (floor $ dtime ds) |
@@ -106,6 +108,8 @@ main = | |||
106 | 108 | ||
107 | loop Set.empty Set.empty clockSession_ netwireIsCool "" | 109 | loop Set.empty Set.empty clockSession_ netwireIsCool "" |
108 | 110 | ||
111 | zipzip ls = if (head ls) == [] then [] else (map head ls) : (zipzip $ map tail ls) | ||
112 | |||
109 | drawHexagonSDL videoSurface centerx centery radius pixel = do | 113 | drawHexagonSDL videoSurface centerx centery radius pixel = do |
110 | let r = fromIntegral radius | 114 | let r = fromIntegral radius |
111 | --let points = map (\(x, y) -> (centerx + x + radius `div` 2, centery + y + radius `div` 2)) $ | 115 | --let points = map (\(x, y) -> (centerx + x + radius `div` 2, centery + y + radius `div` 2)) $ |
@@ -124,7 +128,6 @@ centerText videoSurface x y font text = do | |||
124 | --_ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just (SDL.Rect (fromIntegral(x) + w) (fromIntegral(y) + h `div` 2) w h)) | 128 | --_ <- SDL.blitSurface fontSurface (Just fontClipRect) videoSurface (Just (SDL.Rect (fromIntegral(x) + w) (fromIntegral(y) + h `div` 2) w h)) |
125 | return () | 129 | return () |
126 | 130 | ||
127 | |||
128 | getKeyLocations (SDL.Rect offx offy totalw totalh) = | 131 | getKeyLocations (SDL.Rect offx offy totalw totalh) = |
129 | let (key_height, key_width, xys) = getKeyLocationsAbs | 132 | let (key_height, key_width, xys) = getKeyLocationsAbs |
130 | 133 | ||
@@ -150,7 +153,7 @@ getKeyLocations (SDL.Rect offx offy totalw totalh) = | |||
150 | centerx = (screenw - keyboard_width * scale) / 2 | 153 | centerx = (screenw - keyboard_width * scale) / 2 |
151 | centery = (screenh - keyboard_height * scale) / 2 | 154 | centery = (screenh - keyboard_height * scale) / 2 |
152 | in | 155 | in |
153 | (floor(kw/2 * 15/16), map (\(x, y) -> (floor(scale * x + centerx + kw/2), floor(scale * y + centery + kh/2))) $ concat xys) | 156 | (floor(kw/2 * 15/16), map (\(x, y) -> (floor(scale * x + centerx + kw/2), floor(scale * y + centery + kh/2))) $ concat $ zipzip xys) |
154 | 157 | ||
155 | getKeyLocationsAbs = | 158 | getKeyLocationsAbs = |
156 | let kb_rows = 7 :: Double | 159 | let kb_rows = 7 :: Double |