From 153b5a4e3d4e21dfe0a4c4cb9023c76bde74f60b Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 24 Feb 2018 15:33:46 +0100 Subject: [PATCH] now works with ecstasy. ready to merge. --- src/Init.hs | 3 ++- src/StateMachine.hs | 2 +- src/Test.hs | 28 +++++++++++++--------------- src/Types/UserData.hs | 2 +- 4 files changed, 17 insertions(+), 18 deletions(-) diff --git a/src/Init.hs b/src/Init.hs index 6044f3a..6c91df3 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -39,7 +39,7 @@ load = do subs <- Subsystems <$> (Window <$> newTVarIO []) <*> (Mouse <$> newTVarIO []) - w <- runSystemT defWorld getWorld + (ws, w) <- yieldSystemT (0, defWorld) (getWorld) let fc = FloorConfig (20, 45) [(5, 5), (30,80)] (40, 90) floor <- buildHallFloorIO fc traceIO $ show floor @@ -50,5 +50,6 @@ load = do , nano = nvg , uuid = [] , world = w + , worldState = ws , stateData = None } diff --git a/src/StateMachine.hs b/src/StateMachine.hs index a8dab31..aa78f00 100644 --- a/src/StateMachine.hs +++ b/src/StateMachine.hs @@ -11,7 +11,7 @@ import Test instance StateMachine State UserData where smLoad Menu = loadMap - smUpdate Menu = const $ return () + smUpdate Menu = updateMap smDraw Menu = drawMap diff --git a/src/Test.hs b/src/Test.hs index 1b02997..fd9894e 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -30,7 +30,7 @@ loadMap = do let fc = FloorConfig (20, 20) [(5,5), (45, 95)] (50,100) (Subsystems _ m) = subsystems ud matrix <- liftIO $ buildHallFloorIO fc - nworld <- runSystemT (world ud) $ do + (nws, nworld) <- yieldSystemT (worldState ud) $ do void $ newEntity $ defEntity { pos = Just (V2 20 20) , vel = Just (V2 0 0) @@ -40,10 +40,10 @@ loadMap = do uu <- partSubscribe m movePlayer putAffection ud { world = nworld + , worldState = nws , stateData = MenuData { mapMat = matrix , initCoords = (0, 500) - , playerCoords = (20, 20) } , uuid = [uu] } @@ -63,10 +63,9 @@ mouseToPlayer :: V2 Int32 -> Affection UserData () mouseToPlayer mv2 = do ud <- getAffection rela@(V2 rx ry) <- liftIO $ relativizeMouseCoords mv2 - let dr = (- ry) + (- rx) - dc = (- rx) - (- ry) / 2 - (pr, pc) = playerCoords $ stateData ud - nworld <- runSystemT (world ud) $ do + let dr = ry + rx + dc = rx - ry / 2 + (nws, nworld) <- yieldSystemT (worldState ud) $ do emap $ do with player pure $ defEntity' @@ -75,18 +74,16 @@ mouseToPlayer mv2 = do getWorld putAffection ud { world = nworld - , stateData = (stateData ud) - { playerCoords = (pr - dr, pc - dc) - } + , worldState = nws } movePlayer :: MouseMessage -> Affection UserData () movePlayer (MsgMouseMotion _ _ _ [SDL.ButtonLeft] m _) = mouseToPlayer m movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) = mouseToPlayer m -movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) = do +movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ m) = do ud <- getAffection - nw <- runSystemT (world ud) $ do + (nws, nw) <- yieldSystemT (worldState ud) $ do emap $ do with player pure $ defEntity' @@ -95,6 +92,7 @@ movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) = do getWorld putAffection ud { world = nw + , worldState = nws } movePlayer _ = return () @@ -108,7 +106,7 @@ drawMap = do updateMap :: Double -> Affection UserData () updateMap _ = do ud <- getAffection - nw <- runSystemT (world ud) $ do + (nws, nw) <- yieldSystemT (worldState ud) $ do emap $ do with player pos' <- E.get pos @@ -119,20 +117,20 @@ updateMap _ = do getWorld putAffection ud { world = nw + , worldState = nws } drawTile :: Int -> Int -> TileState -> Affection UserData () drawTile row col tile = do ud <- getAffection - playerPos <- runSystemT (world ud) $ do + (_, playerPos) <- yieldSystemT (worldState ud) $ do efor $ \_ -> do with player pos' <- E.get pos pure pos' - let -- V2 pr pc = head playerPos + let V2 pr pc = head playerPos ctx = nano ud (xinit, yinit) = initCoords $ stateData ud - (pr, pc) = playerCoords $ stateData ud tileWidth = 20 :: Double tileHeight = 10 :: Double liftIO $ do diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index 1d45007..fd238a8 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -22,6 +22,7 @@ data UserData = UserData , nano :: Context , uuid :: [UUID] , world :: Entity 'WorldOf + , worldState :: SystemState Entity , stateData :: StateData } @@ -34,7 +35,6 @@ data StateData | MenuData { mapMat :: Matrix TileState , initCoords :: (Int, Int) - , playerCoords :: (Double, Double) } data ImgId