nek0/tracer
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

further implementation of controller

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

12
src/MainGame/MindMap.hs
View file

@ -26,6 +26,16 @@ updateMind :: Double -> Affection UserData ()
updateMind dt = do
ud <- getAffection
(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
with anim
with mmpos
@ -68,7 +78,7 @@ updateMind dt = do
with rot
with anim
pos'@(V2 pr pc) <- query mmpos
vel' <- query vel
vel' <- query mmvel
rot' <- query rot
stat <- query anim
let npos = pos' + fmap (* dt) vel'

26
src/MainGame/WorldMap.hs
View file

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

12
src/Menu/Adjust.hs
View file

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

58
src/Menu/Connect.hs
View file

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

1
src/Types/StateData.hs
View file

@ -30,5 +30,6 @@ data StateData
{ velocity :: V2 Double
, rotation :: Direction
, activate :: Double
, switchMap :: Double
}
deriving (Eq)

2
src/Types/UserData.hs
View file

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

2
src/Util.hs
View file

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