{-# LANGUAGE RankNTypes #-}
module Game.LambdaHack.Client.UI.RunM
( continueRun
#ifdef EXPOSE_INTERNAL
, continueRunDir, walkableDir, tryTurning, checkAndRun
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import GHC.Exts (inline)
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.Request
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.Msg
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.TileKind (TileKind)
import Game.LambdaHack.Definition.Defs
continueRun :: MonadClientUI m
=> LevelId -> RunParams
-> m (Either Text RequestTimed)
continueRun :: forall (m :: * -> *).
MonadClientUI m =>
LevelId -> RunParams -> m (Either Text RequestTimed)
continueRun LevelId
arena RunParams
paramOld = case RunParams
paramOld of
RunParams{ runMembers :: RunParams -> [ActorId]
runMembers = []
, runStopMsg :: RunParams -> Maybe Text
runStopMsg = Just Text
stopMsg } -> Either Text RequestTimed -> m (Either Text RequestTimed)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text RequestTimed -> m (Either Text RequestTimed))
-> Either Text RequestTimed -> m (Either Text RequestTimed)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text RequestTimed
forall a b. a -> Either a b
Left Text
stopMsg
RunParams{ runMembers :: RunParams -> [ActorId]
runMembers = []
, runStopMsg :: RunParams -> Maybe Text
runStopMsg = Maybe Text
Nothing } ->
Either Text RequestTimed -> m (Either Text RequestTimed)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text RequestTimed -> m (Either Text RequestTimed))
-> Either Text RequestTimed -> m (Either Text RequestTimed)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text RequestTimed
forall a b. a -> Either a b
Left Text
"selected actors no longer there"
RunParams{ ActorId
runLeader :: ActorId
runLeader :: RunParams -> ActorId
runLeader
, runMembers :: RunParams -> [ActorId]
runMembers = ActorId
r : [ActorId]
rs
, Bool
runInitial :: Bool
runInitial :: RunParams -> Bool
runInitial
, Maybe Text
runStopMsg :: RunParams -> Maybe Text
runStopMsg :: Maybe Text
runStopMsg } -> do
let runInitialNew :: Bool
runInitialNew = Bool
runInitial Bool -> Bool -> Bool
&& ActorId
r ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
runLeader
paramIni :: RunParams
paramIni = RunParams
paramOld {runInitial = runInitialNew}
Bool
onLevel <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
r LevelId
arena
Bool
onLevelLeader <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
runLeader LevelId
arena
if | Bool -> Bool
not Bool
onLevel -> do
let paramNew :: RunParams
paramNew = RunParams
paramIni {runMembers = rs }
LevelId -> RunParams -> m (Either Text RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> RunParams -> m (Either Text RequestTimed)
continueRun LevelId
arena RunParams
paramNew
| Bool -> Bool
not Bool
onLevelLeader -> do
let paramNew :: RunParams
paramNew = RunParams
paramIni {runLeader = r}
LevelId -> RunParams -> m (Either Text RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> RunParams -> m (Either Text RequestTimed)
continueRun LevelId
arena RunParams
paramNew
| Bool
otherwise -> do
Either Text Vector
mdirOrRunStopMsgCurrent <- RunParams -> m (Either Text Vector)
forall (m :: * -> *).
MonadClientUI m =>
RunParams -> m (Either Text Vector)
continueRunDir RunParams
paramOld
let runStopMsgCurrent :: Maybe Text
runStopMsgCurrent =
(Text -> Maybe Text)
-> (Vector -> Maybe Text) -> Either Text Vector -> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Maybe Text
forall a. a -> Maybe a
Just (Maybe Text -> Vector -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Either Text Vector
mdirOrRunStopMsgCurrent
runStopMsgNew :: Maybe Text
runStopMsgNew = Maybe Text
runStopMsg Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe Text
runStopMsgCurrent
runMembersNew :: [ActorId]
runMembersNew = if Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
runStopMsgNew then [ActorId]
rs else [ActorId]
rs [ActorId] -> [ActorId] -> [ActorId]
forall a. [a] -> [a] -> [a]
++ [ActorId
r]
paramNew :: RunParams
paramNew = RunParams
paramIni { runMembers = runMembersNew
, runStopMsg = runStopMsgNew }
case Either Text Vector
mdirOrRunStopMsgCurrent of
Left Text
_ -> LevelId -> RunParams -> m (Either Text RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> RunParams -> m (Either Text RequestTimed)
continueRun LevelId
arena RunParams
paramNew
Right Vector
dir -> do
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
updateClientLeader ActorId
r
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {srunning = Just paramNew}
Either Text RequestTimed -> m (Either Text RequestTimed)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text RequestTimed -> m (Either Text RequestTimed))
-> Either Text RequestTimed -> m (Either Text RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> Either Text RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> Either Text RequestTimed)
-> RequestTimed -> Either Text RequestTimed
forall a b. (a -> b) -> a -> b
$ Vector -> RequestTimed
ReqMove Vector
dir
continueRunDir :: MonadClientUI m
=> RunParams -> m (Either Text Vector)
continueRunDir :: forall (m :: * -> *).
MonadClientUI m =>
RunParams -> m (Either Text Vector)
continueRunDir RunParams
params = case RunParams
params of
RunParams{ runMembers :: RunParams -> [ActorId]
runMembers = [] } -> [Char] -> m (Either Text Vector)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Either Text Vector))
-> [Char] -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> RunParams -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` RunParams
params
RunParams{ ActorId
runLeader :: RunParams -> ActorId
runLeader :: ActorId
runLeader
, runMembers :: RunParams -> [ActorId]
runMembers = ActorId
aid : [ActorId]
_
, Bool
runInitial :: RunParams -> Bool
runInitial :: Bool
runInitial } -> do
Report
report <- (SessionUI -> Report) -> m Report
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Report) -> m Report)
-> (SessionUI -> Report) -> m Report
forall a b. (a -> b) -> a -> b
$ History -> Report
newReport (History -> Report)
-> (SessionUI -> History) -> SessionUI -> Report
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> History
shistory
let msgInterrupts :: Bool
msgInterrupts = (MsgClass -> Bool) -> Report -> Bool
anyInReport MsgClass -> Bool
interruptsRunning Report
report
if Bool
msgInterrupts then Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"message shown"
else do
cops :: COps
cops@COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Actor
rbody <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
runLeader
let rposHere :: Point
rposHere = Actor -> Point
bpos Actor
rbody
rposLast :: Point
rposLast = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Point
forall a. HasCallStack => [Char] -> a
error ([Char] -> Point) -> [Char] -> Point
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ActorId, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
runLeader, Actor
rbody))
(Actor -> Maybe Point
boldpos Actor
rbody)
dir :: Vector
dir = Point
rposHere Point -> Point -> Vector
`vectorToFrom` Point
rposLast
Actor
body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
let lid :: LevelId
lid = Actor -> LevelId
blid Actor
body
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let posHere :: Point
posHere = Actor -> Point
bpos Actor
body
posThere :: Point
posThere = Point
posHere Point -> Vector -> Point
`shift` Vector
dir
bigActorThere :: Bool
bigActorThere = Point -> Level -> Bool
occupiedBigLvl Point
posThere Level
lvl
projsThere :: Bool
projsThere = Point -> Level -> Bool
occupiedProjLvl Point
posThere Level
lvl
let openableLast :: Bool
openableLast =
TileSpeedup -> ContentId TileKind -> Bool
Tile.isOpenable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` (Point
posHere Point -> Vector -> Point
`shift` Vector
dir))
check :: m (Either Text Vector)
check
| Bool
bigActorThere = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"actor in the way"
| Bool
projsThere = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"projectile in the way"
| COps -> Level -> Point -> Vector -> Bool
walkableDir COps
cops Level
lvl Point
posHere Vector
dir =
if Bool
runInitial Bool -> Bool -> Bool
&& ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
runLeader
then Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Vector -> Either Text Vector
forall a b. b -> Either a b
Right Vector
dir
else ActorId -> Vector -> m (Either Text Vector)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> Vector -> m (Either Text Vector)
checkAndRun ActorId
aid Vector
dir
| Bool -> Bool
not (Bool
runInitial Bool -> Bool -> Bool
&& ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
runLeader) = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"blocked"
| Bool
openableLast = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"blocked by a closed door"
| Bool
otherwise =
ActorId -> m (Either Text Vector)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Either Text Vector)
tryTurning ActorId
aid
m (Either Text Vector)
check
walkableDir :: COps -> Level -> Point -> Vector -> Bool
walkableDir :: COps -> Level -> Point -> Vector -> Bool
walkableDir COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} Level
lvl Point
spos Vector
dir =
TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` (Point
spos Point -> Vector -> Point
`shift` Vector
dir)
tryTurning :: MonadClientRead m
=> ActorId -> m (Either Text Vector)
tryTurning :: forall (m :: * -> *).
MonadClientRead m =>
ActorId -> m (Either Text Vector)
tryTurning ActorId
aid = do
cops :: COps
cops@COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Actor
body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
let lid :: LevelId
lid = Actor -> LevelId
blid Actor
body
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let posHere :: Point
posHere = Actor -> Point
bpos Actor
body
posLast :: Point
posLast = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Point
forall a. HasCallStack => [Char] -> a
error ([Char] -> Point) -> [Char] -> Point
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ActorId, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
aid, Actor
body)) (Actor -> Maybe Point
boldpos Actor
body)
dirLast :: Vector
dirLast = Point
posHere Point -> Point -> Vector
`vectorToFrom` Point
posLast
let openableDir :: Vector -> Bool
openableDir Vector
dir =
TileSpeedup -> ContentId TileKind -> Bool
Tile.isOpenable TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` (Point
posHere Point -> Vector -> Point
`shift` Vector
dir))
dirWalkable :: Vector -> Bool
dirWalkable Vector
dir = COps -> Level -> Point -> Vector -> Bool
walkableDir COps
cops Level
lvl Point
posHere Vector
dir Bool -> Bool -> Bool
|| Vector -> Bool
openableDir Vector
dir
dirNearby :: Vector -> Vector -> Bool
dirNearby Vector
dir1 Vector
dir2 = Vector -> Vector -> Int
euclidDistSqVector Vector
dir1 Vector
dir2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
dirSimilar :: Vector -> Bool
dirSimilar Vector
dir = Vector -> Vector -> Bool
dirNearby Vector
dirLast Vector
dir Bool -> Bool -> Bool
&& Vector -> Bool
dirWalkable Vector
dir
dirsSimilar :: [Vector]
dirsSimilar = (Vector -> Bool) -> [Vector] -> [Vector]
forall a. (a -> Bool) -> [a] -> [a]
filter Vector -> Bool
dirSimilar [Vector]
moves
case [Vector]
dirsSimilar of
[] -> Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"dead end"
Vector
d1 : [Vector]
ds | (Vector -> Bool) -> [Vector] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Vector -> Vector -> Bool
dirNearby Vector
d1) [Vector]
ds ->
case (Vector -> Int) -> [Vector] -> [Vector]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Vector -> Vector -> Int
euclidDistSqVector Vector
dirLast)
([Vector] -> [Vector]) -> [Vector] -> [Vector]
forall a b. (a -> b) -> a -> b
$ (Vector -> Bool) -> [Vector] -> [Vector]
forall a. (a -> Bool) -> [a] -> [a]
filter (COps -> Level -> Point -> Vector -> Bool
walkableDir COps
cops Level
lvl Point
posHere) ([Vector] -> [Vector]) -> [Vector] -> [Vector]
forall a b. (a -> b) -> a -> b
$ Vector
d1 Vector -> [Vector] -> [Vector]
forall a. a -> [a] -> [a]
: [Vector]
ds of
[] ->
Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"blocked and all similar directions are non-walkable"
Vector
d : [Vector]
_ -> ActorId -> Vector -> m (Either Text Vector)
forall (m :: * -> *).
MonadClientRead m =>
ActorId -> Vector -> m (Either Text Vector)
checkAndRun ActorId
aid Vector
d
[Vector]
_ -> Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"blocked and many distant similar directions found"
checkAndRun :: MonadClientRead m
=> ActorId -> Vector -> m (Either Text Vector)
checkAndRun :: forall (m :: * -> *).
MonadClientRead m =>
ActorId -> Vector -> m (Either Text Vector)
checkAndRun ActorId
aid Vector
dir = do
COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
ActorMaxSkills
actorMaxSkills <- (State -> ActorMaxSkills) -> m ActorMaxSkills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorMaxSkills
sactorMaxSkills
Actor
body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
Int
smarkSuspect <- (StateClient -> Int) -> m Int
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
smarkSuspect
let lid :: LevelId
lid = Actor -> LevelId
blid Actor
body
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
ActorDict
actorD <- (State -> ActorDict) -> m ActorDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorDict
sactorD
let posHere :: Point
posHere = Actor -> Point
bpos Actor
body
posHasItems :: Point -> Bool
posHasItems Point
pos = Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member Point
pos (EnumMap Point ItemBag -> Bool) -> EnumMap Point ItemBag -> Bool
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ItemBag
lfloor Level
lvl
posThere :: Point
posThere = Point
posHere Point -> Vector -> Point
`shift` Vector
dir
bigActorThere :: Bool
bigActorThere = Point -> Level -> Bool
occupiedBigLvl Point
posThere Level
lvl
enemyThreatensThere :: Bool
enemyThreatensThere =
let f :: Point -> Bool
f !Point
p = case Point -> Level -> Maybe ActorId
posToBigLvl Point
p Level
lvl of
Maybe ActorId
Nothing -> Bool
False
Just ActorId
aid2 -> ActorId -> Actor -> Bool
g ActorId
aid2 (Actor -> Bool) -> Actor -> Bool
forall a b. (a -> b) -> a -> b
$ ActorDict
actorD ActorDict -> ActorId -> Actor
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid2
g :: ActorId -> Actor -> Bool
g ActorId
aid2 !Actor
b2 = (FactionId -> Faction -> FactionId -> Bool)
-> FactionId -> Faction -> FactionId -> Bool
forall a. a -> a
inline FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
body) Faction
fact (Actor -> FactionId
bfid Actor
b2)
Bool -> Bool -> Bool
&& ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMeleeToHarm ActorMaxSkills
actorMaxSkills ActorId
aid2 Actor
b2
Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
in (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Point -> Bool
f ([Point] -> Bool) -> [Point] -> Bool
forall a b. (a -> b) -> a -> b
$ Point -> [Point]
vicinityUnsafe Point
posThere
projsThere :: Bool
projsThere = Point -> Level -> Bool
occupiedProjLvl Point
posThere Level
lvl
let posLast :: Point
posLast = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Point
forall a. HasCallStack => [Char] -> a
error ([Char] -> Point) -> [Char] -> Point
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ActorId, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
aid, Actor
body)) (Actor -> Maybe Point
boldpos Actor
body)
dirLast :: Vector
dirLast = Point
posHere Point -> Point -> Vector
`vectorToFrom` Point
posLast
anglePos :: Point -> Vector -> RadianAngle -> Point
anglePos :: Point -> Vector -> RadianAngle -> Point
anglePos Point
pos Vector
d RadianAngle
angle = Point -> Vector -> Point
shift Point
pos (RadianAngle -> Vector -> Vector
rotate RadianAngle
angle Vector
d)
tileLast :: ContentId TileKind
tileLast = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
posLast
tileHere :: ContentId TileKind
tileHere = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
posHere
tileThere :: ContentId TileKind
tileThere = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
posThere
leftPsLast :: [Point]
leftPsLast = (RadianAngle -> Point) -> [RadianAngle] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dirLast) [RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
2, RadianAngle
3RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
*RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4]
[Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ (RadianAngle -> Point) -> [RadianAngle] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dir) [RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
2, RadianAngle
3RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
*RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4]
rightPsLast :: [Point]
rightPsLast = (RadianAngle -> Point) -> [RadianAngle] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dirLast) [-RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
2, -RadianAngle
3RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
*RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4]
[Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ (RadianAngle -> Point) -> [RadianAngle] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dir) [-RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
2, -RadianAngle
3RadianAngle -> RadianAngle -> RadianAngle
forall a. Num a => a -> a -> a
*RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4]
leftForwardPosHere :: Point
leftForwardPosHere = Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dir (RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4)
rightForwardPosHere :: Point
rightForwardPosHere = Point -> Vector -> RadianAngle -> Point
anglePos Point
posHere Vector
dir (-RadianAngle
forall a. Floating a => a
piRadianAngle -> RadianAngle -> RadianAngle
forall a. Fractional a => a -> a -> a
/RadianAngle
4)
leftTilesLast :: [ContentId TileKind]
leftTilesLast = (Point -> ContentId TileKind) -> [Point] -> [ContentId TileKind]
forall a b. (a -> b) -> [a] -> [b]
map (Level
lvl Level -> Point -> ContentId TileKind
`at`) [Point]
leftPsLast
rightTilesLast :: [ContentId TileKind]
rightTilesLast = (Point -> ContentId TileKind) -> [Point] -> [ContentId TileKind]
forall a b. (a -> b) -> [a] -> [b]
map (Level
lvl Level -> Point -> ContentId TileKind
`at`) [Point]
rightPsLast
leftForwardTileHere :: ContentId TileKind
leftForwardTileHere = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
leftForwardPosHere
rightForwardTileHere :: ContentId TileKind
rightForwardTileHere = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
rightForwardPosHere
tilePropAt :: ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt :: ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt ContentId TileKind
tile =
let suspect :: Bool
suspect =
Int
smarkSuspect Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup ContentId TileKind
tile
Bool -> Bool -> Bool
|| Int
smarkSuspect Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isHideAs TileSpeedup
coTileSpeedup ContentId TileKind
tile
embed :: Bool
embed = TileSpeedup -> ContentId TileKind -> Bool
Tile.isEmbed TileSpeedup
coTileSpeedup ContentId TileKind
tile
walkable :: Bool
walkable = TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
tile
openable :: Bool
openable = TileSpeedup -> ContentId TileKind -> Bool
Tile.isOpenable TileSpeedup
coTileSpeedup ContentId TileKind
tile
closable :: Bool
closable = TileSpeedup -> ContentId TileKind -> Bool
Tile.isClosable TileSpeedup
coTileSpeedup ContentId TileKind
tile
modifiable :: Bool
modifiable = TileSpeedup -> ContentId TileKind -> Bool
Tile.isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
tile
in (Bool
suspect, Bool
embed, Bool
walkable, Bool
openable, Bool
closable, Bool
modifiable)
terrainChangeMiddle :: Bool
terrainChangeMiddle = ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt ContentId TileKind
tileThere
(Bool, Bool, Bool, Bool, Bool, Bool)
-> [(Bool, Bool, Bool, Bool, Bool, Bool)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool))
-> [ContentId TileKind] -> [(Bool, Bool, Bool, Bool, Bool, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt [ContentId TileKind
tileLast, ContentId TileKind
tileHere]
terrainChangeLeft :: Bool
terrainChangeLeft = ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt ContentId TileKind
leftForwardTileHere
(Bool, Bool, Bool, Bool, Bool, Bool)
-> [(Bool, Bool, Bool, Bool, Bool, Bool)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool))
-> [ContentId TileKind] -> [(Bool, Bool, Bool, Bool, Bool, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt [ContentId TileKind]
leftTilesLast
terrainChangeRight :: Bool
terrainChangeRight = ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt ContentId TileKind
rightForwardTileHere
(Bool, Bool, Bool, Bool, Bool, Bool)
-> [(Bool, Bool, Bool, Bool, Bool, Bool)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool))
-> [ContentId TileKind] -> [(Bool, Bool, Bool, Bool, Bool, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map ContentId TileKind -> (Bool, Bool, Bool, Bool, Bool, Bool)
tilePropAt [ContentId TileKind]
rightTilesLast
itemChangeLeft :: Bool
itemChangeLeft = Point -> Bool
posHasItems Point
leftForwardPosHere
Bool -> [Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Point -> Bool) -> [Point] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Point -> Bool
posHasItems [Point]
leftPsLast
itemChangeRight :: Bool
itemChangeRight = Point -> Bool
posHasItems Point
rightForwardPosHere
Bool -> [Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (Point -> Bool) -> [Point] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Point -> Bool
posHasItems [Point]
rightPsLast
check :: m (Either Text Vector)
check
| Bool
bigActorThere = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"actor in the way"
| Bool
enemyThreatensThere = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"enemy threatens the position"
| Bool
projsThere = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"projectile in the way"
| Bool
terrainChangeLeft = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"terrain change on the left"
| Bool
terrainChangeRight = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"terrain change on the right"
| Bool
itemChangeLeft = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"item change on the left"
| Bool
itemChangeRight = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"item change on the right"
| Bool
terrainChangeMiddle = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Vector
forall a b. a -> Either a b
Left Text
"terrain change in the middle"
| Bool
otherwise = Either Text Vector -> m (Either Text Vector)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Vector -> m (Either Text Vector))
-> Either Text Vector -> m (Either Text Vector)
forall a b. (a -> b) -> a -> b
$ Vector -> Either Text Vector
forall a b. b -> Either a b
Right Vector
dir
m (Either Text Vector)
check