starting keyboard input

src/Menu/Adjust.hs

@@ -20,14 +20,14 @@ loadAdjust :: Action -> Affection UserData () -> Affection UserData ()
 loadAdjust sub switchBack = do
   ud <- getAffection
   let Subsystems w m k j t = subsystems ud
-  uu1 <- partSubscribe j (listener switchBack)
+  uu1 <- partSubscribe j (joyListener switchBack)
   putAffection ud
     { state = Menu (Adjust sub)
     , uuid = [ uu1 ]
     }
 
-listener :: Affection UserData () -> JoystickMessage -> Affection UserData ()
-listener switchBack (MsgJoystickAxis _ _ axis val) = do
+joyListener :: Affection UserData () -> JoystickMessage -> Affection UserData ()
+joyListener switchBack (MsgJoystickAxis _ _ axis val) = do
   ud <- getAffection
   liftIO $ logIO A.Debug ("switching " ++ show (state ud) ++ " to " ++ show axis)
   case state ud of
@@ -47,7 +47,7 @@ listener switchBack (MsgJoystickAxis _ _ axis val) = do
         }
   fullClean
   switchBack
-listener switchBack (MsgJoystickButton _ _ but SDL.JoyButtonPressed) = do
+joyListener switchBack (MsgJoystickButton _ _ but SDL.JoyButtonPressed) = do
   ud <- getAffection
   case state ud of
     Menu (Adjust (UpDown s)) -> return ()
@@ -62,7 +62,7 @@ listener switchBack (MsgJoystickButton _ _ but SDL.JoyButtonPressed) = do
     _ -> return ()
   fullClean
   switchBack
-listener _ _ = return ()
+joyListener _ _ = return ()
 
 drawAdjust :: Affection UserData ()
 drawAdjust = do

src/Menu/Connect.hs

@@ -25,12 +25,13 @@ loadMenu :: Affection UserData ()
 loadMenu = do
   ud <- getAffection
   ad <- get
-  let (Subsystems _ m _ j t) = subsystems ud
+  let (Subsystems _ m k j t) = subsystems ud
   uu1 <- partSubscribe j joystickConnect
   uu2 <- partSubscribe j joystickDisconnect
-  uu3 <- partSubscribe j emitActionMessage
+  uu3 <- partSubscribe j emitJoyActionMessage
   uu4 <- partSubscribe t handleActionMessages
   uu5 <- partSubscribe m handleClicks
+  uu6 <- partSubscribe k emitKbdActionMessage
   partUnSubscribe j (joyUUID ud)
   putAffection ud
     { uuid      = [ uu1, uu2, uu3, uu4, uu5 ]
@@ -49,7 +50,7 @@ joystickConnect msg = do
       ident <- liftIO $ fromIntegral <$> SDL.getJoystickID joy
       liftIO $ logIO A.Debug $ "Joystick connected: " ++ show ident
       putAffection ud
-        { joystick = Just joy
+        { controls = Joystick joy
         }
       ) mjoy
 
@@ -61,7 +62,7 @@ joystickDisconnect msg = do
     when (null njoys) $ do
       liftIO $ logIO A.Debug $ "Joystick disconnected"
       putAffection ud
-        { joystick = Nothing
+        { Controls = None
         }
     ) (joystick ud)
 
@@ -168,7 +169,7 @@ drawMenu = do
     MenuData _ _ _ _ ->
       liftIO $ do
         let ctx = nano ud
-            controller = joystick ud
+            controller = controls ud
         save ctx
         beginPath ctx
         paint <- imagePattern ctx 600 620 80 80 0 (assetIcons ud M.!
@@ -179,7 +180,7 @@ drawMenu = do
         rect ctx 600 620 80 80
         fillPaint ctx paint
         fill ctx
-        when (isJust controller) $ do
+        when (controller /= None) $ do
           let V2 vx vy = velocity $ stateData ud
           beginPath ctx
           roundedRect ctx 140 110 1000 500 25

src/Types/UserData.hs

@@ -30,7 +30,7 @@ data UserData = UserData
   , assetImages     :: M.Map ImgId Image
   , assetFonts      :: M.Map FontId T.Text
   , assetAnimations :: M.Map AnimId Animation
-  , joystick        :: Maybe SDL.Joystick
+  , controls        :: Controller -- Maybe SDL.Joystick
   , translation     :: M.Map GamepadAction Action
   , nano            :: Context
   , uuid            :: [UUID]
@@ -47,6 +47,12 @@ data UserData = UserData
   , joyUUID         :: UUID
   }
 
+data Controller
+  = None
+  | Keyboard
+  | Joystick SDL.Joystick
+  deriving (Eq, Show)
+
 data State
   = Load
   | Menu SubMenu