starting keyboard input

This commit is contained in:
nek0 2019-02-11 10:49:23 +01:00
parent f4292cd931
commit ab4be91d13
3 changed files with 19 additions and 12 deletions

View file

@ -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

View file

@ -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

View file

@ -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