diff --git a/src/Menu/Adjust.hs b/src/Menu/Adjust.hs index e99eca9..6d1f394 100644 --- a/src/Menu/Adjust.hs +++ b/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 diff --git a/src/Menu/Connect.hs b/src/Menu/Connect.hs index 3669eed..776882a 100644 --- a/src/Menu/Connect.hs +++ b/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 diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index 42cd28a..5d93423 100644 --- a/src/Types/UserData.hs +++ b/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