diff --git a/src/NPC.hs b/src/NPC.hs index ea353bb..dce1758 100644 --- a/src/NPC.hs +++ b/src/NPC.hs @@ -160,7 +160,8 @@ updateNPCs imgmat rp dt = else do ttl <- liftIO $ randomRIO (5, 30) future <- liftIO $ newEmptyMVar - _ <- liftIO $ forkOS $ getPath (fmap floor pos') future rp imgmat + -- _ <- liftIO $ forkOS $ getPath (fmap floor pos') future rp imgmat + _ <- liftIO $ getPath (fmap floor pos') future rp imgmat return $ unchanged { npcState = Set $ NPCStanding ttl future } diff --git a/src/Test.hs b/src/Test.hs index 66dd6ca..04bbe4f 100644 --- a/src/Test.hs +++ b/src/Test.hs @@ -16,7 +16,7 @@ import qualified Data.Text as T import Data.Matrix as M import Data.Ecstasy as E import Data.Maybe -import Data.List (sortOn) +import Data.List as L (sortOn, partition) import System.Random (randomRIO) @@ -131,8 +131,7 @@ drawMap = do pc <- fmap head $ efor allEnts $ do with player with pos - pos' <- query pos - pure pos' + query pos posanims <- efor allEnts $ do with anim with pos @@ -149,6 +148,30 @@ drawMap = do 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)] + ) + ) + ) + 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 @@ -165,7 +188,7 @@ drawMap = do fillColor ctx (rgb 255 255 255) fill ctx mapM_ (\(i, ls) -> mapM_ - (uncurry (drawTile ud ctx posanims pr pc i)) + (\(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 @@ -189,8 +212,8 @@ drawTile ud ctx posanims pr pc row col img = ((realToFrac x :: Double) < 1280 && (realToFrac (y - (74 - (realToFrac tileHeight :: CFloat))) :: Double) < 720)) $ do - let lt = Prelude.filter delimiter sorted - ge = Prelude.filter (not . delimiter) sorted + let (lt, ge) = L.partition delimiter filtered + -- ge = Prelude.filter (not . delimiter) sorted save ctx mapM_ drawAnim lt when (isJust img) drawImage @@ -198,8 +221,8 @@ drawTile ud ctx posanims pr pc row col img = restore ctx where delimiter (V2 nr nc, _) = - (any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs && - any (\m -> nc > fromIntegral (floor nc :: Int) + m) mincs) + any (\m -> nr < fromIntegral (floor nr :: Int) + m) maxrs && + any (\m -> nc > fromIntegral (floor nc :: Int) + m) mincs ai = assetImages ud anims = assetAnimations ud tileWidth = 64 :: Double @@ -418,10 +441,10 @@ updateMap dt = do ( concatMap (\(dr, dc) -> - let bs = fromMaybe [] (imgObstacle <$> (M.safeGet + let bs = fromMaybe [] (imgObstacle <$> M.safeGet (fromIntegral $ floor pr + dr) (fromIntegral $ floor pc + dc) - (imgMat (stateData ud)))) + (imgMat (stateData ud))) in Prelude.map (\(Boundaries (minr, minc) (maxr, maxc))-> Boundaries (minr + fromIntegral dr, minc + fromIntegral dc)