summaryrefslogtreecommitdiff
path: root/axis.hs
diff options
context:
space:
mode:
Diffstat (limited to 'axis.hs')
-rw-r--r--axis.hs18
1 files changed, 13 insertions, 5 deletions
diff --git a/axis.hs b/axis.hs
index 3e9917e..1e1a911 100644
--- a/axis.hs
+++ b/axis.hs
@@ -9,6 +9,8 @@ import qualified Graphics.UI.SDL as SDL
9import AlsaSeq 9import AlsaSeq
10import qualified Data.Set as Set 10import qualified Data.Set as Set
11import qualified Graphics.UI.SDL.TTF as SDL.TTF 11import qualified Graphics.UI.SDL.TTF as SDL.TTF
12import Data.String
13import Graphics.UI.SDL.Keysym as SDL.Keysym
12 14
13netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String 15netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String
14netwireIsCool = 16netwireIsCool =
@@ -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
96parseSDLEvents :: Set.Set SDL.Keysym -> IO (Set.Set SDL.Keysym) 104parseSDLEvents :: Set.Set SDL.SDLKey -> IO (Set.Set SDL.Keysym.SDLKey)
97parseSDLEvents keysDown = do 105parseSDLEvents 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
105keyDown :: SDL.SDLKey -> Set.Set SDL.Keysym -> Bool 113keyDown :: SDL.Keysym.SDLKey -> Set.Set SDL.Keysym.SDLKey -> Bool
106keyDown k = not . Set.null . Set.filter ((== k) . SDL.symKey) 114keyDown k s = Set.member k s
107 115
108deriving instance Ord SDL.Keysym 116deriving instance Ord SDL.Keysym