summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--axis.hs39
1 files changed, 21 insertions, 18 deletions
diff --git a/axis.hs b/axis.hs
index d6a76a6..a31199e 100644
--- a/axis.hs
+++ b/axis.hs
@@ -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
111zipzip ls = if (head ls) == [] then [] else (map head ls) : (zipzip $ map tail ls)
112
109drawHexagonSDL videoSurface centerx centery radius pixel = do 113drawHexagonSDL 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
128getKeyLocations (SDL.Rect offx offy totalw totalh) = 131getKeyLocations (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
155getKeyLocationsAbs = 158getKeyLocationsAbs =
156 let kb_rows = 7 :: Double 159 let kb_rows = 7 :: Double