module Game.LambdaHack.Running
( run, continueRun
) where
import Control.Monad.State hiding (State, state)
import qualified Data.List as L
import qualified Data.IntSet as IS
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Action
import Game.LambdaHack.EffectAction
import Game.LambdaHack.Actions
import Game.LambdaHack.Point
import Game.LambdaHack.Vector
import Game.LambdaHack.PointXY
import Game.LambdaHack.Level
import Game.LambdaHack.Msg
import Game.LambdaHack.Actor
import Game.LambdaHack.ActorState
import Game.LambdaHack.Perception
import Game.LambdaHack.State
import qualified Game.LambdaHack.Tile as Tile
import qualified Game.LambdaHack.Kind as Kind
import qualified Game.LambdaHack.Feature as F
run :: (Vector, Int) -> ActionFrame ()
run (dir, dist) = do
cops <- getCOps
pl <- gets splayer
locHere <- gets (bloc . getPlayerBody)
lvl <- gets slevel
targeting <- gets (ctargeting . scursor)
if targeting /= TgtOff
then do
frs <- moveCursor dir 10
modify (\ s -> s {stakeTime = Just False})
return frs
else do
let accessibleDir loc d = accessible cops lvl loc (loc `shift` d)
distNew = if accessibleDir locHere dir then dist + 1 else dist
updatePlayerBody (\ p -> p { bdir = Just (dir, distNew) })
inFrame $ moveOrAttack False pl dir
data RunMode =
RunOpen
| RunHub
| RunCorridor (Vector, Bool)
| RunDeadEnd
runMode :: Point -> Vector -> (Point -> Vector -> Bool) -> X -> RunMode
runMode loc dir dirEnterable lxsize =
let dirNearby dir1 dir2 = euclidDistSq lxsize dir1 dir2 == 1
dirBackward d = euclidDistSq lxsize (neg dir) d <= 1
dirAhead d = euclidDistSq lxsize dir d <= 2
findOpen =
let f dirC open = open ++
case L.filter (dirNearby dirC) dirsEnterable of
l | dirBackward dirC -> dirC : l
[] -> []
[_] -> []
l -> dirC : l
in L.foldr f []
dirsEnterable = L.filter (dirEnterable loc) (moves lxsize)
in case dirsEnterable of
[] -> assert `failure` (loc, dir)
[negdir] -> assert (negdir == neg dir) $ RunDeadEnd
_ ->
let dirsOpen = findOpen dirsEnterable
dirsCorridor = dirsEnterable L.\\ dirsOpen
in case dirsCorridor of
[] -> RunOpen
_ | L.any dirAhead dirsOpen -> RunOpen
[d] -> RunCorridor (d, False)
[d1, d2] | dirNearby d1 d2 ->
RunCorridor (if diagonal lxsize d1 then d2 else d1, True)
_ -> RunHub
runDisturbance :: Point -> Int -> Report
-> [Actor] -> [Actor] -> Perception -> Point
-> (F.Feature -> Point -> Bool) -> (Point -> Bool) -> X -> Y
-> (Vector, Int) -> Maybe (Vector, Int)
runDisturbance locLast distLast msg hs ms per locHere
locHasFeature locHasItems lxsize lysize (dirNew, distNew) =
let msgShown = not $ nullReport msg
mslocs = IS.delete locHere $ IS.fromList (L.map bloc ms)
enemySeen = not (IS.null (mslocs `IS.intersection` totalVisible per))
surrLast = locLast : vicinity lxsize lysize locLast
surrHere = locHere : vicinity lxsize lysize locHere
locThere = locHere `shift` dirNew
heroThere = locThere `elem` L.map bloc hs
touchList = [ locHasFeature F.Exit
, locHasItems
]
standList = [ locHasFeature F.Path
, not . locHasFeature F.Lit
]
firstList = [ locHasFeature F.Lit
, not . locHasFeature F.Path
]
touchNew fun =
let touchLast = L.filter fun surrLast
touchHere = L.filter fun surrHere
in touchHere L.\\ touchLast
touchExplore fun = touchNew fun == [locThere]
touchStop fun = touchNew fun /= []
standNew fun = L.filter (\ loc -> locHasFeature F.Walkable loc ||
locHasFeature F.Openable loc)
(touchNew fun)
standExplore fun = not (fun locHere) && standNew fun == [locThere]
standStop fun = not (fun locHere) && standNew fun /= []
firstNew fun = L.all (not . fun) surrLast &&
L.any fun surrHere
firstExplore fun = firstNew fun && fun locThere
firstStop = firstNew
tryRunMaybe
| msgShown || enemySeen
|| heroThere || distLast >= 40 = Nothing
| L.any touchExplore touchList = Just (dirNew, 1000)
| L.any standExplore standList = Just (dirNew, 1000)
| L.any firstExplore firstList = Just (dirNew, 1000)
| L.any touchStop touchList = Nothing
| L.any standStop standList = Nothing
| L.any firstStop firstList = Nothing
| otherwise = Just (dirNew, distNew)
in tryRunMaybe
continueRun :: (Vector, Int) -> Action ()
continueRun (dirLast, distLast) = do
cops@Kind.COps{cotile} <- getCOps
locHere <- gets (bloc . getPlayerBody)
per <- getPerception
Diary{sreport} <- getDiary
ms <- gets dangerousList
sfaction <- gets sfaction
hs <- gets (factionList [sfaction])
lvl@Level{lxsize, lysize} <- gets slevel
let locHasFeature f loc = Tile.hasFeature cotile f (lvl `at` loc)
locHasItems loc = not $ L.null $ lvl `atI` loc
locLast = if distLast == 0 then locHere else locHere `shift` neg dirLast
tryRunDist (dir, distNew)
| accessibleDir locHere dir =
maybe abort run $
runDisturbance locLast distLast sreport hs ms per locHere
locHasFeature locHasItems lxsize lysize (dir, distNew)
| otherwise = abort
tryRun dir = tryRunDist (dir, distLast)
tryRunAndStop dir = tryRunDist (dir, 1000)
accessibleDir loc dir = accessible cops lvl loc (loc `shift` dir)
openableDir loc dir = Tile.hasFeature cotile F.Openable
(lvl `at` (loc `shift` dir))
dirEnterable loc d = accessibleDir loc d || openableDir loc d
((), frames) <- case runMode locHere dirLast dirEnterable lxsize of
RunDeadEnd -> abort
RunOpen -> tryRun dirLast
RunHub -> abort
RunCorridor (dirNext, turn) ->
case runMode (locHere `shift` dirNext) dirNext dirEnterable lxsize of
RunDeadEnd -> tryRun dirNext
RunCorridor _ -> tryRun dirNext
RunOpen | turn -> abort
RunHub | turn -> abort
RunOpen -> tryRunAndStop dirNext
RunHub -> tryRunAndStop dirNext
when (not $ null frames) abort