diff options
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 |