From 02c55d5b39bb67c7a978c69aa21862b6d3719ddc Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Thu, 16 Jan 2014 01:37:59 -0500
Subject: 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.
---
 axis.hs | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)

(limited to 'axis.hs')

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
 import AlsaSeq
 import qualified Data.Set as Set
 import qualified Graphics.UI.SDL.TTF as SDL.TTF
+import Data.String
+import Graphics.UI.SDL.Keysym as SDL.Keysym
 
 netwireIsCool :: (Monad m) => Wire (Timed NominalDiffTime ()) () m a String
 netwireIsCool =
@@ -67,6 +69,12 @@ main =
           textBand videoSurface videoClipRect (SDL.Rect 0 70 0 70) font chord
           return ()
 
+        Control.Monad.when (keysDown' /= keysDown) $ do
+          let chord = unwords $ map (\k -> drop 5 (show k)) $ Set.toList keysDown'
+          Control.Monad.when (chord /= "") $ putStrLn chord
+          textBand videoSurface videoClipRect (SDL.Rect 0 210 0 70) font chord
+          return ()
+
         mouse <- SDL.getRelativeMouseState
         let (x, y, button) = mouse
         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
     return ()
   return ()
 
-parseSDLEvents :: Set.Set SDL.Keysym -> IO (Set.Set SDL.Keysym)
+parseSDLEvents :: Set.Set SDL.SDLKey -> IO (Set.Set SDL.Keysym.SDLKey)
 parseSDLEvents keysDown = do
   event <- SDL.pollEvent
   case event of
     SDL.NoEvent -> return keysDown
-    SDL.KeyDown k -> parseSDLEvents (Set.insert k keysDown)
-    SDL.KeyUp k -> parseSDLEvents (Set.delete k keysDown)
+    SDL.KeyDown (SDL.Keysym k _ _) -> parseSDLEvents (Set.insert k keysDown)
+    SDL.KeyUp (SDL.Keysym k _ _) -> parseSDLEvents (Set.delete k keysDown)
     _ -> parseSDLEvents keysDown
 
-keyDown :: SDL.SDLKey -> Set.Set SDL.Keysym -> Bool
-keyDown k = not . Set.null . Set.filter ((== k) . SDL.symKey)
+keyDown :: SDL.Keysym.SDLKey -> Set.Set SDL.Keysym.SDLKey -> Bool
+keyDown k s = Set.member k s
 
 deriving instance Ord SDL.Keysym
-- 
cgit v1.2.3