diff options
author | Andrew Cady <d@jerkface.net> | 2014-01-16 01:37:59 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2014-01-16 01:37:59 -0500 |
commit | 02c55d5b39bb67c7a978c69aa21862b6d3719ddc (patch) | |
tree | 5e48faf2e6574a18f7a2a11e715ae17331b59720 /axis.hs | |
parent | 0921c83c08d4d9fd49901cfc5bd6295c710f0553 (diff) |
output sdl keys being pressed
changed type of keysDown in response to bug discovered in ocharles's
code: pressing keys with modifiers resulted in "stuck keys" (because
e.g. 'shift-a' would go into the same Set as 'a'). Now we're using just
Keysym.symkey instead of the entire Keysym.
Diffstat (limited to 'axis.hs')
-rw-r--r-- | axis.hs | 18 |
1 files changed, 13 insertions, 5 deletions
@@ -9,6 +9,8 @@ import qualified Graphics.UI.SDL as SDL | |||
9 | import AlsaSeq | 9 | import AlsaSeq |
10 | import qualified Data.Set as Set | 10 | import qualified Data.Set as Set |
11 | import qualified Graphics.UI.SDL.TTF as SDL.TTF | 11 | import qualified Graphics.UI.SDL.TTF as SDL.TTF |
12 | import Data.String | ||
13 | import Graphics.UI.SDL.Keysym as SDL.Keysym | ||
12 | 14 | ||
13 | netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String | 15 | netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String |
14 | netwireIsCool = | 16 | netwireIsCool = |
@@ -67,6 +69,12 @@ main = | |||
67 | textBand videoSurface videoClipRect (SDL.Rect 0 70 0 70) font chord | 69 | textBand videoSurface videoClipRect (SDL.Rect 0 70 0 70) font chord |
68 | return () | 70 | return () |
69 | 71 | ||
72 | Control.Monad.when (keysDown' /= keysDown) $ do | ||
73 | let chord = unwords $ map (\k -> drop 5 (show k)) $ Set.toList keysDown' | ||
74 | Control.Monad.when (chord /= "") $ putStrLn chord | ||
75 | textBand videoSurface videoClipRect (SDL.Rect 0 210 0 70) font chord | ||
76 | return () | ||
77 | |||
70 | mouse <- SDL.getRelativeMouseState | 78 | mouse <- SDL.getRelativeMouseState |
71 | let (x, y, button) = mouse | 79 | let (x, y, button) = mouse |
72 | textBand videoSurface videoClipRect (SDL.Rect 0 140 0 70) font ((show x) ++ " " ++ (show y) ++ " " ++ (show button)) | 80 | textBand videoSurface videoClipRect (SDL.Rect 0 140 0 70) font ((show x) ++ " " ++ (show y) ++ " " ++ (show button)) |
@@ -93,16 +101,16 @@ textBand videoSurface videoClipRect (SDL.Rect _ y _ h) font text = do | |||
93 | return () | 101 | return () |
94 | return () | 102 | return () |
95 | 103 | ||
96 | parseSDLEvents :: Set.Set SDL.Keysym -> IO (Set.Set SDL.Keysym) | 104 | parseSDLEvents :: Set.Set SDL.SDLKey -> IO (Set.Set SDL.Keysym.SDLKey) |
97 | parseSDLEvents keysDown = do | 105 | parseSDLEvents keysDown = do |
98 | event <- SDL.pollEvent | 106 | event <- SDL.pollEvent |
99 | case event of | 107 | case event of |
100 | SDL.NoEvent -> return keysDown | 108 | SDL.NoEvent -> return keysDown |
101 | SDL.KeyDown k -> parseSDLEvents (Set.insert k keysDown) | 109 | SDL.KeyDown (SDL.Keysym k _ _) -> parseSDLEvents (Set.insert k keysDown) |
102 | SDL.KeyUp k -> parseSDLEvents (Set.delete k keysDown) | 110 | SDL.KeyUp (SDL.Keysym k _ _) -> parseSDLEvents (Set.delete k keysDown) |
103 | _ -> parseSDLEvents keysDown | 111 | _ -> parseSDLEvents keysDown |
104 | 112 | ||
105 | keyDown :: SDL.SDLKey -> Set.Set SDL.Keysym -> Bool | 113 | keyDown :: SDL.Keysym.SDLKey -> Set.Set SDL.Keysym.SDLKey -> Bool |
106 | keyDown k = not . Set.null . Set.filter ((== k) . SDL.symKey) | 114 | keyDown k s = Set.member k s |
107 | 115 | ||
108 | deriving instance Ord SDL.Keysym | 116 | deriving instance Ord SDL.Keysym |