From efc3a2f7d8d4aed87d6db1cfac8413449fd88ae4 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 25 Feb 2018 02:03:25 +0100 Subject: [PATCH] remove world and add proper collision --- src/Init.hs | 3 +-- src/Test.hs | 60 ++++++++++++++++++++++++------------------- src/Types/UserData.hs | 1 - 3 files changed, 35 insertions(+), 29 deletions(-) diff --git a/src/Init.hs b/src/Init.hs index 75d5a53..8bb5100 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -39,14 +39,13 @@ load = do subs <- Subsystems <$> (Window <$> newTVarIO []) <*> (Mouse <$> newTVarIO []) - (ws, w) <- yieldSystemT (0, defWorld) (getWorld) + (ws, _) <- yieldSystemT (0, defWorld) (return ()) return UserData { state = Menu , subsystems = subs , assetImages = M.empty -- FILLME! , nano = nvg , uuid = [] - , world = w , worldState = ws , stateData = None } diff --git a/src/Test.hs b/src/Test.hs index 26d9633..8ead8cc 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -30,17 +30,15 @@ loadMap = do let fc = FloorConfig (20, 20) [(5,5), (45, 75)] (80,80) (Subsystems _ m) = subsystems ud matrix <- liftIO $ buildHallFloorIO fc - (nws, nworld) <- yieldSystemT (worldState ud) $ do + (nws, _) <- yieldSystemT (worldState 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 - { world = nworld - , worldState = nws + { worldState = nws , stateData = MenuData { mapMat = matrix , initCoords = (0, 500) @@ -65,16 +63,14 @@ mouseToPlayer mv2 = do rela@(V2 rx ry) <- liftIO $ relativizeMouseCoords mv2 let dr = (ry / sin (atan (1/2)) / 2) + rx dc = rx - (ry / sin (atan (1/2)) / 2) - (nws, nworld) <- yieldSystemT (worldState ud) $ do + (nws, _) <- yieldSystemT (worldState ud) $ do emap $ do with player pure $ defEntity' { vel = Set $ V2 dr dc } - getWorld putAffection ud - { world = nworld - , worldState = nws + { worldState = nws } movePlayer :: MouseMessage -> Affection UserData () @@ -83,16 +79,14 @@ movePlayer (MsgMouseButton _ _ SDL.Pressed _ SDL.ButtonLeft _ m) = mouseToPlayer m movePlayer (MsgMouseButton _ _ SDL.Released _ SDL.ButtonLeft _ m) = do ud <- getAffection - (nws, nw) <- yieldSystemT (worldState ud) $ do + (nws, _) <- yieldSystemT (worldState ud) $ do emap $ do with player pure $ defEntity' { vel = Set $ V2 0 0 } - getWorld putAffection ud - { world = nw - , worldState = nws + { worldState = nws } movePlayer _ = return () @@ -106,18 +100,32 @@ drawMap = do updateMap :: Double -> Affection UserData () updateMap dt = do ud <- getAffection - (nws, nw) <- yieldSystemT (worldState ud) $ do + let matrix = mapMat $ stateData ud + (nws, _) <- yieldSystemT (worldState ud) $ do emap $ do - with player - pos' <- E.get pos + with vel + with pos + pos'@(V2 or oc) <- E.get pos vel' <- E.get vel - pure $ defEntity' - { pos = Set $ pos' + fmap (* (4 * dt)) vel' - } - getWorld + let npos@(V2 nr nc) = pos' + fmap (* (4 * dt)) vel' + let ent + | Wall /= matrix M.! (floor nr, floor nc) = + defEntity' + { pos = Set npos + } + | Wall /= matrix M.! (floor nr, floor oc) = + defEntity' + { pos = Set (V2 nr oc) + } + | Wall /= matrix M.! (floor or, floor nc) = + defEntity' + { pos = Set (V2 or nc) + } + | otherwise = + defEntity' + pure ent putAffection ud - { world = nw - , worldState = nws + { worldState = nws } drawTile :: Int -> Int -> TileState -> Affection UserData () @@ -136,10 +144,10 @@ drawTile row col tile = do liftIO $ do save ctx beginPath ctx - let x = realToFrac $ (640 + tileWidth / 2) + ((fromIntegral col - pc) + - (fromIntegral row - pr)) * (tileWidth / 2) - y = realToFrac $ 360 + ((fromIntegral row - pr) - - (fromIntegral col - pc)) * (tileHeight / 2) + let x = realToFrac $ 640 + ((fromIntegral col - pc + 1) + + (fromIntegral row - pr + 1)) * (tileWidth / 2) + y = realToFrac $ 360 + ((fromIntegral row - pr + 1) - + (fromIntegral col - pc + 1)) * (tileHeight / 2) fillColor ctx (case tile of Wall -> rgba 128 128 128 255 Door -> rgba 255 128 128 255 @@ -156,7 +164,7 @@ drawTile row col tile = do lineTo ctx (x + realToFrac tileWidth / 2) (y - realToFrac tileHeight / 2) closePath ctx fill ctx - when (floor pr + 1 == row && floor pc + 1 == col) $ do + when (floor pr + 1 == row && floor pc - 1 == col) $ do beginPath ctx circle ctx 640 360 5 closePath ctx diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index fd238a8..c2b40b9 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -21,7 +21,6 @@ data UserData = UserData , assetImages :: M.Map ImgId Image , nano :: Context , uuid :: [UUID] - , world :: Entity 'WorldOf , worldState :: SystemState Entity , stateData :: StateData }