From fd8d5d81f017292af967d20841d5a9c43efccc2e Mon Sep 17 00:00:00 2001 From: nek0 Date: Fri, 8 Jun 2018 00:29:46 +0200 Subject: [PATCH] loading screen --- shell.nix | 2 +- src/Init.hs | 10 +- src/NPC.hs | 10 +- src/Test.hs | 576 +++++++++++++++++++++------------------- src/Types/ReachPoint.hs | 2 +- src/Types/StateData.hs | 3 +- src/Types/UserData.hs | 1 + 7 files changed, 321 insertions(+), 283 deletions(-) diff --git a/shell.nix b/shell.nix index 246c47d..a9d8e63 100644 --- a/shell.nix +++ b/shell.nix @@ -79,7 +79,7 @@ let f = { mkDerivation, astar, base, containers, linear , matrix, OpenGL, random, sdl2, stdenv, stm, text, unordered-containers - , vector, JuicyPixels, JuicyPixels-extra, bytestring + , vector, JuicyPixels, JuicyPixels-extra, bytestring, monad-loops }: mkDerivation { pname = "tracer-game"; diff --git a/src/Init.hs b/src/Init.hs index 3fa03bd..f66693e 100644 --- a/src/Init.hs +++ b/src/Init.hs @@ -43,11 +43,13 @@ foreign import ccall unsafe "glewInit" load :: IO UserData load = do - _ <- glewInit - nvg <- createGL3 (S.fromList [Antialias, StencilStrokes]) subs <- Subsystems <$> (Window <$> newTVarIO []) <*> (Mouse <$> newTVarIO []) + _ <- glewInit + nvg <- createGL3 (S.fromList [Antialias, StencilStrokes]) + _ <- createFont nvg "bedstead" + (FileName "assets/font/Bedstead-Semicondensed.ttf") (ws, _) <- yieldSystemT (0, defStorage) (return ()) mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0 mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0 @@ -66,10 +68,8 @@ load = do mmisctable3 <- createImage nvg (FileName "assets/misc/table3.png") 0 mmisctable4 <- createImage nvg (FileName "assets/misc/table4.png") 0 mmisctableC <- createImage nvg (FileName "assets/misc/tableCorner.png") 0 - _ <- createFont nvg "bedstead" - (FileName "assets/font/Bedstead-Semicondensed.ttf") let mimgs = [ mwallasc, mwalldesc, - mwallcornern, mwallcornere, mwallcorners, mwallcornerw, + mwallcornern, mwallcornere, mwallcorners, mwallcornerw, mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross, mmiscbox1, mmisctable1, mmisctable2, mmisctable3, mmisctable4, mmisctableC diff --git a/src/NPC.hs b/src/NPC.hs index ec72308..c2caa01 100644 --- a/src/NPC.hs +++ b/src/NPC.hs @@ -81,21 +81,21 @@ placeNPCs -> [ReachPoint] -> [Graph] -> Int - -> Affection UserData [V2 Double] + -> IO [V2 Double] placeNPCs imgmat tilemat rp gr count = doPlace 1 [] where - doPlace :: Int -> [V2 Double] -> Affection UserData [V2 Double] + doPlace :: Int -> [V2 Double] -> IO [V2 Double] doPlace nr acc = do if nr <= count then do - r <- liftIO $ randomRIO (1, M.nrows imgmat) - c <- liftIO $ randomRIO (1, M.ncols imgmat) + r <- randomRIO (1, M.nrows imgmat) + c <- randomRIO (1, M.ncols imgmat) if null (imgObstacle $ imgmat M.! (r, c)) && tilemat M.! (r, c) == Hall then doPlace (nr + 1) ((V2 (fromIntegral r) (fromIntegral c)) : acc) else do - i <- liftIO $ randomRIO (0, length nonexits - 1) + i <- randomRIO (0, length nonexits - 1) doPlace (nr + 1) ((fmap fromIntegral $ pointCoord (nonexits !! i)) : acc) diff --git a/src/Test.hs b/src/Test.hs index 550956d..346a10e 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -8,7 +8,7 @@ import NanoVG hiding (V2(..)) import Control.Monad (when, void) import Control.Monad.IO.Class (liftIO) import Control.Concurrent.MVar -import Control.Concurrent (forkOS) +import Control.Concurrent (forkIO) import Data.Map.Strict as Map import qualified Data.Set as S @@ -35,12 +35,33 @@ import NPC loadMap :: Affection UserData () loadMap = do ud <- getAffection + let (Subsystems _ m) = subsystems ud + ctx = nano ud + uu <- partSubscribe m movePlayer + future <- liftIO $ newEmptyMVar + _ <- liftIO $ forkIO $ loadMapFork ud future + -- liftIO $ whileM_ (isJust <$> tryTakeMVar future) $ do + -- beginFrame (nano ud) 1280 720 1 + -- fontSize ctx 100 + -- fontFace ctx (assetFonts ud Map.! FontBedstead) + -- textAlign ctx (S.fromList [AlignCenter,AlignTop]) + -- fillColor ctx (rgb 255 128 0) + -- textBox ctx 0 300 1280 ("Loading") + -- endFrame (nano ud) + -- (nws, mendat) <- liftIO $ takeMVar future + putAffection ud + { stateData = None + , uuid = [uu] + , menuMVar = future + } + +loadMapFork :: UserData -> MVar (SystemState Entity IO, StateData) -> IO () +loadMapFork ud future = do let fc = FloorConfig (10, 10) [] (50, 50) - (Subsystems _ m) = subsystems ud - (mat, gr) <- liftIO $ buildHallFloorIO fc + (mat, gr) <- buildHallFloorIO fc let imgmat = convertTileToImg mat exits = Prelude.foldl (\acc coord@(r, c) -> if imgmat M.! coord == Just ImgEmpty @@ -49,12 +70,12 @@ loadMap = do ) [] ((,) <$> [1 .. nrows mat] <*> [1 .. ncols mat]) - (inter, rps) <- liftIO $ placeInteriorIO mat imgmat exits gr - liftIO $ logIO A.Debug ("number of reachpoints: " ++ show (length rps)) + (inter, rps) <- placeInteriorIO mat imgmat exits gr + logIO A.Debug ("number of reachpoints: " ++ show (length rps)) let nnex = Prelude.filter (\p -> pointType p /= RoomExit) rps npcposs <- placeNPCs inter mat rps gr 50 -- (length nnex) - liftIO $ A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs) - (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do + A.logIO A.Debug $ "number of placed NPCs: " ++ show (length npcposs) + (nws, _) <- yieldSystemT (worldState ud) $ do void $ createEntity $ newEntity { pos = Just (V2 10.5 10.5) , vel = Just (V2 0 0) @@ -65,7 +86,7 @@ loadMap = do void $ mapM_ (\npcpos@(V2 nr nc) -> do fact <- liftIO $ randomRIO (0.5, 1.5) future <- liftIO newEmptyMVar - _ <- liftIO $ forkOS $ getPath (fmap floor npcpos) future nnex inter + _ <- liftIO $ forkIO $ getPath (fmap floor npcpos) future nnex inter void $ createEntity $ newEntity { pos = Just (V2 (nr + 0.5) (nc + 0.5)) , vel = Just (V2 0 0) @@ -75,10 +96,7 @@ loadMap = do , anim = Just $ AnimState (AnimId 0 "standing" SE) 0 0 } ) npcposs - uu <- partSubscribe m movePlayer - putAffection ud - { worldState = nws - , stateData = MenuData + putMVar future (nws, MenuData { mapMat = mat , imgMat = M.fromList (nrows inter) (ncols inter) $ Prelude.map @@ -86,9 +104,7 @@ loadMap = do (M.toList inter) , initCoords = (0, 500) , reachPoints = rps - } - , uuid = [uu] - } + }) mouseToPlayer :: V2 Int32 -> Affection UserData () mouseToPlayer mv2 = do @@ -126,76 +142,86 @@ movePlayer _ = return () drawMap :: Affection UserData () drawMap = do ud <- getAffection - dt <- getDelta - (_, (playerPos, posanims)) <- liftIO $ yieldSystemT (worldState ud) $ do - pc <- fmap head $ efor allEnts $ do - with player - with pos - query pos - posanims <- efor allEnts $ do - with anim - with pos - stat <- query anim - pos' <- query pos - return (pos', stat) - return (pc, posanims) - let V2 pr pc = playerPos - mat = imgMat (stateData ud) - ctx = nano ud - cols = fromIntegral (ncols mat) - rows = fromIntegral (nrows mat) - tileWidth = 64 :: Double - tileHeight = 32 :: Double - x = realToFrac $ 640 + ((1 - pc) + (1 - pr)) * (tileWidth / 2) - y = realToFrac $ 360 + ((1 - pr) - (1 - pc)) * (tileHeight / 2) - partposanims = M.fromList - (nrows $ mapMat $ stateData ud) - (ncols $ mapMat $ stateData ud) - ((reverse . fst) - (Prelude.foldl - (\(done, proc) coord -> - let (ndone, nproc) = processList proc coord - in (ndone : done, nproc) + let ctx = nano ud + case stateData ud of + None -> liftIO $ do + beginFrame (nano ud) 1280 720 1 + fontSize ctx 100 + fontFace ctx (assetFonts ud Map.! FontBedstead) + textAlign ctx (S.fromList [AlignCenter,AlignTop]) + fillColor ctx (rgb 255 128 0) + textBox ctx 0 300 1280 ("Loading") + endFrame (nano ud) + _ -> do + dt <- getDelta + (_, (playerPos, posanims)) <- liftIO $ yieldSystemT (worldState ud) $ do + pc <- fmap head $ efor allEnts $ do + with player + with pos + query pos + posanims <- efor allEnts $ do + with anim + with pos + stat <- query anim + pos' <- query pos + return (pos', stat) + return (pc, posanims) + let V2 pr pc = playerPos + mat = imgMat (stateData ud) + cols = fromIntegral (ncols mat) + rows = fromIntegral (nrows mat) + tileWidth = 64 :: Double + tileHeight = 32 :: Double + x = realToFrac $ 640 + ((1 - pc) + (1 - pr)) * (tileWidth / 2) + y = realToFrac $ 360 + ((1 - pr) - (1 - pc)) * (tileHeight / 2) + partposanims = M.fromList + (nrows $ mapMat $ stateData ud) + (ncols $ mapMat $ stateData ud) + ((reverse . fst) + (Prelude.foldl + (\(done, proc) coord -> + let (ndone, nproc) = processList proc coord + in (ndone : done, nproc) + ) + ([], posanims) + ((,) + <$> [1 .. (nrows $ mapMat $ stateData ud)] + <*> [1 .. (ncols $ mapMat $ stateData ud)] + ) + ) ) - ([], posanims) - ((,) - <$> [1 .. (nrows $ mapMat $ stateData ud)] - <*> [1 .. (ncols $ mapMat $ stateData ud)] - ) - ) - ) - processList - :: [(V2 Double, AnimState)] - -> (Int, Int) - -> ([(V2 Double, AnimState)], [(V2 Double, AnimState)]) - processList list coord@(r, c) = - let delimiter (V2 nr nc, _) = - floor nr == r && floor nc == c - in L.partition delimiter list - liftIO $ do -- draw floor - beginPath ctx - moveTo ctx (x + realToFrac tileWidth / 2) y - lineTo ctx - (x + cols * (realToFrac tileWidth / 2)) - (y - (realToFrac tileHeight / 2) * (cols - 1)) - lineTo ctx - (x + (realToFrac tileWidth / 2) * (cols + rows - 1)) - (y + (rows - cols) * (realToFrac tileHeight / 2)) - lineTo ctx - (x + (realToFrac tileWidth / 2) * rows) - (y + (realToFrac tileHeight / 2) * (rows - 1)) - closePath ctx - fillColor ctx (rgb 255 255 255) - fill ctx - mapM_ (\(i, ls) -> mapM_ - (\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t) - (reverse $ zip [1..] ls)) - (zip [1..] (toLists mat)) - fontSize ctx 20 - fontFace ctx (assetFonts ud Map.! FontBedstead) - textAlign ctx (S.fromList [AlignCenter,AlignTop]) - fillColor ctx (rgb 255 128 0) - textBox ctx 0 0 200 ("FPS: " `T.append` T.pack (Prelude.take 5 $ show (1/dt))) + processList + :: [(V2 Double, AnimState)] + -> (Int, Int) + -> ([(V2 Double, AnimState)], [(V2 Double, AnimState)]) + processList list coord@(r, c) = + let delimiter (V2 nr nc, _) = + floor nr == r && floor nc == c + in L.partition delimiter list + liftIO $ do -- draw floor + beginPath ctx + moveTo ctx (x + realToFrac tileWidth / 2) y + lineTo ctx + (x + cols * (realToFrac tileWidth / 2)) + (y - (realToFrac tileHeight / 2) * (cols - 1)) + lineTo ctx + (x + (realToFrac tileWidth / 2) * (cols + rows - 1)) + (y + (rows - cols) * (realToFrac tileHeight / 2)) + lineTo ctx + (x + (realToFrac tileWidth / 2) * rows) + (y + (realToFrac tileHeight / 2) * (rows - 1)) + closePath ctx + fillColor ctx (rgb 255 255 255) + fill ctx + mapM_ (\(i, ls) -> mapM_ + (\(j, t) -> drawTile ud ctx (partposanims M.! (i, j)) pr pc i j t) + (reverse $ zip [1..] ls)) + (zip [1..] (toLists mat)) + fontSize ctx 20 + fontFace ctx (assetFonts ud Map.! FontBedstead) + textAlign ctx (S.fromList [AlignCenter,AlignTop]) + fillColor ctx (rgb 255 128 0) + textBox ctx 0 0 200 ("FPS: " `T.append` T.pack (Prelude.take 5 $ show (1/dt))) drawTile :: UserData @@ -268,203 +294,213 @@ drawTile ud ctx posanims pr pc row col img = updateMap :: Double -> Affection UserData () updateMap dt = do - let direction :: V2 Double -> Direction -> Direction - direction vel'@(V2 vr _) rot' = if sqrt (vel' `dot` vel') > 0 - then - let xuu = - acos ((vel' `dot` V2 0 1) / sqrt (vel' `dot` vel')) / pi * 180 - xu = if vr < 0 then 360 - xuu else xuu - d - | xu < 22.5 = NE - | xu > 22.5 && xu < 67.5 = E - | xu > 67.5 && xu < 112.5 = SE - | xu > 112.5 && xu < 157.5 = S - | xu > 157.5 && xu < 202.5 = SW - | xu > 202.5 && xu < 247.5 = W - | xu > 247.5 && xu < 292.5 = NW - | xu > 292.5 && xu < 337.5 = N - | xu > 337.5 = NE - | otherwise = NE - in d - else rot' ud <- getAffection - (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do - emap allEnts $ do - with anim - stat <- query anim - let an = assetAnimations ud Map.! asId stat - ntime = asElapsedTime stat + dt - nstate = if ntime > fromIntegral (asCurrentFrame stat) * - (animDuration an / fromIntegral (length $ animSprites an)) - then - let nframe = asCurrentFrame stat + 1 - in case animPlay an of - APLoop -> - let (nnframe, nntime) = - if nframe >= length (animSprites an) - then (0, 0) - else (nframe, ntime) - in stat - { asCurrentFrame = nnframe - , asElapsedTime = nntime - } - APOnce -> - let nnframe = if nframe >= length (animSprites an) - then nframe - 1 - else nframe - in stat - { asCurrentFrame = nnframe - , asElapsedTime = ntime - } - else - stat - { asElapsedTime = ntime - } - return $ unchanged - { anim = Set nstate - } - emap allEnts $ do - without player - with vel - with velFact - with pos - with rot - with anim - pos' <- query pos - vel' <- query vel - rot' <- query rot - fact' <- query velFact - stat <- query anim - let npos = pos' + fmap (* (dt * fact')) vel' - aId = asId stat - nstat = case aiName aId of - "walking" - | sqrt (vel' `dot` vel') > 0 -> + isFut <- liftIO $ isEmptyMVar (menuMVar ud) + if not isFut && stateData ud == None + then do + Just (nws, mendat) <- liftIO $ tryTakeMVar (menuMVar ud) + putAffection ud + { worldState = nws + , stateData = mendat + } + else do + let direction :: V2 Double -> Direction -> Direction + direction vel'@(V2 vr _) rot' = if sqrt (vel' `dot` vel') > 0 + then + let xuu = + acos ((vel' `dot` V2 0 1) / + sqrt (vel' `dot` vel')) / pi * 180 + xu = if vr < 0 then 360 - xuu else xuu + d + | xu < 22.5 = NE + | xu > 22.5 && xu < 67.5 = E + | xu > 67.5 && xu < 112.5 = SE + | xu > 112.5 && xu < 157.5 = S + | xu > 157.5 && xu < 202.5 = SW + | xu > 202.5 && xu < 247.5 = W + | xu > 247.5 && xu < 292.5 = NW + | xu > 292.5 && xu < 337.5 = N + | xu > 337.5 = NE + | otherwise = NE + in d + else rot' + (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do + emap allEnts $ do + with anim + stat <- query anim + let an = assetAnimations ud Map.! asId stat + ntime = asElapsedTime stat + dt + nstate = if ntime > fromIntegral (asCurrentFrame stat) * + (animDuration an / fromIntegral (length $ animSprites an)) + then + let nframe = asCurrentFrame stat + 1 + in case animPlay an of + APLoop -> + let (nnframe, nntime) = + if nframe >= length (animSprites an) + then (0, 0) + else (nframe, ntime) + in stat + { asCurrentFrame = nnframe + , asElapsedTime = nntime + } + APOnce -> + let nnframe = if nframe >= length (animSprites an) + then nframe - 1 + else nframe + in stat + { asCurrentFrame = nnframe + , asElapsedTime = ntime + } + else stat - { asId = aId - { aiDirection = direction vel' rot' - } + { asElapsedTime = ntime } - | otherwise -> - stat - { asId = aId - { aiDirection = direction vel' rot' - , aiName = "standing" + return $ unchanged + { anim = Set nstate + } + emap allEnts $ do + without player + with vel + with velFact + with pos + with rot + with anim + pos' <- query pos + vel' <- query vel + rot' <- query rot + fact' <- query velFact + stat <- query anim + let npos = pos' + fmap (* (dt * fact')) vel' + aId = asId stat + nstat = case aiName aId of + "walking" + | sqrt (vel' `dot` vel') > 0 -> + stat + { asId = aId + { aiDirection = direction vel' rot' + } } - , asCurrentFrame = 0 - } - "standing" - | sqrt (vel' `dot` vel') > 0 -> - stat - { asId = aId - { aiDirection = direction vel' rot' - , aiName = "walking" + | otherwise -> + stat + { asId = aId + { aiDirection = direction vel' rot' + , aiName = "standing" + } + , asCurrentFrame = 0 } - , asCurrentFrame = 0 - } - | otherwise -> - stat - { asId = aId - { aiDirection = direction vel' rot' + "standing" + | sqrt (vel' `dot` vel') > 0 -> + stat + { asId = aId + { aiDirection = direction vel' rot' + , aiName = "walking" + } + , asCurrentFrame = 0 } - } - x -> error ("unknown animation name" ++ x) - ent = unchanged - { pos = Set npos - , rot = Set $ direction vel' rot' - , anim = Set nstat - } - return ent - emap allEnts $ do - with player - with vel - with pos - with rot - with anim - pos'@(V2 pr pc) <- query pos - vel' <- query vel - rot' <- query rot - stat <- query anim - let npos = pos' + fmap (* dt) vel' - dpos@(V2 dpr dpc) = npos - pos' - aId = asId stat - nstat = case aiName aId of - "walking" - | sqrt (colldpos `dot` colldpos) > 0 -> - stat - { asId = aId - { aiDirection = direction vel' rot' + | otherwise -> + stat + { asId = aId + { aiDirection = direction vel' rot' + } } - } - | otherwise -> - stat - { asId = aId - { aiDirection = direction vel' rot' - , aiName = "standing" + x -> error ("unknown animation name" ++ x) + ent = unchanged + { pos = Set npos + , rot = Set $ direction vel' rot' + , anim = Set nstat + } + return ent + emap allEnts $ do + with player + with vel + with pos + with rot + with anim + pos'@(V2 pr pc) <- query pos + vel' <- query vel + rot' <- query rot + stat <- query anim + let npos = pos' + fmap (* dt) vel' + dpos@(V2 dpr dpc) = npos - pos' + aId = asId stat + nstat = case aiName aId of + "walking" + | sqrt (colldpos `dot` colldpos) > 0 -> + stat + { asId = aId + { aiDirection = direction vel' rot' + } } - , asCurrentFrame = 0 - } - "standing" - | sqrt (colldpos `dot` colldpos) > 0 -> - stat - { asId = aId - { aiDirection = direction vel' rot' - , aiName = "walking" + | otherwise -> + stat + { asId = aId + { aiDirection = direction vel' rot' + , aiName = "standing" + } + , asCurrentFrame = 0 } - , asCurrentFrame = 0 - } - | otherwise -> - stat - { asId = aId - { aiDirection = direction vel' rot' + "standing" + | sqrt (colldpos `dot` colldpos) > 0 -> + stat + { asId = aId + { aiDirection = direction vel' rot' + , aiName = "walking" + } + , asCurrentFrame = 0 } - } - x -> error ("unknown animation name" ++ x) - len = sqrt (dpos `dot` dpos) - lll = (,) - <$> ( - if dpr < 0 - then [(floor dpr :: Int) .. 0] - else [0 .. (ceiling dpr :: Int)]) - <*> ( - if dpc < 0 - then [(floor dpc :: Int) .. 0] - else [0 .. (ceiling dpc :: Int)]) - colldpos = dpos * Prelude.foldl - (\acc a -> let ret = checkBoundsCollision2 pos' npos dt acc a - in A.log A.Verbose (show ret) ret) - (V2 1 1) - ( - concatMap - (\(dr, dc) -> - let bs = fromMaybe [] (imgObstacle <$> M.safeGet - (fromIntegral $ floor pr + dr) - (fromIntegral $ floor pc + dc) - (imgMat (stateData ud))) - in Prelude.map (\(Boundaries (minr, minc) (maxr, maxc))-> - Boundaries - (minr + fromIntegral dr, minc + fromIntegral dc) - (maxr + fromIntegral dr, maxc + fromIntegral dc) - ) bs + | otherwise -> + stat + { asId = aId + { aiDirection = direction vel' rot' + } + } + x -> error ("unknown animation name" ++ x) + len = sqrt (dpos `dot` dpos) + lll = (,) + <$> ( + if dpr < 0 + then [(floor dpr :: Int) .. 0] + else [0 .. (ceiling dpr :: Int)]) + <*> ( + if dpc < 0 + then [(floor dpc :: Int) .. 0] + else [0 .. (ceiling dpc :: Int)]) + colldpos = dpos * Prelude.foldl + (\acc a -> let ret = checkBoundsCollision2 pos' npos dt acc a + in A.log A.Verbose (show ret) ret) + (V2 1 1) + ( + concatMap + (\(dr, dc) -> + let bs = fromMaybe [] (imgObstacle <$> M.safeGet + (fromIntegral $ floor pr + dr) + (fromIntegral $ floor pc + dc) + (imgMat (stateData ud))) + in Prelude.map (\(Boundaries (minr, minc) (maxr, maxc))-> + Boundaries + (minr + fromIntegral dr, minc + fromIntegral dc) + (maxr + fromIntegral dr, maxc + fromIntegral dc) + ) bs + ) + lll -- (A.log A.Verbose (show lll ++ " " ++ show len) lll) ) - lll -- (A.log A.Verbose (show lll ++ " " ++ show len) lll) - ) - ent = unchanged - { pos = Set $ pos' + colldpos - , rot = Set (direction vel' rot') - , anim = Set nstat - } - return ent - updateNPCs - (imgMat $ stateData ud) - (Prelude.filter - (\p -> pointType p /= RoomExit) - (reachPoints $ stateData ud) - ) - dt - putAffection ud - { worldState = nws - } + ent = unchanged + { pos = Set $ pos' + colldpos + , rot = Set (direction vel' rot') + , anim = Set nstat + } + return ent + updateNPCs + (imgMat $ stateData ud) + (Prelude.filter + (\p -> pointType p /= RoomExit) + (reachPoints $ stateData ud) + ) + dt + putAffection ud + { worldState = nws + } checkBoundsCollision2 :: V2 Double diff --git a/src/Types/ReachPoint.hs b/src/Types/ReachPoint.hs index 5746924..cceaee2 100644 --- a/src/Types/ReachPoint.hs +++ b/src/Types/ReachPoint.hs @@ -8,7 +8,7 @@ data ReachPoint = ReachPoint , pointCoord :: V2 Int , pointDir :: Direction } - deriving (Show) + deriving (Eq, Show) data PointType = RoomExit diff --git a/src/Types/StateData.hs b/src/Types/StateData.hs index cfb65dc..f732e37 100644 --- a/src/Types/StateData.hs +++ b/src/Types/StateData.hs @@ -7,10 +7,11 @@ import Types.Map import Types.ImgId data StateData - = None + = None | MenuData { mapMat :: Matrix TileState , initCoords :: (Int, Int) , imgMat :: Matrix (Maybe ImgId) , reachPoints :: [ReachPoint] } + deriving (Eq) diff --git a/src/Types/UserData.hs b/src/Types/UserData.hs index f959886..e77e3d4 100644 --- a/src/Types/UserData.hs +++ b/src/Types/UserData.hs @@ -32,6 +32,7 @@ data UserData = UserData , uuid :: [UUID] , worldState :: SystemState Entity IO , stateData :: StateData + , menuMVar :: MVar (SystemState Entity IO, StateData) } data State