From 2be7479f5147881501dc0d8fe15435b4dffda90b Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 18 Feb 2018 05:31:34 +0100 Subject: [PATCH] try ecstasy --- src/Test.hs | 86 +++++++++++++++++++++++++++++++++++-------- src/Types/UserData.hs | 13 ++++--- 2 files changed, 77 insertions(+), 22 deletions(-) diff --git a/src/Test.hs b/src/Test.hs index 3f7066f..f4ed03c 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -6,10 +6,11 @@ import SDL (get, ($=)) import qualified SDL import qualified Graphics.Rendering.OpenGL as GL hiding (get) -import Control.Monad (when) +import Control.Monad (when, void) import Control.Monad.IO.Class (liftIO) import Data.Matrix (toLists) +import Data.Ecstasy as E import NanoVG hiding (V2(..)) @@ -29,19 +30,27 @@ 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 + void $ newEntity $ defEntity + { pos = Just (V2 20 20) + , vel = Just (V2 0 0) + , player = Just True + } + getWorld uu <- partSubscribe m movePlayer putAffection ud - { stateData = MenuData + { world = nworld + , stateData = MenuData { mapMat = matrix - , initCoords = (0, 500) - , playerCoords = (20, 20) + -- , initCoords = (0, 500) + -- , playerCoords = (20, 20) } , uuid = [uu] } relativizeMouseCoords :: V2 Int32 -> IO (V2 Double) relativizeMouseCoords (V2 ix iy) = do - (GL.Position vx vy, GL.Size vw vh) <- get GL.viewport + (GL.Position vx vy, GL.Size vw vh) <- SDL.get GL.viewport let rx = ix - vx ry = iy - vy hx = fromIntegral vw / 2 @@ -50,19 +59,42 @@ relativizeMouseCoords (V2 ix iy) = do dy = fromIntegral ry - hy return $ V2 (dx / hx) (dy / hy) -movePlayer :: MouseMessage -> Affection UserData () -movePlayer (MsgMouseMotion _ _ _ [SDL.ButtonLeft] mv2@(V2 mx my) _) = do +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 - liftIO $ traceIO $ "delta: " ++ show (V2 rx ry) - liftIO $ traceIO $ "movement: " ++ show (V2 dr dc) + -- (pr, pc) = playerCoords $ stateData ud + nworld <- runSystemT (world ud) $ do + emap $ do + with player + pure $ defEntity' + { vel = Set $ V2 dr dc + } + getWorld putAffection ud - { stateData = (stateData ud) - { playerCoords = (pr - dr, pc - dc) - } + { world = nworld + -- stateData = (stateData ud) + -- { playerCoords = (pr - dr, pc - dc) + -- } + } + +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 + ud <- getAffection + nw <- runSystemT (world ud) $ do + emap $ do + with player + pure $ defEntity' + { vel = Set $ V2 0 0 + } + getWorld + putAffection ud + { world = nw } movePlayer _ = return () @@ -73,12 +105,34 @@ drawMap = do mapM_ (\(i, ls) -> mapM_ (uncurry $ drawTile i) (reverse $ zip [0..] ls)) (zip [0..] (toLists matrix)) +updateMap :: Double -> Affection UserData () +updateMap _ = do + ud <- getAffection + nw <- runSystemT (world ud) $ do + emap $ do + with player + pos' <- E.get pos + vel' <- E.get vel + pure $ defEntity' + { pos = Set $ pos' + vel' + } + getWorld + putAffection ud + { world = nw + } + drawTile :: Int -> Int -> TileState -> Affection UserData () drawTile row col tile = do ud <- getAffection - let ctx = nano ud - (xinit, yinit) = initCoords $ stateData ud - (pr, pc) = playerCoords $ stateData ud + playerPos <- runSystemT (world ud) $ do + efor $ \_ -> do + with player + pos' <- E.get pos + pure pos' + 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 ad1d77b..9513633 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -33,8 +33,8 @@ data StateData = None | MenuData { mapMat :: Matrix TileState - , initCoords :: (Int, Int) - , playerCoords :: (Double, Double) + -- , initCoords :: (Int, Int) + -- , playerCoords :: (Double, Double) } data ImgId @@ -51,10 +51,11 @@ data Direction | SE data Entity f = Entity - { pos :: Component f 'Field (V2 Float) - , vel :: Component f 'Field (V2 Float) - , rot :: Component f 'Field Direction - , player :: Component f 'Unique Bool + { pos :: Component f 'Field (V2 Double) + , gridPos :: Component f 'Field (V2 Int) + , vel :: Component f 'Field (V2 Double) + , rot :: Component f 'Field Direction + , player :: Component f 'Unique Bool } deriving (Generic)