2018-08-10 12:09:07 +00:00
|
|
|
{-# LANGUAGE TypeSynonymInstances #-}
|
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
2019-10-20 08:53:53 +00:00
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
2018-04-14 09:18:37 +00:00
|
|
|
module NPC where
|
|
|
|
|
|
|
|
import Affection as A
|
|
|
|
|
|
|
|
import qualified Data.Matrix as M
|
|
|
|
import Data.Ecstasy as E
|
2018-08-10 23:12:07 +00:00
|
|
|
import Data.Maybe
|
2018-06-04 03:29:20 +00:00
|
|
|
import Data.List (find)
|
2019-03-15 00:41:18 +00:00
|
|
|
import Data.List.Split (splitWhen)
|
2019-10-20 08:53:53 +00:00
|
|
|
import qualified Data.Vector as V
|
2019-10-28 17:20:34 +00:00
|
|
|
import Data.String
|
2018-04-14 09:18:37 +00:00
|
|
|
|
2018-04-14 16:43:05 +00:00
|
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
2018-09-12 22:51:22 +00:00
|
|
|
import Control.Monad.Trans (lift)
|
2022-08-04 16:13:53 +00:00
|
|
|
import Control.Monad.Trans.Resource (ResIO)
|
2018-05-16 14:23:23 +00:00
|
|
|
import Control.Concurrent.MVar
|
2018-06-23 22:43:09 +00:00
|
|
|
import Control.Concurrent (forkIO)
|
2018-04-14 16:43:05 +00:00
|
|
|
|
2018-04-14 09:18:37 +00:00
|
|
|
import Linear
|
|
|
|
|
|
|
|
import System.Random
|
|
|
|
|
|
|
|
-- internal imports
|
|
|
|
|
2018-04-14 11:34:28 +00:00
|
|
|
import Util
|
|
|
|
|
2018-06-04 03:29:20 +00:00
|
|
|
import Types
|
2018-04-14 09:18:37 +00:00
|
|
|
|
2018-08-18 03:01:52 +00:00
|
|
|
import Object ()
|
2018-08-10 12:09:07 +00:00
|
|
|
|
2018-09-12 22:51:22 +00:00
|
|
|
getPosBounds
|
|
|
|
:: SystemT
|
|
|
|
Entity
|
2022-08-04 16:13:53 +00:00
|
|
|
(AffectionState AffectionData ResIO)
|
2018-09-12 22:51:22 +00:00
|
|
|
[(V2 Double, Boundaries Double)]
|
|
|
|
getPosBounds = do
|
|
|
|
efor allEnts $ do
|
|
|
|
with pos
|
|
|
|
with obstacle
|
2019-02-15 19:02:34 +00:00
|
|
|
without ignoreObstacle
|
2018-09-12 22:51:22 +00:00
|
|
|
pos' <- query pos
|
|
|
|
bnds <- query obstacle
|
|
|
|
return (pos', bnds)
|
2018-04-14 16:43:05 +00:00
|
|
|
|
|
|
|
updateNPCs
|
2018-08-10 12:09:07 +00:00
|
|
|
:: M.Matrix (Maybe ImgId)
|
2019-03-15 00:41:18 +00:00
|
|
|
-> M.Matrix TileState
|
2022-08-04 16:13:53 +00:00
|
|
|
-> SystemState Entity (AffectionState AffectionData ResIO)
|
2019-10-20 08:53:53 +00:00
|
|
|
-> V.Vector ReachPoint
|
2018-04-14 16:43:05 +00:00
|
|
|
-> Double
|
2022-08-04 16:13:53 +00:00
|
|
|
-> SystemT Entity (AffectionState AffectionData ResIO) ()
|
2019-03-15 00:41:18 +00:00
|
|
|
updateNPCs imgmat tsmat ws rrp dt = do
|
2018-09-07 21:39:53 +00:00
|
|
|
updateStats dt
|
2018-09-12 22:51:22 +00:00
|
|
|
posbounds <- getPosBounds
|
2018-09-02 08:44:33 +00:00
|
|
|
moent <- catMaybes <$> eover allEnts (do
|
2018-04-14 16:43:05 +00:00
|
|
|
with pos
|
2018-08-10 23:12:07 +00:00
|
|
|
with npcMoveState
|
2018-09-08 12:05:07 +00:00
|
|
|
with npcActionState
|
|
|
|
with npcWorkplace
|
|
|
|
with npcStats
|
2019-02-14 21:31:00 +00:00
|
|
|
with clearanceLvl
|
2018-08-10 23:12:07 +00:00
|
|
|
with vel
|
2018-06-04 03:29:20 +00:00
|
|
|
with rot
|
|
|
|
with anim
|
2018-08-10 12:09:07 +00:00
|
|
|
pos' <- query pos
|
|
|
|
rot' <- query rot
|
2019-02-14 21:31:00 +00:00
|
|
|
lvl <- query clearanceLvl
|
2019-03-15 00:41:18 +00:00
|
|
|
stat <- query anim
|
2018-08-10 23:12:07 +00:00
|
|
|
npcState' <- query npcMoveState
|
2019-10-20 08:53:53 +00:00
|
|
|
let rp = V.filter ((lvl >=) . pointClearance) rrp
|
2018-08-10 23:12:07 +00:00
|
|
|
case npcState' of
|
|
|
|
NPCStanding ttl future -> do
|
|
|
|
let nttl = ttl - dt
|
|
|
|
if nttl > 0
|
|
|
|
then
|
2018-09-02 08:44:33 +00:00
|
|
|
return (Nothing, unchanged
|
2018-08-10 23:12:07 +00:00
|
|
|
{ npcMoveState = Set $ NPCStanding nttl future
|
2018-09-12 22:51:22 +00:00
|
|
|
-- , vel = Set $ V2 0 0
|
2018-08-10 23:12:07 +00:00
|
|
|
})
|
|
|
|
else do
|
|
|
|
mpath <- liftIO $ tryTakeMVar future
|
2018-09-08 12:05:07 +00:00
|
|
|
as <- query npcActionState
|
|
|
|
stats <- query npcStats
|
|
|
|
let nstats = case as of
|
|
|
|
ASDrink -> stats
|
|
|
|
{ statThirst = 0
|
|
|
|
, statDrink = 1
|
|
|
|
}
|
|
|
|
ASEat -> stats
|
|
|
|
{ statHunger = 0
|
|
|
|
, statFood = 1
|
|
|
|
}
|
|
|
|
ASToilet -> stats
|
|
|
|
{ statBladder = 0
|
|
|
|
}
|
|
|
|
_ -> stats
|
2018-08-10 23:12:07 +00:00
|
|
|
case mpath of
|
|
|
|
Just path ->
|
2018-09-02 08:44:33 +00:00
|
|
|
return (Nothing, unchanged
|
2018-08-10 23:12:07 +00:00
|
|
|
{ npcMoveState = Set $ NPCWalking path
|
2018-09-08 12:05:07 +00:00
|
|
|
, npcStats = Set nstats
|
2018-08-10 12:09:07 +00:00
|
|
|
})
|
2018-08-10 23:12:07 +00:00
|
|
|
Nothing ->
|
2018-09-02 08:44:33 +00:00
|
|
|
return (Nothing, unchanged
|
2018-08-10 23:12:07 +00:00
|
|
|
{ npcMoveState = Set $ NPCStanding 1 future
|
2018-08-10 12:09:07 +00:00
|
|
|
})
|
2018-09-02 08:44:33 +00:00
|
|
|
NPCWalking path ->
|
2018-08-10 23:12:07 +00:00
|
|
|
if not (null path)
|
2019-03-15 00:41:18 +00:00
|
|
|
then
|
|
|
|
case head path of
|
|
|
|
[] -> if null (tail path)
|
|
|
|
then standStill imgmat tsmat pos' rot' ws posbounds rp
|
|
|
|
else do
|
|
|
|
(_, accessibles) <- lift $ yieldSystemT ws (getObject pos')
|
2019-10-28 17:20:34 +00:00
|
|
|
liftIO $ logIO
|
|
|
|
A.Verbose
|
|
|
|
("accessibles: " <> fromString (show accessibles))
|
2019-03-15 00:41:18 +00:00
|
|
|
case accessibles of
|
|
|
|
[] -> error ("unknown reason to stop at " ++ show pos')
|
|
|
|
objects -> do
|
|
|
|
rind <- liftIO $ randomRIO (0, length objects - 1)
|
|
|
|
npcent <- queryEnt
|
|
|
|
let (oent, _, _) = objects !! rind
|
|
|
|
mdir =
|
2019-10-20 08:53:53 +00:00
|
|
|
pointDir <$> V.find (\a -> pointCoord a == fmap floor pos') rp
|
2019-03-15 00:41:18 +00:00
|
|
|
return (Just (oent, npcent, Nothing), unchanged
|
|
|
|
{ rot = Set $ fromMaybe rot' mdir
|
|
|
|
, anim = Set stat
|
|
|
|
{ asId = (asId stat)
|
|
|
|
{ aiDirection = fromMaybe rot' mdir
|
|
|
|
}
|
|
|
|
}
|
|
|
|
, vel = Set $ V2 0 0
|
|
|
|
, npcMoveState = Set $ NPCWalking (tail path)
|
|
|
|
})
|
|
|
|
ppath -> do
|
|
|
|
let itarget = fmap (+ 0.5) (fromIntegral <$> head ppath) :: V2 Double
|
|
|
|
if distance pos' itarget < 1.5 * dt
|
|
|
|
then
|
|
|
|
return (Nothing, unchanged
|
|
|
|
{ npcMoveState = Set $ NPCWalking (tail ppath : tail path)
|
|
|
|
})
|
|
|
|
else
|
|
|
|
return (Nothing, unchanged
|
|
|
|
{ vel = Set $ (* 2) <$> signorm (itarget - pos')
|
|
|
|
})
|
2018-08-10 23:12:07 +00:00
|
|
|
else do
|
2019-03-15 00:41:18 +00:00
|
|
|
standStill imgmat tsmat pos' rot' ws posbounds rp
|
|
|
|
)
|
|
|
|
mapM_ (\(oent, npcent, mfuture) -> do
|
2019-01-06 02:52:43 +00:00
|
|
|
mts <- efor (anEnt oent) $ do
|
2018-08-10 23:12:07 +00:00
|
|
|
with objType
|
|
|
|
with objState
|
2018-09-12 22:51:22 +00:00
|
|
|
moub <- queryMaybe objUsedBy
|
2018-08-10 23:12:07 +00:00
|
|
|
otyp <- query objType
|
|
|
|
ostat <- query objState
|
2018-09-12 22:51:22 +00:00
|
|
|
case moub of
|
|
|
|
Nothing -> return $ Just (otyp, ostat)
|
|
|
|
Just uent -> if uent == npcent
|
|
|
|
then return $ Just (otyp, ostat)
|
|
|
|
else return Nothing
|
|
|
|
maybe
|
|
|
|
(return ())
|
|
|
|
(\(t, s) ->
|
|
|
|
setEntity oent =<< objectTransition t s False oent (Just npcent)
|
|
|
|
)
|
2019-01-06 02:52:43 +00:00
|
|
|
(head mts)
|
|
|
|
mntns <- efor (anEnt oent) $ do
|
2018-08-10 23:12:07 +00:00
|
|
|
with objType
|
|
|
|
with objState
|
2018-09-12 22:51:22 +00:00
|
|
|
moub <- queryMaybe objUsedBy
|
2018-08-10 23:12:07 +00:00
|
|
|
otyp <- query objType
|
|
|
|
ostat <- query objState
|
2018-09-12 22:51:22 +00:00
|
|
|
case moub of
|
|
|
|
Nothing -> return $ Just (otyp, ostat)
|
|
|
|
Just uent -> if uent == npcent
|
|
|
|
then return $ Just (otyp, ostat)
|
|
|
|
else return Nothing
|
2018-08-10 23:12:07 +00:00
|
|
|
emap (anEnt npcent) $ do
|
2019-01-06 02:52:43 +00:00
|
|
|
let ttl = case head mntns of
|
2018-09-12 22:51:22 +00:00
|
|
|
Just (nt, ns) -> actionTime nt ns
|
|
|
|
Nothing -> 1
|
2019-03-15 00:41:18 +00:00
|
|
|
maybe
|
|
|
|
(return unchanged)
|
|
|
|
(\future -> return unchanged
|
|
|
|
{ npcMoveState = Set $ NPCStanding ttl future
|
|
|
|
}
|
|
|
|
)
|
|
|
|
mfuture
|
2018-08-10 23:12:07 +00:00
|
|
|
) moent
|
2018-05-16 14:23:23 +00:00
|
|
|
|
2019-03-15 00:41:18 +00:00
|
|
|
standStill
|
|
|
|
:: (MonadIO m, RealFrac a1)
|
|
|
|
=> M.Matrix (Maybe ImgId)
|
|
|
|
-> M.Matrix TileState
|
|
|
|
-> V2 a1
|
|
|
|
-> Direction
|
|
|
|
-> SystemState Entity m
|
|
|
|
-> [(V2 Double, Boundaries Double)]
|
2019-10-20 08:53:53 +00:00
|
|
|
-> V.Vector ReachPoint
|
2019-03-15 00:41:18 +00:00
|
|
|
-> QueryT Entity m (Maybe (Ent, Ent, Maybe (MVar [[V2 Int]])), Entity 'SetterOf)
|
|
|
|
standStill imgmat tsmat pos' rot' ws posbounds rp = do
|
|
|
|
future <- liftIO $ newEmptyMVar
|
|
|
|
stat <- query anim
|
|
|
|
as <- query npcActionState
|
|
|
|
targetRPs <- case as of
|
|
|
|
ASWork ->
|
2019-10-20 08:53:53 +00:00
|
|
|
let fltrd = V.filter (\p -> pointType p == Copier) rp
|
2019-03-15 00:41:18 +00:00
|
|
|
in
|
2019-10-20 08:53:53 +00:00
|
|
|
(V.foldl V.snoc fltrd . V.replicate (5 * V.length fltrd)) <$>
|
2019-03-15 00:41:18 +00:00
|
|
|
query npcWorkplace
|
|
|
|
ASToilet -> do
|
2019-10-20 08:53:53 +00:00
|
|
|
let seekRP = V.filter (\p -> pointType p == Toilet) rp
|
|
|
|
if V.null seekRP
|
|
|
|
then return $ V.filter (\p -> pointType p == Elevator) rp
|
2019-03-15 00:41:18 +00:00
|
|
|
else return seekRP
|
|
|
|
ASDrink -> do
|
2019-10-20 08:53:53 +00:00
|
|
|
let seekRP = V.filter (\p -> pointType p == Drink) rp
|
|
|
|
if V.null seekRP
|
|
|
|
then return $ V.filter (\p -> pointType p == Elevator) rp
|
2019-03-15 00:41:18 +00:00
|
|
|
else return seekRP
|
|
|
|
ASEat -> do
|
2019-10-20 08:53:53 +00:00
|
|
|
let seekRP = V.filter (\p -> pointType p == Eat) rp
|
|
|
|
if V.null seekRP
|
|
|
|
then return $ V.filter (\p -> pointType p == Elevator) rp
|
2019-03-15 00:41:18 +00:00
|
|
|
else return seekRP
|
|
|
|
ASRandWalk ->
|
2019-10-20 08:53:53 +00:00
|
|
|
return $ V.filter (\p -> pointType p /= RoomExit) rp
|
2019-03-15 00:41:18 +00:00
|
|
|
_ <- liftIO $ forkIO $
|
|
|
|
getPath (fmap floor pos') future targetRPs imgmat tsmat posbounds
|
|
|
|
let mdir =
|
|
|
|
pointDir <$> find (\a -> pointCoord a == fmap floor pos') rp
|
|
|
|
(_, accessibles) <- lift $ yieldSystemT ws (getObject pos')
|
2019-10-28 17:20:34 +00:00
|
|
|
liftIO $ logIO A.Verbose ("accessibles: " <> fromString (show accessibles))
|
2019-03-15 00:41:18 +00:00
|
|
|
case accessibles of
|
|
|
|
[] -> do
|
|
|
|
ttl <- liftIO $ randomRIO (5, 30)
|
|
|
|
return (Nothing, unchanged
|
|
|
|
{ npcMoveState = Set $ NPCStanding ttl future
|
|
|
|
, vel = Set $ V2 0 0
|
|
|
|
, rot = Set $ fromMaybe rot' mdir
|
|
|
|
, anim = Set stat
|
|
|
|
{ asId = (asId stat)
|
|
|
|
{ aiDirection = fromMaybe rot' mdir
|
|
|
|
}
|
|
|
|
}
|
|
|
|
})
|
|
|
|
objects -> do
|
|
|
|
rind <- liftIO $ randomRIO (0, length objects - 1)
|
|
|
|
npcent <- queryEnt
|
|
|
|
let (oent, _, _) = objects !! rind
|
|
|
|
return (Just (oent, npcent, Just future), unchanged
|
|
|
|
{ rot = Set $ fromMaybe rot' mdir
|
|
|
|
, anim = Set stat
|
|
|
|
{ asId = (asId stat)
|
|
|
|
{ aiDirection = fromMaybe rot' mdir
|
|
|
|
}
|
|
|
|
}
|
|
|
|
, vel = Set $ V2 0 0
|
|
|
|
})
|
|
|
|
|
2018-09-07 21:39:53 +00:00
|
|
|
updateStats
|
|
|
|
:: Double
|
2022-08-04 16:13:53 +00:00
|
|
|
-> SystemT Entity (AffectionState AffectionData ResIO) ()
|
2018-09-07 21:39:53 +00:00
|
|
|
updateStats dt =
|
|
|
|
emap allEnts $ do
|
|
|
|
with npcStats
|
|
|
|
with npcActionState
|
|
|
|
stat <- query npcStats
|
|
|
|
as <- query npcActionState
|
|
|
|
let nstat = doUpdate stat as
|
|
|
|
return unchanged
|
|
|
|
{ npcStats = Set nstat
|
|
|
|
, npcActionState = Set $ doCompare stat nstat as
|
|
|
|
}
|
|
|
|
where
|
|
|
|
doUpdate stat@(NPCStats conc blad thir hung food drin) as =
|
|
|
|
stat
|
2018-09-08 19:40:05 +00:00
|
|
|
{ statAttention =
|
2018-09-07 21:39:53 +00:00
|
|
|
if as == ASWork
|
2019-02-13 23:20:26 +00:00
|
|
|
then max 0 (conc - 0.05 * dt)
|
|
|
|
else min 1 (conc + 0.1 * dt)
|
2018-09-07 21:39:53 +00:00
|
|
|
, statBladder =
|
|
|
|
if food > 0 || drin > 0
|
2019-03-07 00:33:51 +00:00
|
|
|
then min 1 (blad + 0.01 * dt)
|
2018-09-07 21:39:53 +00:00
|
|
|
else blad
|
|
|
|
, statThirst = min 1 (if drin > 0 then thir else thir + 0.2 * dt)
|
|
|
|
, statHunger = min 1 (if food > 0 then hung else hung + 0.1 * dt)
|
|
|
|
, statFood = max 0 (food - 0.1 * dt)
|
|
|
|
, statDrink = max 0 (drin - 0.2 * dt)
|
|
|
|
}
|
|
|
|
doCompare ostat nstat as
|
2018-09-08 19:40:05 +00:00
|
|
|
| statAttention nstat == 0 = ASRandWalk
|
2018-09-07 21:39:53 +00:00
|
|
|
| statThirst nstat == 0 = ASDrink
|
2019-02-13 23:20:26 +00:00
|
|
|
| statHunger nstat == 0 = ASEat -- TODO: Let them eat
|
2018-09-08 19:40:05 +00:00
|
|
|
| statAttention nstat > statAttention ostat &&
|
|
|
|
statAttention nstat > 0.75 = ASWork
|
2018-09-07 21:39:53 +00:00
|
|
|
| statBladder nstat > 0.9 = ASToilet
|
|
|
|
| otherwise = as
|
|
|
|
|
2018-09-12 22:51:22 +00:00
|
|
|
getObject
|
|
|
|
:: (MonadIO m, RealFrac a1)
|
|
|
|
=> V2 a1
|
2019-02-16 19:38:00 +00:00
|
|
|
-> SystemT Entity m [(Ent, V2 Double, [(V2 Int, Direction)])]
|
2018-09-12 22:51:22 +00:00
|
|
|
getObject npos = do
|
2018-08-10 12:09:07 +00:00
|
|
|
candidates <- efor allEnts $ do
|
|
|
|
with pos
|
|
|
|
with objType
|
|
|
|
with objState
|
|
|
|
with objAccess
|
|
|
|
pos' <- query pos
|
|
|
|
oacc <- query objAccess
|
|
|
|
ent <- queryEnt
|
|
|
|
return (ent, pos', oacc)
|
2019-10-28 17:20:34 +00:00
|
|
|
liftIO $ logIO A.Verbose ("candidates: " <> fromString (show candidates))
|
2018-09-12 22:51:22 +00:00
|
|
|
return $
|
2019-02-16 19:38:00 +00:00
|
|
|
filter (\(_, p, deltaors) ->
|
|
|
|
any (\(delta, _) -> fmap floor p + delta == fmap floor npos) deltaors
|
2018-09-12 22:51:22 +00:00
|
|
|
) candidates
|
2018-05-16 14:23:23 +00:00
|
|
|
|
|
|
|
getPath
|
|
|
|
:: V2 Int
|
2019-03-15 00:41:18 +00:00
|
|
|
-> MVar [[V2 Int]]
|
2019-10-20 08:53:53 +00:00
|
|
|
-> V.Vector ReachPoint
|
2018-05-16 14:23:23 +00:00
|
|
|
-> M.Matrix (Maybe ImgId)
|
2019-03-15 00:41:18 +00:00
|
|
|
-> M.Matrix TileState
|
2018-07-21 19:10:32 +00:00
|
|
|
-> [(V2 Double, Boundaries Double)]
|
2018-05-16 14:23:23 +00:00
|
|
|
-> IO ()
|
2019-03-15 00:41:18 +00:00
|
|
|
getPath pos' mvar rp imgmat tsmat posbounds = do
|
2019-10-20 08:53:53 +00:00
|
|
|
let seekRP = V.filter (\p -> pointType p /= RoomExit) rp
|
|
|
|
ntargeti <- randomRIO (0, V.length seekRP - 1)
|
|
|
|
let ntarget = pointCoord (seekRP V.! ntargeti)
|
2018-07-21 19:10:32 +00:00
|
|
|
path = astarAppl imgmat posbounds ntarget pos'
|
2019-10-28 17:20:34 +00:00
|
|
|
logIO
|
|
|
|
A.Verbose
|
|
|
|
("seeking path from " <>
|
|
|
|
fromString (show pos') <>
|
|
|
|
" to " <>
|
|
|
|
fromString (show ntarget)
|
|
|
|
)
|
2018-05-16 14:23:23 +00:00
|
|
|
case path of
|
2018-09-12 22:51:22 +00:00
|
|
|
Nothing -> do
|
2019-10-28 17:20:34 +00:00
|
|
|
logIO
|
|
|
|
A.Error
|
|
|
|
("No path from " <>
|
|
|
|
fromString (show pos') <>
|
|
|
|
" to " <>
|
|
|
|
fromString ( show ntarget)
|
|
|
|
)
|
2018-09-12 22:51:22 +00:00
|
|
|
putMVar mvar []
|
|
|
|
-- getPath pos' mvar rp imgmat posbounds
|
2019-03-15 00:41:18 +00:00
|
|
|
Just p -> putMVar mvar (chewPath tsmat p)
|
2018-09-07 17:49:16 +00:00
|
|
|
|
|
|
|
getPathTo
|
|
|
|
:: V2 Int
|
2019-03-15 00:41:18 +00:00
|
|
|
-> MVar [[V2 Int]]
|
2018-09-07 17:49:16 +00:00
|
|
|
-> V2 Int
|
|
|
|
-> M.Matrix (Maybe ImgId)
|
2019-03-15 00:41:18 +00:00
|
|
|
-> M.Matrix TileState
|
2018-09-07 17:49:16 +00:00
|
|
|
-> [(V2 Double, Boundaries Double)]
|
|
|
|
-> IO ()
|
2019-03-15 00:41:18 +00:00
|
|
|
getPathTo pos' mvar target imgmat tsmat posbounds = do
|
2018-09-07 17:49:16 +00:00
|
|
|
let path = astarAppl imgmat posbounds target pos'
|
2019-10-28 17:20:34 +00:00
|
|
|
logIO
|
|
|
|
A.Verbose
|
|
|
|
("seeking path from " <>
|
|
|
|
fromString (show pos') <>
|
|
|
|
" to " <>
|
|
|
|
fromString (show target)
|
|
|
|
)
|
2018-09-07 17:49:16 +00:00
|
|
|
case path of
|
|
|
|
Nothing -> do
|
2019-10-28 17:20:34 +00:00
|
|
|
logIO
|
|
|
|
A.Error
|
|
|
|
("No path from " <>
|
|
|
|
fromString (show pos') <>
|
|
|
|
" to " <>
|
|
|
|
fromString (show target)
|
|
|
|
)
|
2019-03-15 00:41:18 +00:00
|
|
|
Just p -> putMVar mvar (chewPath tsmat p)
|
|
|
|
|
|
|
|
simplifyPath :: [V2 Int] -> V2 Int -> [V2 Int]
|
|
|
|
simplifyPath [] a = [a]
|
|
|
|
simplifyPath acc@[_] a = a : acc
|
|
|
|
simplifyPath (b:c:bs) a
|
|
|
|
| ((signorm $ fmap fromIntegral a) - (signorm $ fmap fromIntegral b)) `dot`
|
|
|
|
((signorm $ fmap fromIntegral b) - (signorm $ fmap fromIntegral c)) == (1 :: Double)
|
|
|
|
= a : c : bs
|
|
|
|
| otherwise
|
|
|
|
= a : b : c : bs
|
|
|
|
|
|
|
|
chunkPath :: M.Matrix TileState -> [V2 Int] -> [[V2 Int]]
|
|
|
|
chunkPath tsmat = splitWhen (\(V2 r c) -> tsmat M.! (r, c) == Door)
|
|
|
|
|
|
|
|
chewPath :: M.Matrix TileState -> [V2 Int] -> [[V2 Int]]
|
|
|
|
chewPath tsmat = map (reverse . foldl simplifyPath []) . chunkPath tsmat
|