diff --git a/src/MainGame/MindMap.hs b/src/MainGame/MindMap.hs index 1149714..aee7637 100644 --- a/src/MainGame/MindMap.hs +++ b/src/MainGame/MindMap.hs @@ -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' diff --git a/src/MainGame/WorldMap.hs b/src/MainGame/WorldMap.hs index b53a934..fcc549b 100644 --- a/src/MainGame/WorldMap.hs +++ b/src/MainGame/WorldMap.hs @@ -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 diff --git a/src/Menu/Adjust.hs b/src/Menu/Adjust.hs index 9ae9cd6..e99eca9 100644 --- a/src/Menu/Adjust.hs +++ b/src/Menu/Adjust.hs @@ -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 () diff --git a/src/Menu/Connect.hs b/src/Menu/Connect.hs index 6a74ba7..3669eed 100644 --- a/src/Menu/Connect.hs +++ b/src/Menu/Connect.hs @@ -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 () diff --git a/src/Types/StateData.hs b/src/Types/StateData.hs index 8769b87..f6cbd7a 100644 --- a/src/Types/StateData.hs +++ b/src/Types/StateData.hs @@ -27,8 +27,9 @@ data StateData , mmImgMat :: Matrix (Maybe ImgId) } | MenuData - { velocity :: V2 Double - , rotation :: Direction - , activate :: Double + { velocity :: V2 Double + , rotation :: Direction + , activate :: Double + , switchMap :: Double } deriving (Eq) diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index f9ab08a..42cd28a 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -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) diff --git a/src/Util.hs b/src/Util.hs index 7e37c3c..54771e7 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -302,8 +302,8 @@ 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) - _ -> return () + Just act -> partEmit t (ActionMessage act time) + _ -> return () emitActionMessage _ = return () fullClean :: Affection UserData ()