further implementation of controller

This commit is contained in:
nek0 2018-10-13 20:12:10 +02:00
parent 4c0910f640
commit 5ec3be4429
7 changed files with 95 additions and 26 deletions

View file

@ -26,6 +26,16 @@ updateMind :: Double -> Affection UserData ()
updateMind dt = do updateMind dt = do
ud <- getAffection ud <- getAffection
(nws, _) <- yieldSystemT (worldState ud) $ do (nws, _) <- yieldSystemT (worldState ud) $ do
emap allEnts $ do
with player
with xyvel
with mmvel
V2 rx ry <- query xyvel
let dr = (ry / sin (atan (1/2)) / 2) + rx
dc = rx - (ry / sin (atan (1/2)) / 2)
return $ unchanged
{ mmvel = Set $ 2 * V2 dr dc
}
emap allEnts $ do emap allEnts $ do
with anim with anim
with mmpos with mmpos
@ -68,7 +78,7 @@ updateMind dt = do
with rot with rot
with anim with anim
pos'@(V2 pr pc) <- query mmpos pos'@(V2 pr pc) <- query mmpos
vel' <- query vel vel' <- query mmvel
rot' <- query rot rot' <- query rot
stat <- query anim stat <- query anim
let npos = pos' + fmap (* dt) vel' let npos = pos' + fmap (* dt) vel'

View file

@ -52,12 +52,13 @@ loadMap = do
uu4 <- partSubscribe j emitActionMessage uu4 <- partSubscribe j emitActionMessage
uu5 <- partSubscribe t movePlayer2 uu5 <- partSubscribe t movePlayer2
uu6 <- partSubscribe t playerInteract2 uu6 <- partSubscribe t playerInteract2
uu7 <- partSubscribe t changeMaps2
future <- liftIO newEmptyMVar future <- liftIO newEmptyMVar
progress <- liftIO $ newMVar (0, "Ohai!") progress <- liftIO $ newMVar (0, "Ohai!")
_ <- liftIO $ forkIO $ loadMapFork ud ad future progress _ <- liftIO $ forkIO $ loadMapFork ud ad future progress
putAffection ud putAffection ud
{ stateData = None { stateData = None
, uuid = [ uu1, uu2, uu3, uu4, uu5, uu6 ] , uuid = [ uu1, uu2, uu3, uu4, uu5, uu6, uu7 ]
, stateMVar = future , stateMVar = future
, stateProgress = progress , stateProgress = progress
, state = Main WorldMap , state = Main WorldMap
@ -78,6 +79,21 @@ changeMaps (MsgKeyboardEvent _ _ SDL.Pressed False sym)
| otherwise = return () | otherwise = return ()
changeMaps _ = return () changeMaps _ = return ()
changeMaps2 :: ActionMessage -> Affection UserData ()
changeMaps2 (ActionMessage SwitchMap _) = do
ud <- getAffection
case state ud of
Main MindMap ->
putAffection ud
{ state = Main WorldMap
}
Main WorldMap ->
putAffection ud
{ state = Main MindMap
}
_ -> return ()
changeMaps2 _ = return ()
loadMapFork loadMapFork
:: UserData :: UserData
-> AffectionData UserData -> AffectionData UserData
@ -250,13 +266,11 @@ mouseToPlayer :: V2 Int32 -> Affection UserData ()
mouseToPlayer mv2 = do mouseToPlayer mv2 = do
ud <- getAffection ud <- getAffection
(V2 rx ry) <- liftIO $ relativizeMouseCoords mv2 (V2 rx ry) <- liftIO $ relativizeMouseCoords mv2
let dr = (ry / sin (atan (1/2)) / 2) + rx
dc = rx - (ry / sin (atan (1/2)) / 2)
(nws, _) <- yieldSystemT (worldState ud) $ (nws, _) <- yieldSystemT (worldState ud) $
emap allEnts $ do emap allEnts $ do
with player with player
pure $ unchanged return $ unchanged
{ vel = Set $ 4 * V2 dr dc { xyvel = Set $ V2 rx ry
} }
putAffection ud putAffection ud
{ worldState = nws { worldState = nws
@ -272,7 +286,7 @@ movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ _) = do
emap allEnts $ do emap allEnts $ do
with player with player
return $ unchanged return $ unchanged
{ vel = Set $ V2 0 0 { xyvel = Set $ V2 0 0
} }
putAffection ud putAffection ud
{ worldState = nws { worldState = nws

View file

@ -50,16 +50,16 @@ listener switchBack (MsgJoystickAxis _ _ axis val) = do
listener switchBack (MsgJoystickButton _ _ but SDL.JoyButtonPressed) = do listener switchBack (MsgJoystickButton _ _ but SDL.JoyButtonPressed) = do
ud <- getAffection ud <- getAffection
case state ud of case state ud of
Menu (Adjust (Activate)) -> do Menu (Adjust (UpDown s)) -> return ()
let k = fst <$> find (\(_, v) -> case v of Menu (Adjust (LeftRight s)) -> return ()
Activate -> True Menu (Adjust (act)) -> do
_ -> False let k = fst <$> find (\(_, v) -> v == act) (M.assocs $ translation ud)
) (M.assocs $ translation ud)
putAffection ud putAffection ud
{ translation = { translation =
M.insert (ButtonAction but SDL.JoyButtonPressed) Activate $ M.insert (ButtonAction but SDL.JoyButtonPressed) act $
if isJust k then M.delete (fromJust k) (translation ud) else translation ud if isJust k then M.delete (fromJust k) (translation ud) else translation ud
} }
_ -> return ()
fullClean fullClean
switchBack switchBack
listener _ _ = return () listener _ _ = return ()

View file

@ -35,7 +35,7 @@ loadMenu = do
putAffection ud putAffection ud
{ uuid = [ uu1, uu2, uu3, uu4, uu5 ] { uuid = [ uu1, uu2, uu3, uu4, uu5 ]
, state = Menu Connect , state = Menu Connect
, stateData = MenuData (V2 0 0) S 0 , stateData = MenuData (V2 0 0) S 0 0
, joyCache = [] , joyCache = []
} }
mapM_ (partEmit j) (joyCache ud) mapM_ (partEmit j) (joyCache ud)
@ -73,6 +73,13 @@ handleActionMessages (ActionMessage Activate _) = do
{ activate = 0.5 { activate = 0.5
} }
} }
handleActionMessages (ActionMessage SwitchMap _) = do
ud <- getAffection
putAffection ud
{ stateData = (stateData ud)
{ switchMap = 0.5
}
}
handleActionMessages (ActionMessage (UpDown f) _) = do handleActionMessages (ActionMessage (UpDown f) _) = do
ud <- getAffection ud <- getAffection
let V2 vx _ = velocity $ stateData ud let V2 vx _ = velocity $ stateData ud
@ -96,6 +103,7 @@ handleClicks (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft 1 pos@(V2 px py))
when (arrowUp rels || arrowDown rels) (adjustUpDown rels) when (arrowUp rels || arrowDown rels) (adjustUpDown rels)
when (arrowLeft rels || arrowRight rels) (adjustLeftRight rels) when (arrowLeft rels || arrowRight rels) (adjustLeftRight rels)
when (buttonActivate rels) (adjustActivate) when (buttonActivate rels) (adjustActivate)
when (buttonSwitchMap rels) (adjustSwitchMap)
when (buttonPlay rels) (enterGame) when (buttonPlay rels) (enterGame)
where where
adjustUpDown rels = do adjustUpDown rels = do
@ -117,6 +125,9 @@ handleClicks (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft 1 pos@(V2 px py))
adjustActivate = do adjustActivate = do
fullClean fullClean
loadAdjust Activate loadMenu loadAdjust Activate loadMenu
adjustSwitchMap = do
fullClean
loadAdjust SwitchMap loadMenu
enterGame = do enterGame = do
fullClean fullClean
loadMap loadMap
@ -130,6 +141,8 @@ handleClicks (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft 1 pos@(V2 px py))
rx > 430 / 1280 && rx < 530 / 1280 && ry > 310 / 720 && ry < 410 / 720 rx > 430 / 1280 && rx < 530 / 1280 && ry > 310 / 720 && ry < 410 / 720
buttonActivate (V2 rx ry) = buttonActivate (V2 rx ry) =
rx > 650 / 1280 && rx < 800 / 1280 && ry > 160 / 720 && ry < 210 / 720 rx > 650 / 1280 && rx < 800 / 1280 && ry > 160 / 720 && ry < 210 / 720
buttonSwitchMap (V2 rx ry) =
rx > 650 / 1280 && rx < 800 / 1280 && ry > 220 / 720 && ry < 270 / 720
buttonPlay (V2 rx ry) = buttonPlay (V2 rx ry) =
rx > 650 / 1280 && rx < 800 / 1280 && ry > 560 / 720 && ry < 610 / 720 rx > 650 / 1280 && rx < 800 / 1280 && ry > 560 / 720 && ry < 610 / 720
handleClicks _ = return () handleClicks _ = return ()
@ -138,12 +151,13 @@ updateMenu :: Double -> Affection UserData ()
updateMenu dt = do updateMenu dt = do
ud <- getAffection ud <- getAffection
case stateData ud of case stateData ud of
MenuData _ _ _ -> MenuData _ _ _ _ ->
putAffection ud putAffection ud
{ stateData = MenuData { stateData = MenuData
(velocity $ stateData ud) (velocity $ stateData ud)
(rotation $ stateData ud) (rotation $ stateData ud)
(max 0 ((activate $ stateData ud) - dt)) (max 0 ((activate $ stateData ud) - dt))
(max 0 ((switchMap $ stateData ud) - dt))
} }
_ -> return () _ -> return ()
@ -151,7 +165,7 @@ drawMenu :: Affection UserData ()
drawMenu = do drawMenu = do
ud <- getAffection ud <- getAffection
case stateData ud of case stateData ud of
MenuData _ _ _ -> MenuData _ _ _ _ ->
liftIO $ do liftIO $ do
let ctx = nano ud let ctx = nano ud
controller = joystick ud controller = joystick ud
@ -256,11 +270,12 @@ drawMenu = do
fill ctx fill ctx
restore ctx restore ctx
) [0, 90, 180, 270] ) [0, 90, 180, 270]
beginPath ctx
when (activate (stateData ud) > 0) $ do when (activate (stateData ud) > 0) $ do
beginPath ctx
fillColor ctx (rgb 255 128 0) fillColor ctx (rgb 255 128 0)
roundedRect ctx 650 160 150 50 10 roundedRect ctx 650 160 150 50 10
fill ctx fill ctx
closePath ctx
case state ud of case state ud of
Menu (Adjust Activate) -> do Menu (Adjust Activate) -> do
beginPath ctx beginPath ctx
@ -270,22 +285,49 @@ drawMenu = do
fill ctx fill ctx
_ -> _ ->
return () return ()
beginPath ctx
roundedRect ctx 650 160 150 50 10 roundedRect ctx 650 160 150 50 10
strokeWidth ctx 2 strokeWidth ctx 2
stroke ctx stroke ctx
fontSize ctx 25 fontSize ctx 25
fontFace ctx "bedstead" fontFace ctx "bedstead"
textAlign ctx (S.fromList [AlignCenter, AlignTop]) textAlign ctx (S.fromList [AlignCenter, AlignTop])
fillColor ctx (rgba 255 255 255 255) fillColor ctx (rgb 255 255 255)
textBox ctx 650 175 150 "Activate" textBox ctx 650 175 150 "Activate"
closePath ctx closePath ctx
roundedRect ctx 650 560 150 50 10 when (switchMap (stateData ud) > 0) $ do
strokeWidth ctx 5 beginPath ctx
fillColor ctx (rgb 255 128 0)
roundedRect ctx 650 220 150 50 10
fill ctx
closePath ctx
case state ud of
Menu (Adjust SwitchMap) -> do
beginPath ctx
fillColor ctx (rgb 0 255 0)
roundedRect ctx 650 220 150 50 10
closePath ctx
fill ctx
_ ->
return ()
beginPath ctx
roundedRect ctx 650 220 150 50 10
strokeWidth ctx 2
stroke ctx stroke ctx
fontSize ctx 25 fontSize ctx 25
fontFace ctx "bedstead" fontFace ctx "bedstead"
fillColor ctx (rgb 255 255 255)
textAlign ctx (S.fromList [AlignCenter, AlignTop])
textBox ctx 650 235 150 "Switch Map"
closePath ctx
beginPath ctx
roundedRect ctx 650 560 150 50 10
strokeWidth ctx 5
stroke ctx
closePath ctx
fontSize ctx 25
fontFace ctx "bedstead"
textAlign ctx (S.fromList [AlignCenter, AlignTop]) textAlign ctx (S.fromList [AlignCenter, AlignTop])
fillColor ctx (rgba 255 255 255 255)
textBox ctx 650 575 150 "Play" textBox ctx 650 575 150 "Play"
restore ctx restore ctx
_ -> return () _ -> return ()

View file

@ -27,8 +27,9 @@ data StateData
, mmImgMat :: Matrix (Maybe ImgId) , mmImgMat :: Matrix (Maybe ImgId)
} }
| MenuData | MenuData
{ velocity :: V2 Double { velocity :: V2 Double
, rotation :: Direction , rotation :: Direction
, activate :: Double , activate :: Double
, switchMap :: Double
} }
deriving (Eq) deriving (Eq)

View file

@ -66,12 +66,14 @@ data SubMenu
defaultTranslation :: M.Map GamepadAction Action defaultTranslation :: M.Map GamepadAction Action
defaultTranslation = M.fromList defaultTranslation = M.fromList
[ (ButtonAction 0 SDL.JoyButtonPressed, Activate) [ (ButtonAction 0 SDL.JoyButtonPressed, Activate)
, (ButtonAction 7 SDL.JoyButtonPressed, SwitchMap)
, (AxisAction 1, UpDown 1) , (AxisAction 1, UpDown 1)
, (AxisAction 0, LeftRight 1) , (AxisAction 0, LeftRight 1)
] ]
data Action data Action
= Activate = Activate
| SwitchMap
| UpDown Int | UpDown Int
| LeftRight Int | LeftRight Int
deriving (Show, Eq) deriving (Show, Eq)

View file

@ -302,8 +302,8 @@ emitActionMessage (MsgJoystickButton time _ but SDL.JoyButtonPressed) = do
ud <- getAffection ud <- getAffection
let Subsystems _ _ _ _ t = subsystems ud let Subsystems _ _ _ _ t = subsystems ud
case (translation ud) Map.!? (ButtonAction but SDL.JoyButtonPressed) of case (translation ud) Map.!? (ButtonAction but SDL.JoyButtonPressed) of
Just Activate -> partEmit t (ActionMessage Activate time) Just act -> partEmit t (ActionMessage act time)
_ -> return () _ -> return ()
emitActionMessage _ = return () emitActionMessage _ = return ()
fullClean :: Affection UserData () fullClean :: Affection UserData ()