hunting again

This commit is contained in:
nek0 2018-06-03 04:28:39 +02:00
parent dd6938c7a5
commit 03b84b02db
2 changed files with 35 additions and 11 deletions

View file

@ -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
}

View file

@ -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)