module Game.LambdaHack.Client.UI.HandleHumanLocalM
(
macroHuman, macroHumanTransition
, chooseItemHuman, chooseItemDialogMode
, chooseItemProjectHuman, chooseItemApplyHuman
, psuitReq, triggerSymbols, pickLeaderHuman, pickLeaderWithPointerHuman
, pointmanCycleHuman, pointmanCycleLevelHuman
, selectActorHuman, selectNoneHuman, selectWithPointerHuman
, repeatHuman, repeatHumanTransition
, repeatLastHuman, repeatLastHumanTransition
, recordHuman, recordHumanTransition, allHistoryHuman
, markVisionHuman, markSmellHuman, markSuspectHuman, markAnimHuman
, overrideTutHuman
, printScreenHuman
, cancelHuman, acceptHuman, detailCycleHuman
, clearTargetIfItemClearHuman, itemClearHuman
, moveXhairHuman, aimTgtHuman, aimFloorHuman, aimEnemyHuman, aimItemHuman
, aimAscendHuman, epsIncrHuman
, xhairUnknownHuman, xhairItemHuman, xhairStairHuman
, xhairPointerFloorHuman, xhairPointerMuteHuman, xhairPointerEnemyHuman
, aimPointerFloorHuman, aimPointerEnemyHuman
#ifdef EXPOSE_INTERNAL
, chooseItemDialogModeLore, projectCheck
, posFromXhair, permittedApplyClient, endAiming, endAimingMsg
, flashAiming
#endif
, permittedProjectClient, xhairLegalEps
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Either
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Client.BfsM
import Game.LambdaHack.Client.CommonM
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.ActorUI
import Game.LambdaHack.Client.UI.Animation
import Game.LambdaHack.Client.UI.Content.Screen
import Game.LambdaHack.Client.UI.ContentClientUI
import Game.LambdaHack.Client.UI.DrawM
import Game.LambdaHack.Client.UI.EffectDescription
import Game.LambdaHack.Client.UI.Frame
import Game.LambdaHack.Client.UI.FrameM
import Game.LambdaHack.Client.UI.HandleHelperM
import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
import Game.LambdaHack.Client.UI.InventoryM
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.Msg
import Game.LambdaHack.Client.UI.MsgM
import Game.LambdaHack.Client.UI.Overlay
import Game.LambdaHack.Client.UI.PointUI
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Client.UI.Slideshow
import Game.LambdaHack.Client.UI.SlideshowM
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.ReqFailure
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.FactionKind as FK
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.ModeKind as MK
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import Game.LambdaHack.Definition.Defs
macroHuman :: MonadClientUI m => [String] -> m ()
macroHuman :: forall (m :: * -> *). MonadClientUI m => [String] -> m ()
macroHuman [String]
ks = do
(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 ->
let kms :: [KM]
kms = String -> KM
K.mkKM (String -> KM) -> [String] -> [KM]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ks
(KeyMacroFrame
smacroFrameNew, [KeyMacroFrame]
smacroStackMew) =
[KM]
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
macroHumanTransition [KM]
kms (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) (SessionUI -> [KeyMacroFrame]
smacroStack SessionUI
sess)
in SessionUI
sess { smacroFrame = smacroFrameNew
, smacroStack = smacroStackMew }
MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgMacroOperation (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Macro activated:" Text -> Text -> Text
<+> String -> Text
T.pack ([String] -> String
unwords [String]
ks)
macroHumanTransition :: [K.KM] -> KeyMacroFrame -> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
macroHumanTransition :: [KM]
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
macroHumanTransition [KM]
kms KeyMacroFrame
macroFrame [KeyMacroFrame]
macroFrames =
let smacroFrameNew :: KeyMacroFrame
smacroFrameNew = KeyMacroFrame
emptyMacroFrame {keyPending = KeyMacro kms}
in (KeyMacroFrame
smacroFrameNew, KeyMacroFrame
macroFrame KeyMacroFrame -> [KeyMacroFrame] -> [KeyMacroFrame]
forall a. a -> [a] -> [a]
: [KeyMacroFrame]
macroFrames)
chooseItemHuman :: MonadClientUI m => ActorId -> ItemDialogMode -> m MError
chooseItemHuman :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> ItemDialogMode -> m MError
chooseItemHuman ActorId
leader ItemDialogMode
c =
(FailError -> MError)
-> (ActorId -> MError) -> Either FailError ActorId -> MError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FailError -> MError
forall a. a -> Maybe a
Just (MError -> ActorId -> MError
forall a b. a -> b -> a
const MError
forall a. Maybe a
Nothing) (Either FailError ActorId -> MError)
-> m (Either FailError ActorId) -> m MError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False ItemDialogMode
c
chooseItemDialogModeLore :: forall m . MonadClientUI m
=> m (Maybe ResultItemDialogMode)
chooseItemDialogModeLore :: forall (m :: * -> *).
MonadClientUI m =>
m (Maybe ResultItemDialogMode)
chooseItemDialogModeLore = do
ChosenLore
schosenLoreOld <- (SessionUI -> ChosenLore) -> m ChosenLore
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChosenLore
schosenLore
([(ActorId, Actor)]
inhabitants, [(ItemId, ItemQuant)]
embeds) <- case ChosenLore
schosenLoreOld of
ChosenLore [(ActorId, Actor)]
inh [(ItemId, ItemQuant)]
emb -> ([(ActorId, Actor)], [(ItemId, ItemQuant)])
-> m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ActorId, Actor)]
inh, [(ItemId, ItemQuant)]
emb)
ChosenLore
ChosenNothing -> m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
forall (m :: * -> *).
MonadClientUI m =>
m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
computeChosenLore
EnumMap ItemId ItemQuant
bagHuge <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ (Item -> ItemQuant)
-> EnumMap ItemId Item -> EnumMap ItemId ItemQuant
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (ItemQuant -> Item -> ItemQuant
forall a b. a -> b -> a
const ItemQuant
quantSingle) (EnumMap ItemId Item -> EnumMap ItemId ItemQuant)
-> (State -> EnumMap ItemId Item)
-> State
-> EnumMap ItemId ItemQuant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ItemId Item
sitemD
ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
ItemRoles EnumMap SLore (EnumSet ItemId)
itemRoles <- (SessionUI -> ItemRoles) -> m ItemRoles
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemRoles
sroles
let rlore :: ItemId -> SLore -> ChosenLore -> m (Maybe ResultItemDialogMode)
rlore :: ItemId -> SLore -> ChosenLore -> m (Maybe ResultItemDialogMode)
rlore ItemId
iid SLore
slore ChosenLore
schosenLore = do
let itemRole :: EnumSet ItemId
itemRole = EnumMap SLore (EnumSet ItemId)
itemRoles EnumMap SLore (EnumSet ItemId) -> SLore -> EnumSet ItemId
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore
bagAll :: EnumMap ItemId ItemQuant
bagAll = (ItemId -> ItemQuant -> Bool)
-> EnumMap ItemId ItemQuant -> EnumMap ItemId ItemQuant
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey (\ItemId
iid2 ItemQuant
_ -> ItemId
iid2 ItemId -> EnumSet ItemId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet ItemId
itemRole)
EnumMap ItemId ItemQuant
bagHuge
(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 {schosenLore}
let iids :: [(ItemId, ItemQuant)]
iids = (ItemId -> ItemFull)
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
sortIids ItemId -> ItemFull
itemToF ([(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)])
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId ItemQuant -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ItemId ItemQuant
bagAll
slot :: MenuSlot
slot = Int -> MenuSlot
forall a. Enum a => Int -> a
toEnum (Int -> MenuSlot) -> Int -> MenuSlot
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"" String -> (ItemId, [(ItemId, ItemQuant)]) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemId
iid, [(ItemId, ItemQuant)]
iids))
(Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ItemId -> [ItemId] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex ItemId
iid ([ItemId] -> Maybe Int) -> [ItemId] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemQuant) -> ItemId)
-> [(ItemId, ItemQuant)] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemQuant) -> ItemId
forall a b. (a, b) -> a
fst [(ItemId, ItemQuant)]
iids
Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode))
-> Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ResultItemDialogMode -> Maybe ResultItemDialogMode
forall a. a -> Maybe a
Just (ResultItemDialogMode -> Maybe ResultItemDialogMode)
-> ResultItemDialogMode -> Maybe ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ SLore -> MenuSlot -> [(ItemId, ItemQuant)] -> ResultItemDialogMode
RLore SLore
slore MenuSlot
slot [(ItemId, ItemQuant)]
iids
case [(ActorId, Actor)]
inhabitants of
(ActorId
_, Actor
b) : [(ActorId, Actor)]
rest -> do
let iid :: ItemId
iid = Actor -> ItemId
btrunk Actor
b
AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid
let slore :: SLore
slore | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
b = SLore
STrunk
| Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem = SLore
SBlast
| Bool
otherwise = SLore
SItem
ItemId -> SLore -> ChosenLore -> m (Maybe ResultItemDialogMode)
rlore ItemId
iid SLore
slore ([(ActorId, Actor)] -> [(ItemId, ItemQuant)] -> ChosenLore
ChosenLore [(ActorId, Actor)]
rest [(ItemId, ItemQuant)]
embeds)
[] ->
case [(ItemId, ItemQuant)]
embeds of
(ItemId
iid, ItemQuant
_) : [(ItemId, ItemQuant)]
rest -> do
let slore :: SLore
slore = SLore
SEmbed
ItemId -> SLore -> ChosenLore -> m (Maybe ResultItemDialogMode)
rlore ItemId
iid SLore
slore ([(ActorId, Actor)] -> [(ItemId, ItemQuant)] -> ChosenLore
ChosenLore [(ActorId, Actor)]
inhabitants [(ItemId, ItemQuant)]
rest)
[] -> do
(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 {schosenLore = ChosenNothing}
Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ResultItemDialogMode
forall a. Maybe a
Nothing
chooseItemDialogMode :: forall m. MonadClientUI m
=> ActorId -> Bool -> ItemDialogMode
-> m (FailOrCmd ActorId)
chooseItemDialogMode :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader0 Bool
permitLoreCycle ItemDialogMode
c = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth, Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FontSetup{DisplayFont
propFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
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.! FactionId
side) (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
(Either Text ResultItemDialogMode
ggi, Bool
loreFound) <- do
Maybe ResultItemDialogMode
mggiLore <- if Bool
permitLoreCycle Bool -> Bool -> Bool
&& ItemDialogMode
c ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
== SLore -> ItemDialogMode
MLore SLore
SItem
then m (Maybe ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
m (Maybe ResultItemDialogMode)
chooseItemDialogModeLore
else Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ResultItemDialogMode
forall a. Maybe a
Nothing
case Maybe ResultItemDialogMode
mggiLore of
Just ResultItemDialogMode
rlore -> (Either Text ResultItemDialogMode, Bool)
-> m (Either Text ResultItemDialogMode, Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right ResultItemDialogMode
rlore, Bool
True)
Maybe ResultItemDialogMode
Nothing -> do
Either Text ResultItemDialogMode
ggi <- ActorId -> ItemDialogMode -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> ItemDialogMode -> m (Either Text ResultItemDialogMode)
getStoreItem ActorId
leader0 ItemDialogMode
c
(Either Text ResultItemDialogMode, Bool)
-> m (Either Text ResultItemDialogMode, Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
ggi, Bool
False)
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
let leader :: ActorId
leader = ActorId -> Maybe ActorId -> ActorId
forall a. a -> Maybe a -> a
fromMaybe ActorId
leader0 Maybe ActorId
mleader
m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
Skills
actorCurAndMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
let meleeSkill :: Int
meleeSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHurtMelee Skills
actorCurAndMaxSk
ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
case Either Text ResultItemDialogMode
ggi of
Right ResultItemDialogMode
result -> case ResultItemDialogMode
result of
RStore CStore
fromCStore [ItemId
iid] -> do
(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 {sitemSel = Just (iid, fromCStore, False)}
Either FailError ActorId -> m (Either FailError ActorId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FailError ActorId -> m (Either FailError ActorId))
-> Either FailError ActorId -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ ActorId -> Either FailError ActorId
forall a b. b -> Either a b
Right ActorId
leader
RStore{} -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> ResultItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ResultItemDialogMode
result
ROwned ItemId
iid -> do
[(ActorId, (Actor, CStore))]
found <- (State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))])
-> (State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))]
forall a b. (a -> b) -> a -> b
$ ActorId
-> FactionId -> ItemId -> State -> [(ActorId, (Actor, CStore))]
findIid ActorId
leader FactionId
side ItemId
iid
let (ActorId
newAid, CStore
bestStore) = case ActorId
leader ActorId -> [(ActorId, (Actor, CStore))] -> Maybe (Actor, CStore)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(ActorId, (Actor, CStore))]
found of
Just (Actor
_, CStore
store) -> (ActorId
leader, CStore
store)
Maybe (Actor, CStore)
Nothing -> case [(ActorId, (Actor, CStore))]
found of
(ActorId
aid, (Actor
_, CStore
store)) : [(ActorId, (Actor, CStore))]
_ -> (ActorId
aid, CStore
store)
[] -> String -> (ActorId, CStore)
forall a. HasCallStack => String -> a
error (String -> (ActorId, CStore)) -> String -> (ActorId, CStore)
forall a b. (a -> b) -> a -> b
$ String
"" String -> ResultItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ResultItemDialogMode
result
(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 {sitemSel = Just (iid, bestStore, False)}
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
Actor
b2 <- (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
newAid
let banned :: Bool
banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
if | ActorId
newAid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
leader -> Either FailError ActorId -> m (Either FailError ActorId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FailError ActorId -> m (Either FailError ActorId))
-> Either FailError ActorId -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ ActorId -> Either FailError ActorId
forall a b. b -> Either a b
Right ActorId
leader
| Actor -> LevelId
blid Actor
b2 LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
arena Bool -> Bool -> Bool
&& Bool
banned ->
ReqFailure -> m (Either FailError ActorId)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
NoChangeDunLeader
| Bool
otherwise -> do
m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
True ActorId
newAid
Either FailError ActorId -> m (Either FailError ActorId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FailError ActorId -> m (Either FailError ActorId))
-> Either FailError ActorId -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ ActorId -> Either FailError ActorId
forall a b. b -> Either a b
Right ActorId
newAid
RLore SLore
slore MenuSlot
slot [(ItemId, ItemQuant)]
iids -> do
let promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun ItemId
_ ItemFull
itemFull Int
_ = case SLore
slore of
SLore
SBody ->
let blurb :: Part
blurb = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition
(AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
then Part
"condition"
else Part
"organ"
in [Part] -> Text
makeSentence [ActorUI -> Part
partActor ActorUI
bUI, Part
"is aware of" ,Part -> Part
MU.AW Part
blurb]
SLore
_ ->
[Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg (ActorUI -> Part
partActor ActorUI
bUI) Part
"remember"
, Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (SLore -> Text
headingSLore SLore
slore) ]
ChosenLore
schosenLore <- (SessionUI -> ChosenLore) -> m ChosenLore
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChosenLore
schosenLore
let lorePending :: Bool
lorePending = Bool
loreFound Bool -> Bool -> Bool
&& case ChosenLore
schosenLore of
ChosenLore [] [] -> Bool
False
ChosenLore
_ -> Bool
True
renderOneItem :: MenuSlot -> m OKX
renderOneItem =
(ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> MenuSlot
-> m OKX
forall (m :: * -> *).
MonadClientUI m =>
(ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> MenuSlot
-> m OKX
okxItemLoreMsg ItemId -> ItemFull -> Int -> Text
promptFun Int
meleeSkill (SLore -> ItemDialogMode
MLore SLore
slore) [(ItemId, ItemQuant)]
iids
extraKeys :: [KM]
extraKeys = [Char -> KM
K.mkChar Char
'~' | Bool
lorePending]
slotBound :: Int
slotBound = [(ItemId, ItemQuant)] -> Int
forall a. [a] -> Int
length [(ItemId, ItemQuant)]
iids Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
KM
km <- (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
extraKeys Int
slotBound MenuSlot
slot
case KM -> Key
K.key KM
km of
Key
K.Space -> do
(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 {schosenLore = ChosenNothing}
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False (SLore -> ItemDialogMode
MLore SLore
slore)
K.Char Char
'~' -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
True ItemDialogMode
c
Key
K.Esc -> do
(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 {schosenLore = ChosenNothing}
Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
Key
_ -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
RSkills MenuSlot
slot0 -> do
let renderOneItem :: MenuSlot -> m OKX
renderOneItem MenuSlot
slot = do
(Text
prompt2, AttrString
attrString) <- ActorId -> MenuSlot -> m (Text, AttrString)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> MenuSlot -> m (Text, AttrString)
skillCloseUp ActorId
leader MenuSlot
slot
let ov0 :: EnumMap DisplayFont Overlay
ov0 = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont
(Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth AttrString
attrString
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt2
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov0, [])
extraKeys :: [a]
extraKeys = []
slotBound :: Int
slotBound = [Skill] -> Int
forall a. [a] -> Int
length [Skill]
skillsInDisplayOrder Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
KM
km <- (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
forall a. [a]
extraKeys Int
slotBound MenuSlot
slot0
case KM -> Key
K.key KM
km of
Key
K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False ItemDialogMode
MSkills
Key
K.Esc -> Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
Key
_ -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
RPlaces MenuSlot
slot0 -> do
COps{ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
[(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places <- (State
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> (State
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs
(EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))])
-> (State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int))
-> State
-> [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentData PlaceKind
-> Bool
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, Int, Int, Int)
placesFromState ContentData PlaceKind
coplace (ClientOptions -> Bool
sexposePlaces ClientOptions
soptions)
let renderOneItem :: MenuSlot -> m OKX
renderOneItem MenuSlot
slot = do
(Text
prompt2, [(DisplayFont, [AttrString])]
blurbs) <-
[(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Bool -> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
forall (m :: * -> *).
MonadClientUI m =>
[(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Bool -> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
placeCloseUp [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places (ClientOptions -> Bool
sexposePlaces ClientOptions
soptions) MenuSlot
slot
let splitText :: AttrString -> [AttrLine]
splitText = Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth
ov0 :: EnumMap DisplayFont Overlay
ov0 = [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap
([(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay)
-> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ ((DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map (([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> ([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString])
-> (DisplayFont, [AttrLine])
forall a b. (a -> b) -> a -> b
$ (AttrString -> [AttrLine]) -> [AttrString] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AttrString -> [AttrLine]
splitText) [(DisplayFont, [AttrString])]
blurbs
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt2
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov0, [])
extraKeys :: [a]
extraKeys = []
slotBound :: Int
slotBound = [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))] -> Int
forall a. [a] -> Int
length [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
KM
km <- (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
forall a. [a]
extraKeys Int
slotBound MenuSlot
slot0
case KM -> Key
K.key KM
km of
Key
K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False ItemDialogMode
MPlaces
Key
K.Esc -> Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
Key
_ -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
RFactions MenuSlot
slot0 -> do
ItemRoles
sroles <- (SessionUI -> ItemRoles) -> m ItemRoles
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemRoles
sroles
[(FactionId, Faction)]
factions <- (State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)])
-> (State -> [(FactionId, Faction)]) -> m [(FactionId, Faction)]
forall a b. (a -> b) -> a -> b
$ ItemRoles -> State -> [(FactionId, Faction)]
factionsFromState ItemRoles
sroles
let renderOneItem :: MenuSlot -> m OKX
renderOneItem MenuSlot
slot = do
(Text
prompt2, [(DisplayFont, [AttrString])]
blurbs) <- [(FactionId, Faction)]
-> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
forall (m :: * -> *).
MonadClientUI m =>
[(FactionId, Faction)]
-> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
factionCloseUp [(FactionId, Faction)]
factions MenuSlot
slot
let splitText :: AttrString -> [AttrLine]
splitText = Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth
ov0 :: EnumMap DisplayFont Overlay
ov0 = [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap
([(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay)
-> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ ((DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map (([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> ([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString])
-> (DisplayFont, [AttrLine])
forall a b. (a -> b) -> a -> b
$ (AttrString -> [AttrLine]) -> [AttrString] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AttrString -> [AttrLine]
splitText) [(DisplayFont, [AttrString])]
blurbs
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt2
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov0, [])
extraKeys :: [a]
extraKeys = []
slotBound :: Int
slotBound = [(FactionId, Faction)] -> Int
forall a. [a] -> Int
length [(FactionId, Faction)]
factions Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
KM
km <- (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
forall a. [a]
extraKeys Int
slotBound MenuSlot
slot0
case KM -> Key
K.key KM
km of
Key
K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False ItemDialogMode
MFactions
Key
K.Esc -> Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
Key
_ -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
RModes MenuSlot
slot0 -> do
let displayOneMenuItemBig :: (MenuSlot -> m OKX)
-> [K.KM] -> Int -> MenuSlot
-> m K.KM
displayOneMenuItemBig :: (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItemBig MenuSlot -> m OKX
renderOneItem [KM]
extraKeys Int
slotBound MenuSlot
slot = do
let keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
slotBound]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM]
extraKeys
OKX
okx <- MenuSlot -> m OKX
renderOneItem MenuSlot
slot
Slideshow
slides <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow Int
rheight [KM]
keys OKX
okx
KeyOrSlot
ekm2 <- String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreen String
"" ColorMode
ColorFull Bool
True Slideshow
slides [KM]
keys
let km :: KM
km = (KM -> KM) -> (MenuSlot -> KM) -> KeyOrSlot -> KM
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either KM -> KM
forall a. a -> a
id (String -> MenuSlot -> KM
forall a. HasCallStack => String -> a
error (String -> MenuSlot -> KM) -> String -> MenuSlot -> KM
forall a b. (a -> b) -> a -> b
$ String
"" String -> KeyOrSlot -> String
forall v. Show v => String -> v -> String
`showFailure` KeyOrSlot
ekm2) KeyOrSlot
ekm2
case KM -> Key
K.key KM
km of
Key
K.Up -> (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItemBig MenuSlot -> m OKX
renderOneItem [KM]
extraKeys
Int
slotBound (MenuSlot -> m KM) -> MenuSlot -> m KM
forall a b. (a -> b) -> a -> b
$ MenuSlot -> MenuSlot
forall a. Enum a => a -> a
pred MenuSlot
slot
Key
K.Down -> (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItemBig MenuSlot -> m OKX
renderOneItem [KM]
extraKeys
Int
slotBound (MenuSlot -> m KM) -> MenuSlot -> m KM
forall a b. (a -> b) -> a -> b
$ MenuSlot -> MenuSlot
forall a. Enum a => a -> a
succ MenuSlot
slot
Key
_ -> KM -> m KM
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
COps{ContentData ModeKind
comode :: ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories <- (SessionUI -> EnumMap (ContentId ModeKind) (Map Challenge Int))
-> m (EnumMap (ContentId ModeKind) (Map Challenge Int))
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories
Challenge
nxtChal <- (StateClient -> Challenge) -> m Challenge
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
let f :: [(a, b)] -> p -> a -> b -> [(a, b)]
f ![(a, b)]
acc p
_p !a
i !b
a = (a
i, b
a) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
acc
campaignModes :: [(ContentId ModeKind, ModeKind)]
campaignModes = ContentData ModeKind
-> GroupName ModeKind
-> ([(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)])
-> [(ContentId ModeKind, ModeKind)]
-> [(ContentId ModeKind, ModeKind)]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode GroupName ModeKind
MK.CAMPAIGN_SCENARIO [(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)]
forall {a} {b} {p}. [(a, b)] -> p -> a -> b -> [(a, b)]
f []
renderOneItem :: MenuSlot -> m OKX
renderOneItem MenuSlot
slot = do
let (ContentId ModeKind
gameModeId, ModeKind
gameMode) = [(ContentId ModeKind, ModeKind)]
campaignModes [(ContentId ModeKind, ModeKind)]
-> Int -> (ContentId ModeKind, ModeKind)
forall a. HasCallStack => [a] -> Int -> a
!! MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot
EnumMap DisplayFont Overlay
ov0 <- Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
describeMode Bool
False ContentId ModeKind
gameModeId
let victories :: Int
victories = case ContentId ModeKind
-> EnumMap (ContentId ModeKind) (Map Challenge Int)
-> Maybe (Map Challenge Int)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ContentId ModeKind
gameModeId EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories of
Maybe (Map Challenge Int)
Nothing -> Int
0
Just Map Challenge Int
cm -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Challenge -> Map Challenge Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Challenge
nxtChal Map Challenge Int
cm)
verb :: Part
verb = if Int
victories Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Part
"remember" else Part
"forsee"
prompt2 :: Text
prompt2 = [Part] -> Text
makeSentence
[ Part -> Part -> Part
MU.SubjectVerbSg Part
"you" Part
verb
, Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
"the '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModeKind -> Text
MK.mname ModeKind
gameMode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' adventure" ]
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt2
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov0, [])
extraKeys :: [a]
extraKeys = []
slotBound :: Int
slotBound = [(ContentId ModeKind, ModeKind)] -> Int
forall a. [a] -> Int
length [(ContentId ModeKind, ModeKind)]
campaignModes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
KM
km <- (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItemBig MenuSlot -> m OKX
renderOneItem [KM]
forall a. [a]
extraKeys Int
slotBound MenuSlot
slot0
case KM -> Key
K.key KM
km of
Key
K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False ItemDialogMode
MModes
Key
K.Esc -> Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
Key
_ -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
Left Text
err -> Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err
chooseItemProjectHuman :: forall m. (MonadClient m, MonadClientUI m)
=> ActorId -> [HumanCmd.TriggerItem] -> m MError
chooseItemProjectHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> [TriggerItem] -> m MError
chooseItemProjectHuman ActorId
leader [TriggerItem]
ts = do
Actor
b <- (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
leader
Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
let overStash :: Bool
overStash = Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
b, Actor -> Point
bpos Actor
b)
storesBase :: [CStore]
storesBase = [CStore
CStash, CStore
CEqp]
stores :: [CStore]
stores | Bool
overStash = [CStore]
storesBase [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CGround]
| Bool
otherwise = CStore
CGround CStore -> [CStore] -> [CStore]
forall a. a -> [a] -> [a]
: [CStore]
storesBase
(Part
verb1, Part
object1) = case [TriggerItem]
ts of
[] -> (Part
"aim", Part
"item")
TriggerItem
tr : [TriggerItem]
_ -> (TriggerItem -> Part
HumanCmd.tiverb TriggerItem
tr, TriggerItem -> Part
HumanCmd.tiobject TriggerItem
tr)
verb :: Text
verb = [Part] -> Text
makePhrase [Part
verb1]
triggerSyms :: String
triggerSyms = [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
Either Text (ItemFull -> Either ReqFailure (Point, Bool))
mpsuitReq <- ActorId
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq ActorId
leader
case Either Text (ItemFull -> Either ReqFailure (Point, Bool))
mpsuitReq of
Left Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err
Right ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun -> do
Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
case Maybe (ItemId, CStore, Bool)
itemSel of
Just (ItemId
_, CStore
_, Bool
True) -> MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
Just (ItemId
iid, CStore
fromCStore, Bool
False) -> do
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
EnumMap ItemId ItemQuant
bag <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId ItemQuant
getBodyStoreBag Actor
b CStore
fromCStore
case ItemId
iid ItemId -> EnumMap ItemId ItemQuant -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ItemId ItemQuant
bag of
Just ItemQuant
_ | Either ReqFailure (Point, Bool) -> Bool
forall a b. Either a b -> Bool
isRight (ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ItemFull
itemFull) ->
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
Maybe ItemQuant
_ -> do
(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 {sitemSel = Nothing}
ActorId -> [TriggerItem] -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> [TriggerItem] -> m MError
chooseItemProjectHuman ActorId
leader [TriggerItem]
ts
Maybe (ItemId, CStore, Bool)
Nothing -> do
let psuit :: m Suitability
psuit =
Suitability -> m Suitability
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Suitability -> m Suitability) -> Suitability -> m Suitability
forall a b. (a -> b) -> a -> b
$ (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
SuitsSomething ((Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability)
-> (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
forall a b. (a -> b) -> a -> b
$ \Maybe CStore
_ ItemFull
itemFull ItemQuant
_kit ->
(ReqFailure -> Bool)
-> ((Point, Bool) -> Bool)
-> Either ReqFailure (Point, Bool)
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) (Point, Bool) -> Bool
forall a b. (a, b) -> b
snd (ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ItemFull
itemFull)
Bool -> Bool -> Bool
&& (String -> Bool
forall a. [a] -> Bool
null String
triggerSyms
Bool -> Bool -> Bool
|| ItemKind -> Char
IK.isymbol (ItemFull -> ItemKind
itemKind ItemFull
itemFull) Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
triggerSyms)
prompt :: Text
prompt = [Part] -> Text
makePhrase [Part
"What", Part
object1, Part
"to"]
promptGeneric :: Text
promptGeneric = Text
"What to"
Either Text (CStore, ItemId)
ggi <- ActorId
-> m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
getGroupItem ActorId
leader m Suitability
psuit Text
prompt Text
promptGeneric Text
verb Text
"fling"
[CStore]
stores
case Either Text (CStore, ItemId)
ggi of
Right (CStore
fromCStore, ItemId
iid) -> do
(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 {sitemSel = Just (iid, fromCStore, False)}
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
Left Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err
permittedProjectClient :: MonadClientUI m
=> ActorId -> m (ItemFull -> Either ReqFailure Bool)
permittedProjectClient :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (ItemFull -> Either ReqFailure Bool)
permittedProjectClient ActorId
leader = do
Skills
actorCurAndMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
Actor
b <- (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
leader
let skill :: Int
skill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
actorCurAndMaxSk
calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorCurAndMaxSk
(ItemFull -> Either ReqFailure Bool)
-> m (ItemFull -> Either ReqFailure Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ItemFull -> Either ReqFailure Bool)
-> m (ItemFull -> Either ReqFailure Bool))
-> (ItemFull -> Either ReqFailure Bool)
-> m (ItemFull -> Either ReqFailure Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool
permittedProject Bool
False Int
skill Bool
calmE
projectCheck :: MonadClientUI m => ActorId -> Point -> m (Maybe ReqFailure)
projectCheck :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> m (Maybe ReqFailure)
projectCheck ActorId
leader Point
tpos = do
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
Int
eps <- (StateClient -> Int) -> m Int
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
seps
Actor
sb <- (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
leader
let lid :: LevelId
lid = Actor -> LevelId
blid Actor
sb
spos :: Point
spos = Actor -> Point
bpos Actor
sb
case Int -> Point -> Point -> Maybe [Point]
bresenhamsLineAlgorithm Int
eps Point
spos Point
tpos of
Maybe [Point]
Nothing -> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectAimOnself
Just [] -> String -> m (Maybe ReqFailure)
forall a. HasCallStack => String -> a
error (String -> m (Maybe ReqFailure)) -> String -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ String
"project from the edge of level"
String -> (Point, Point, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (Point
spos, Point
tpos, Actor
sb)
Just (Point
pos : [Point]
_) -> do
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t
then Maybe ReqFailure -> m (Maybe ReqFailure)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectBlockTerrain
else if Point -> Level -> Bool
occupiedBigLvl Point
pos Level
lvl
then Maybe ReqFailure -> m (Maybe ReqFailure)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectBlockActor
else Maybe ReqFailure -> m (Maybe ReqFailure)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ReqFailure
forall a. Maybe a
Nothing
xhairLegalEps :: MonadClientUI m => ActorId -> m (Either Text Int)
xhairLegalEps :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Either Text Int)
xhairLegalEps ActorId
leader = do
cops :: COps
cops@COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: Int
rWidthMax :: RuleContent -> Int
rWidthMax, Int
rHeightMax :: Int
rHeightMax :: RuleContent -> Int
rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Actor
b <- (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
leader
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b) ()
findNewEps :: Bool -> Point -> m (Either Text Int)
findNewEps Bool
onlyFirst Point
pos = do
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
Int
oldEps <- (StateClient -> Int) -> m Int
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
seps
Either Text Int -> m (Either Text Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> m (Either Text Int))
-> Either Text Int -> m (Either Text Int)
forall a b. (a -> b) -> a -> b
$! case Bool -> Actor -> Point -> Int -> COps -> Level -> Maybe Int
makeLine Bool
onlyFirst Actor
b Point
pos Int
oldEps COps
cops Level
lvl of
Just Int
newEps -> Int -> Either Text Int
forall a b. b -> Either a b
Right Int
newEps
Maybe Int
Nothing -> Text -> Either Text Int
forall a b. a -> Either a b
Left (Text -> Either Text Int) -> Text -> Either Text Int
forall a b. (a -> b) -> a -> b
$ if Bool
onlyFirst
then Text
"aiming blocked at the first step"
else Text
"aiming line blocked somewhere"
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
case Maybe Target
xhair of
Maybe Target
Nothing -> Either Text Int -> m (Either Text Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> m (Either Text Int))
-> Either Text Int -> m (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Int
forall a b. a -> Either a b
Left Text
"no aim designated"
Just (TEnemy ActorId
a) -> do
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
a
let pos :: Point
pos = Actor -> Point
bpos Actor
body
if Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV
then Bool -> Point -> m (Either Text Int)
findNewEps Bool
False Point
pos
else Either Text Int -> m (Either Text Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> m (Either Text Int))
-> Either Text Int -> m (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Int
forall a b. a -> Either a b
Left Text
"can't fling at an enemy on remote level"
Just (TNonEnemy ActorId
a) -> do
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
a
let pos :: Point
pos = Actor -> Point
bpos Actor
body
if Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV
then Bool -> Point -> m (Either Text Int)
findNewEps Bool
False Point
pos
else Either Text Int -> m (Either Text Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> m (Either Text Int))
-> Either Text Int -> m (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Int
forall a b. a -> Either a b
Left Text
"can't fling at a non-enemy on remote level"
Just (TPoint TEnemyPos{} LevelId
_ Point
_) ->
Either Text Int -> m (Either Text Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> m (Either Text Int))
-> Either Text Int -> m (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Int
forall a b. a -> Either a b
Left Text
"selected opponent not visible"
Just (TPoint TGoal
_ LevelId
lid Point
pos) ->
if LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV
then Bool -> Point -> m (Either Text Int)
findNewEps Bool
True Point
pos
else Either Text Int -> m (Either Text Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> m (Either Text Int))
-> Either Text Int -> m (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Int
forall a b. a -> Either a b
Left Text
"can't fling at a target on remote level"
Just (TVector Vector
v) -> do
let shifted :: Point
shifted = Int -> Int -> Point -> Vector -> Point
shiftBounded Int
rWidthMax Int
rHeightMax (Actor -> Point
bpos Actor
b) Vector
v
if Point
shifted Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b Bool -> Bool -> Bool
&& Vector
v Vector -> Vector -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Int -> Vector
Vector Int
0 Int
0
then Either Text Int -> m (Either Text Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> m (Either Text Int))
-> Either Text Int -> m (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Int
forall a b. a -> Either a b
Left Text
"selected translation is void"
else Bool -> Point -> m (Either Text Int)
findNewEps Bool
True Point
shifted
posFromXhair :: (MonadClient m, MonadClientUI m)
=> ActorId -> m (Either Text Point)
posFromXhair :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m (Either Text Point)
posFromXhair ActorId
leader = do
Either Text Int
canAim <- ActorId -> m (Either Text Int)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Either Text Int)
xhairLegalEps ActorId
leader
case Either Text Int
canAim of
Right Int
newEps -> do
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {seps = newEps}
Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos
case Maybe Point
mxhairPos of
Maybe Point
Nothing -> String -> m (Either Text Point)
forall a. HasCallStack => String -> a
error (String -> m (Either Text Point))
-> String -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ String
"" String -> Maybe Point -> String
forall v. Show v => String -> v -> String
`showFailure` Maybe Point
mxhairPos
Just Point
pos -> do
Maybe ReqFailure
munit <- ActorId -> Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> m (Maybe ReqFailure)
projectCheck ActorId
leader Point
pos
case Maybe ReqFailure
munit of
Maybe ReqFailure
Nothing -> Either Text Point -> m (Either Text Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Point -> m (Either Text Point))
-> Either Text Point -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ Point -> Either Text Point
forall a b. b -> Either a b
Right Point
pos
Just ReqFailure
reqFail -> Either Text Point -> m (Either Text Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Point -> m (Either Text Point))
-> Either Text Point -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Point
forall a b. a -> Either a b
Left (Text -> Either Text Point) -> Text -> Either Text Point
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
reqFail
Left Text
cause -> Either Text Point -> m (Either Text Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Point -> m (Either Text Point))
-> Either Text Point -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Point
forall a b. a -> Either a b
Left Text
cause
psuitReq :: (MonadClient m, MonadClientUI m)
=> ActorId
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq ActorId
leader = do
Actor
b <- (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
leader
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
if LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
b
then Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool))))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
forall a b. a -> Either a b
Left Text
"can't fling on remote level"
else do
Either Text Point
mpos <- ActorId -> m (Either Text Point)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m (Either Text Point)
posFromXhair ActorId
leader
ItemFull -> Either ReqFailure Bool
p <- ActorId -> m (ItemFull -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (ItemFull -> Either ReqFailure Bool)
permittedProjectClient ActorId
leader
case Either Text Point
mpos of
Left Text
err -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool))))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
forall a b. a -> Either a b
Left Text
err
Right Point
pos -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool))))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a b. (a -> b) -> a -> b
$ (ItemFull -> Either ReqFailure (Point, Bool))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
forall a b. b -> Either a b
Right ((ItemFull -> Either ReqFailure (Point, Bool))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
-> (ItemFull -> Either ReqFailure (Point, Bool))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
forall a b. (a -> b) -> a -> b
$ \ItemFull
itemFull ->
case ItemFull -> Either ReqFailure Bool
p ItemFull
itemFull of
Left ReqFailure
err -> ReqFailure -> Either ReqFailure (Point, Bool)
forall a b. a -> Either a b
Left ReqFailure
err
Right Bool
False -> (Point, Bool) -> Either ReqFailure (Point, Bool)
forall a b. b -> Either a b
Right (Point
pos, Bool
False)
Right Bool
True ->
let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
in (Point, Bool) -> Either ReqFailure (Point, Bool)
forall a b. b -> Either a b
Right (Point
pos, Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AspectRecord -> ItemKind -> Int
IA.totalRange AspectRecord
arItem (ItemFull -> ItemKind
itemKind ItemFull
itemFull)
Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) Point
pos)
triggerSymbols :: [HumanCmd.TriggerItem] -> [ContentSymbol IK.ItemKind]
triggerSymbols :: [TriggerItem] -> String
triggerSymbols [] = []
triggerSymbols (HumanCmd.TriggerItem{String
tisymbols :: String
tisymbols :: TriggerItem -> String
tisymbols} : [TriggerItem]
ts) =
String
tisymbols String -> String -> String
forall a. [a] -> [a] -> [a]
++ [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
chooseItemApplyHuman :: forall m. MonadClientUI m
=> ActorId -> [HumanCmd.TriggerItem] -> m MError
chooseItemApplyHuman :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> [TriggerItem] -> m MError
chooseItemApplyHuman ActorId
leader [TriggerItem]
ts = do
Actor
b <- (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
leader
Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
let overStash :: Bool
overStash = Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
b, Actor -> Point
bpos Actor
b)
storesBase :: [CStore]
storesBase = [CStore
CStash, CStore
CEqp, CStore
COrgan]
stores :: [CStore]
stores | Bool
overStash = [CStore]
storesBase [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CGround]
| Bool
otherwise = CStore
CGround CStore -> [CStore] -> [CStore]
forall a. a -> [a] -> [a]
: [CStore]
storesBase
(Part
verb1, Part
object1) = case [TriggerItem]
ts of
[] -> (Part
"trigger", Part
"item")
TriggerItem
tr : [TriggerItem]
_ -> (TriggerItem -> Part
HumanCmd.tiverb TriggerItem
tr, TriggerItem -> Part
HumanCmd.tiobject TriggerItem
tr)
verb :: Text
verb = [Part] -> Text
makePhrase [Part
verb1]
triggerSyms :: String
triggerSyms = [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
prompt :: Text
prompt = [Part] -> Text
makePhrase [Part
"What", Part
object1, Part
"to"]
promptGeneric :: Text
promptGeneric = Text
"What to"
Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
case Maybe (ItemId, CStore, Bool)
itemSel of
Just (ItemId
_, CStore
_, Bool
True) -> MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
Just (ItemId
iid, CStore
fromCStore, Bool
False) -> do
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
EnumMap ItemId ItemQuant
bag <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId ItemQuant
getBodyStoreBag Actor
b CStore
fromCStore
Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
mp <- ActorId
-> m (Maybe CStore
-> ItemFull -> ItemQuant -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m (Maybe CStore
-> ItemFull -> ItemQuant -> Either ReqFailure Bool)
permittedApplyClient ActorId
leader
case ItemId
iid ItemId -> EnumMap ItemId ItemQuant -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ItemId ItemQuant
bag of
Just ItemQuant
kit | Bool -> Either ReqFailure Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
mp (CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
fromCStore) ItemFull
itemFull ItemQuant
kit) ->
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
Maybe ItemQuant
_ -> do
(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 {sitemSel = Nothing}
ActorId -> [TriggerItem] -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> [TriggerItem] -> m MError
chooseItemApplyHuman ActorId
leader [TriggerItem]
ts
Maybe (ItemId, CStore, Bool)
Nothing -> do
let psuit :: m Suitability
psuit :: m Suitability
psuit = do
Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
mp <- ActorId
-> m (Maybe CStore
-> ItemFull -> ItemQuant -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m (Maybe CStore
-> ItemFull -> ItemQuant -> Either ReqFailure Bool)
permittedApplyClient ActorId
leader
Suitability -> m Suitability
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Suitability -> m Suitability) -> Suitability -> m Suitability
forall a b. (a -> b) -> a -> b
$ (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
SuitsSomething ((Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability)
-> (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
forall a b. (a -> b) -> a -> b
$ \Maybe CStore
cstore ItemFull
itemFull ItemQuant
kit ->
Bool -> Either ReqFailure Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
mp Maybe CStore
cstore ItemFull
itemFull ItemQuant
kit)
Bool -> Bool -> Bool
&& (String -> Bool
forall a. [a] -> Bool
null String
triggerSyms
Bool -> Bool -> Bool
|| ItemKind -> Char
IK.isymbol (ItemFull -> ItemKind
itemKind ItemFull
itemFull) Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
triggerSyms)
Either Text (CStore, ItemId)
ggi <- ActorId
-> m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
getGroupItem ActorId
leader m Suitability
psuit Text
prompt Text
promptGeneric Text
verb Text
"trigger"
[CStore]
stores
case Either Text (CStore, ItemId)
ggi of
Right (CStore
fromCStore, ItemId
iid) -> do
(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 {sitemSel = Just (iid, fromCStore, False)}
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
Left Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err
permittedApplyClient :: MonadClientUI m
=> ActorId
-> m (Maybe CStore -> ItemFull -> ItemQuant
-> Either ReqFailure Bool)
permittedApplyClient :: forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m (Maybe CStore
-> ItemFull -> ItemQuant -> Either ReqFailure Bool)
permittedApplyClient ActorId
leader = do
COps{RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Skills
actorCurAndMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
Actor
b <- (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
leader
let skill :: Int
skill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkApply Skills
actorCurAndMaxSk
calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorCurAndMaxSk
Time
localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
(Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
-> m (Maybe CStore
-> ItemFull -> ItemQuant -> Either ReqFailure Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
-> m (Maybe CStore
-> ItemFull -> ItemQuant -> Either ReqFailure Bool))
-> (Maybe CStore
-> ItemFull -> ItemQuant -> Either ReqFailure Bool)
-> m (Maybe CStore
-> ItemFull -> ItemQuant -> Either ReqFailure Bool)
forall a b. (a -> b) -> a -> b
$ RuleContent
-> Time
-> Int
-> Bool
-> Maybe CStore
-> ItemFull
-> ItemQuant
-> Either ReqFailure Bool
permittedApply RuleContent
corule Time
localTime Int
skill Bool
calmE
pickLeaderHuman :: MonadClientUI m => Int -> m MError
pickLeaderHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m MError
pickLeaderHuman Int
k = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
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.! FactionId
side) (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
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
Maybe (ActorId, Actor)
mhero <- (State -> Maybe (ActorId, Actor)) -> m (Maybe (ActorId, Actor))
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (ActorId, Actor)) -> m (Maybe (ActorId, Actor)))
-> (State -> Maybe (ActorId, Actor)) -> m (Maybe (ActorId, Actor))
forall a b. (a -> b) -> a -> b
$ ActorDictUI -> FactionId -> Int -> State -> Maybe (ActorId, Actor)
tryFindHeroK ActorDictUI
sactorUI FactionId
side Int
k
[(ActorId, Actor)]
allOurs <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> [(ActorId, Actor)]
fidActorNotProjGlobalAssocs FactionId
side
let allOursUI :: [(ActorId, Actor, ActorUI)]
allOursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ActorId
aid, Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
allOurs
hs :: [(ActorId, Actor, ActorUI)]
hs = ((ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId))
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId)
keySelected [(ActorId, Actor, ActorUI)]
allOursUI
mactor :: Maybe (ActorId, Actor)
mactor = case Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
drop Int
k [(ActorId, Actor, ActorUI)]
hs of
[] -> Maybe (ActorId, Actor)
forall a. Maybe a
Nothing
(ActorId
aid, Actor
b, ActorUI
_) : [(ActorId, Actor, ActorUI)]
_ -> (ActorId, Actor) -> Maybe (ActorId, Actor)
forall a. a -> Maybe a
Just (ActorId
aid, Actor
b)
mchoice :: Maybe (ActorId, Actor)
mchoice = if FactionKind -> Bool
FK.fhasGender (Faction -> FactionKind
gkind Faction
fact) then Maybe (ActorId, Actor)
mhero else Maybe (ActorId, Actor)
mactor
banned :: Bool
banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
case Maybe (ActorId, Actor)
mchoice of
Maybe (ActorId, Actor)
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"no such member of the party"
Just (ActorId
aid, Actor
b)
| Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
arena Bool -> Bool -> Bool
&& Bool
banned ->
Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
NoChangeDunLeader
| Bool
otherwise -> do
m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
True ActorId
aid
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
pickLeaderWithPointerHuman :: MonadClientUI m => ActorId -> m MError
pickLeaderWithPointerHuman :: forall (m :: * -> *). MonadClientUI m => ActorId -> m MError
pickLeaderWithPointerHuman = ActorId -> m MError
forall (m :: * -> *). MonadClientUI m => ActorId -> m MError
pickLeaderWithPointer
pointmanCycleLevelHuman :: MonadClientUI m => ActorId -> Direction -> m MError
pointmanCycleLevelHuman :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Direction -> m MError
pointmanCycleLevelHuman ActorId
leader = ActorId -> Bool -> Direction -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycleLevel ActorId
leader Bool
True
pointmanCycleHuman :: MonadClientUI m => ActorId -> Direction -> m MError
pointmanCycleHuman :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Direction -> m MError
pointmanCycleHuman ActorId
leader = ActorId -> Bool -> Direction -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycle ActorId
leader Bool
True
selectActorHuman :: MonadClientUI m => ActorId -> m ()
selectActorHuman :: forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
selectActorHuman ActorId
leader = do
ActorUI
bodyUI <- (SessionUI -> ActorUI) -> m ActorUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
Bool
wasMemeber <- (SessionUI -> Bool) -> m Bool
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Bool) -> m Bool) -> (SessionUI -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
leader (EnumSet ActorId -> Bool)
-> (SessionUI -> EnumSet ActorId) -> SessionUI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumSet ActorId
sselected
let upd :: EnumSet ActorId -> EnumSet ActorId
upd = if Bool
wasMemeber
then ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete ActorId
leader
else ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ActorId
leader
(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 {sselected = upd $ sselected sess}
let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
bodyUI
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, if Bool
wasMemeber
then Part
"deselected"
else Part
"selected"]
selectNoneHuman :: MonadClientUI m => m ()
selectNoneHuman :: forall (m :: * -> *). MonadClientUI m => m ()
selectNoneHuman = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
[ActorId]
oursIds <- (State -> [ActorId]) -> m [ActorId]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [ActorId]) -> m [ActorId])
-> (State -> [ActorId]) -> m [ActorId]
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> [ActorId]
fidActorRegularIds FactionId
side LevelId
lidV
let ours :: EnumSet ActorId
ours = [ActorId] -> EnumSet ActorId
forall k. Enum k => [k] -> EnumSet k
ES.fromDistinctAscList [ActorId]
oursIds
EnumSet ActorId
oldSel <- (SessionUI -> EnumSet ActorId) -> m (EnumSet ActorId)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumSet ActorId
sselected
let wasNone :: Bool
wasNone = EnumSet ActorId -> Bool
forall k. EnumSet k -> Bool
ES.null (EnumSet ActorId -> Bool) -> EnumSet ActorId -> Bool
forall a b. (a -> b) -> a -> b
$ EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.intersection EnumSet ActorId
ours EnumSet ActorId
oldSel
upd :: EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
upd = if Bool
wasNone
then EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.union
else EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.difference
(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 {sselected = upd (sselected sess) ours}
let subject :: Part
subject = Part
"all party members on the level"
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, if Bool
wasNone
then Part
"selected"
else Part
"deselected"]
selectWithPointerHuman :: MonadClientUI m => m MError
selectWithPointerHuman :: forall (m :: * -> *). MonadClientUI m => m MError
selectWithPointerHuman = do
COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rHeightMax :: RuleContent -> Int
rHeightMax :: Int
rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
[(ActorId, Actor)]
ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ActorId, Actor) -> Bool) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Bool
bproj (Actor -> Bool)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd)
([(ActorId, Actor)] -> [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) LevelId
lidV
ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
let oursUI :: [(ActorId, Actor, ActorUI)]
oursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ActorId
aid, Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
ours
viewed :: [(ActorId, Actor, ActorUI)]
viewed = ((ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId))
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId)
keySelected [(ActorId, Actor, ActorUI)]
oursUI
PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
let p :: Point
p@(Point Int
px Int
py) = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
if | Int
py Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rHeightMax Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Bool -> Bool -> Bool
&& Int
px Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> m ()
forall (m :: * -> *). MonadClientUI m => m ()
selectNoneHuman m () -> m MError -> m MError
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
| Int
py Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rHeightMax Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 ->
case Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
drop (Int
px Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(ActorId, Actor, ActorUI)]
viewed of
[] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"not pointing at an actor"
(ActorId
aid, Actor
_, ActorUI
_) : [(ActorId, Actor, ActorUI)]
_ -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
selectActorHuman ActorId
aid m () -> m MError -> m MError
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
| Bool
otherwise ->
case ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> Maybe (ActorId, Actor)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(ActorId
_, Actor
b) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p) [(ActorId, Actor)]
ours of
Maybe (ActorId, Actor)
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"not pointing at an actor"
Just (ActorId
aid, Actor
_) -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
selectActorHuman ActorId
aid m () -> m MError -> m MError
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
repeatHuman :: MonadClientUI m => Int -> m ()
repeatHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
repeatHuman Int
n =
(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 ->
let (KeyMacroFrame
smacroFrameNew, [KeyMacroFrame]
smacroStackMew) =
Int
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
repeatHumanTransition Int
n (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) (SessionUI -> [KeyMacroFrame]
smacroStack SessionUI
sess)
in SessionUI
sess { smacroFrame = smacroFrameNew
, smacroStack = smacroStackMew }
repeatHumanTransition :: Int -> KeyMacroFrame -> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
repeatHumanTransition :: Int
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
repeatHumanTransition Int
n KeyMacroFrame
macroFrame [KeyMacroFrame]
macroFrames =
let kms :: [KM]
kms = [[KM]] -> [KM]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KM]] -> [KM])
-> (Either [KM] KeyMacro -> [[KM]]) -> Either [KM] KeyMacro -> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [KM] -> [[KM]]
forall a. Int -> a -> [a]
replicate Int
n ([KM] -> [[KM]])
-> (Either [KM] KeyMacro -> [KM]) -> Either [KM] KeyMacro -> [[KM]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMacro -> [KM]
unKeyMacro (KeyMacro -> [KM])
-> (Either [KM] KeyMacro -> KeyMacro)
-> Either [KM] KeyMacro
-> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMacro -> Either [KM] KeyMacro -> KeyMacro
forall b a. b -> Either a b -> b
fromRight KeyMacro
forall a. Monoid a => a
mempty
(Either [KM] KeyMacro -> [KM]) -> Either [KM] KeyMacro -> [KM]
forall a b. (a -> b) -> a -> b
$ KeyMacroFrame -> Either [KM] KeyMacro
keyMacroBuffer KeyMacroFrame
macroFrame
in [KM]
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
macroHumanTransition [KM]
kms KeyMacroFrame
macroFrame [KeyMacroFrame]
macroFrames
repeatLastHuman :: MonadClientUI m => Int -> m ()
repeatLastHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
repeatLastHuman Int
n = (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 {smacroFrame = repeatLastHumanTransition n (smacroFrame sess) }
repeatLastHumanTransition :: Int -> KeyMacroFrame -> KeyMacroFrame
repeatLastHumanTransition :: Int -> KeyMacroFrame -> KeyMacroFrame
repeatLastHumanTransition Int
n KeyMacroFrame
macroFrame =
let macro :: KeyMacro
macro = [KM] -> KeyMacro
KeyMacro ([KM] -> KeyMacro) -> (Maybe KM -> [KM]) -> Maybe KM -> KeyMacro
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[KM]] -> [KM]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KM]] -> [KM]) -> (Maybe KM -> [[KM]]) -> Maybe KM -> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [KM] -> [[KM]]
forall a. Int -> a -> [a]
replicate Int
n ([KM] -> [[KM]]) -> (Maybe KM -> [KM]) -> Maybe KM -> [[KM]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe KM -> [KM]
forall a. Maybe a -> [a]
maybeToList (Maybe KM -> KeyMacro) -> Maybe KM -> KeyMacro
forall a b. (a -> b) -> a -> b
$ KeyMacroFrame -> Maybe KM
keyLast KeyMacroFrame
macroFrame
in KeyMacroFrame
macroFrame { keyPending = macro <> keyPending macroFrame }
recordHuman :: MonadClientUI m => m ()
recordHuman :: forall (m :: * -> *). MonadClientUI m => m ()
recordHuman = do
KeyMacroFrame
smacroFrameOld <- (SessionUI -> KeyMacroFrame) -> m KeyMacroFrame
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> KeyMacroFrame
smacroFrame
let (KeyMacroFrame
smacroFrameNew, Text
msg) = KeyMacroFrame -> (KeyMacroFrame, Text)
recordHumanTransition KeyMacroFrame
smacroFrameOld
(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 {smacroFrame = smacroFrameNew}
[KeyMacroFrame]
macroStack <- (SessionUI -> [KeyMacroFrame]) -> m [KeyMacroFrame]
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> [KeyMacroFrame]
smacroStack
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg Bool -> Bool -> Bool
|| Bool -> Bool
not ([KeyMacroFrame] -> Bool
forall a. [a] -> Bool
null [KeyMacroFrame]
macroStack)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
msg
recordHumanTransition :: KeyMacroFrame -> (KeyMacroFrame, Text)
recordHumanTransition :: KeyMacroFrame -> (KeyMacroFrame, Text)
recordHumanTransition KeyMacroFrame
macroFrame =
let (Either [KM] KeyMacro
buffer, Text
msg) = case KeyMacroFrame -> Either [KM] KeyMacro
keyMacroBuffer KeyMacroFrame
macroFrame of
Right KeyMacro
_ ->
([KM] -> Either [KM] KeyMacro
forall a b. a -> Either a b
Left [], Text
"Recording a macro. Stop recording with the same key.")
Left [KM]
xs ->
(KeyMacro -> Either [KM] KeyMacro
forall a b. b -> Either a b
Right (KeyMacro -> Either [KM] KeyMacro)
-> ([KM] -> KeyMacro) -> [KM] -> Either [KM] KeyMacro
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KM] -> KeyMacro
KeyMacro ([KM] -> KeyMacro) -> ([KM] -> [KM]) -> [KM] -> KeyMacro
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KM] -> [KM]
forall a. [a] -> [a]
reverse ([KM] -> Either [KM] KeyMacro) -> [KM] -> Either [KM] KeyMacro
forall a b. (a -> b) -> a -> b
$ [KM]
xs, Text
"Macro recording stopped.")
smacroFrameNew :: KeyMacroFrame
smacroFrameNew = KeyMacroFrame
macroFrame {keyMacroBuffer = buffer}
in (KeyMacroFrame
smacroFrameNew, Text
msg)
allHistoryHuman :: forall m. MonadClientUI m => m ()
allHistoryHuman :: forall (m :: * -> *). MonadClientUI m => m ()
allHistoryHuman = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth, Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
History
history <- (SessionUI -> History) -> m History
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> History
shistory
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
Time
localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
arena
Time
global <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
FontSetup{DisplayFont
propFont :: FontSetup -> DisplayFont
squareFont :: DisplayFont
monoFont :: DisplayFont
propFont :: DisplayFont
squareFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let renderedHistoryRaw :: [AttrString]
renderedHistoryRaw = History -> [AttrString]
renderHistory History
history
histLenRaw :: Int
histLenRaw = [AttrString] -> Int
forall a. [a] -> Int
length [AttrString]
renderedHistoryRaw
placeholderLine :: AttrString
placeholderLine = Color -> Text -> AttrString
textFgToAS Color
Color.BrBlack
Text
"Newest_messages_are_at_the_bottom._Press_END_to_get_there."
placeholderCount :: Int
placeholderCount =
(- Int
histLenRaw Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
renderedHistory :: [AttrString]
renderedHistory = Int -> AttrString -> [AttrString]
forall a. Int -> a -> [a]
replicate Int
placeholderCount AttrString
placeholderLine
[AttrString] -> [AttrString] -> [AttrString]
forall a. [a] -> [a] -> [a]
++ [AttrString]
renderedHistoryRaw
histLen :: Int
histLen = Int
placeholderCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
histLenRaw
splitRow :: AttrString -> (AttrLine, (Int, AttrLine))
splitRow AttrString
as =
let (AttrString
tLab, AttrString
tDesc) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrCharW32
Color.spaceAttrW32) AttrString
as
labLen :: Int
labLen = DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
monoFont AttrString
tLab
par1 :: AttrLine
par1 = case (AttrLine -> Bool) -> [AttrLine] -> [AttrLine]
forall a. (a -> Bool) -> [a] -> [a]
filter (AttrLine -> AttrLine -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrLine
emptyAttrLine) ([AttrLine] -> [AttrLine]) -> [AttrLine] -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ AttrString -> [AttrLine]
linesAttr AttrString
tDesc of
[] -> AttrLine
emptyAttrLine
[AttrLine
l] -> AttrLine
l
[AttrLine]
ls -> AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ AttrString -> [AttrString] -> AttrString
forall a. [a] -> [[a]] -> [a]
intercalate [AttrCharW32
Color.spaceAttrW32]
([AttrString] -> AttrString) -> [AttrString] -> AttrString
forall a b. (a -> b) -> a -> b
$ (AttrLine -> AttrString) -> [AttrLine] -> [AttrString]
forall a b. (a -> b) -> [a] -> [b]
map AttrLine -> AttrString
attrLine [AttrLine]
ls
in (AttrString -> AttrLine
attrStringToAL AttrString
tLab, (Int
labLen, AttrLine
par1))
([AttrLine]
tsLab, [(Int, AttrLine)]
tsDesc) = [(AttrLine, (Int, AttrLine))] -> ([AttrLine], [(Int, AttrLine)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(AttrLine, (Int, AttrLine))] -> ([AttrLine], [(Int, AttrLine)]))
-> [(AttrLine, (Int, AttrLine))] -> ([AttrLine], [(Int, AttrLine)])
forall a b. (a -> b) -> a -> b
$ (AttrString -> (AttrLine, (Int, AttrLine)))
-> [AttrString] -> [(AttrLine, (Int, AttrLine))]
forall a b. (a -> b) -> [a] -> [b]
map AttrString -> (AttrLine, (Int, AttrLine))
splitRow [AttrString]
renderedHistory
ovs :: EnumMap DisplayFont Overlay
ovs = (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
monoFont ([AttrLine] -> Overlay
offsetOverlay [AttrLine]
tsLab)
(EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
tsDesc
turnsGlobal :: Int
turnsGlobal = Time
global Time -> Time -> Int
`timeFitUp` Time
timeTurn
turnsLocal :: Int
turnsLocal = Time
localTime Time -> Time -> Int
`timeFitUp` Time
timeTurn
msg :: Text
msg = [Part] -> Text
makeSentence
[ Part
"You survived for"
, Int -> Part -> Part
MU.CarWs Int
turnsGlobal Part
"half-second turn"
, Part
"(this level:"
, Int -> Part
MU.Car Int
turnsLocal Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Part
")" ]
kxs :: [KYX]
kxs = [ (MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
sn, ( Int -> Int -> PointUI
PointUI Int
0 (MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
sn)
, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont Int
1000 ))
| MenuSlot
sn <- Int -> [MenuSlot] -> [MenuSlot]
forall a. Int -> [a] -> [a]
take Int
histLen [MenuSlot]
natSlots ]
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
msg
let keysAllHistory :: [KM]
keysAllHistory =
KM
K.returnKM
#ifndef USE_JSFILE
KM -> [KM] -> [KM]
forall a. a -> [a] -> [a]
: Char -> KM
K.mkChar Char
'.'
#endif
KM -> [KM] -> [KM]
forall a. a -> [a] -> [a]
: [KM
K.spaceKM, KM
K.escKM]
Slideshow
slides <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [KM]
keysAllHistory (EnumMap DisplayFont Overlay
ovs, [KYX]
kxs)
let historyLines :: [KYX]
historyLines = case [KYX] -> [KYX]
forall a. [a] -> [a]
reverse ([KYX] -> [KYX]) -> [KYX] -> [KYX]
forall a b. (a -> b) -> a -> b
$ (OKX -> [KYX]) -> [OKX] -> [KYX]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OKX -> [KYX]
forall a b. (a, b) -> b
snd ([OKX] -> [KYX]) -> [OKX] -> [KYX]
forall a b. (a -> b) -> a -> b
$ Slideshow -> [OKX]
slideshow Slideshow
slides of
(Left{}, (PointUI, ButtonWidth)
_) : [KYX]
rest -> [KYX]
rest
[KYX]
l -> [KYX]
l
maxIx :: Int
maxIx = [KYX] -> Int
forall a. [a] -> Int
length [KYX]
historyLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [KM] -> Int
forall a. [a] -> Int
length [KM]
keysAllHistory
menuName :: String
menuName = String
"history"
(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 {smenuIxMap = M.insert menuName maxIx $ smenuIxMap sess}
let displayAllHistory :: m ()
displayAllHistory = do
KeyOrSlot
ekm <- String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreen String
menuName ColorMode
ColorFull Bool
False Slideshow
slides
[KM]
keysAllHistory
case KeyOrSlot
ekm of
Left KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> KM
K.mkChar Char
'.' -> do
let t :: Text
t = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (AttrString -> Text) -> [AttrString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (AttrString -> String) -> AttrString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrCharW32 -> Char) -> AttrString -> String
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> Char
Color.charFromW32)
[AttrString]
renderedHistoryRaw
String
path <- Text -> String -> m String
forall (m :: * -> *).
MonadClientRead m =>
Text -> String -> m String
dumpTextFile Text
t String
"history.txt"
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"All of history dumped to file" Text -> Text -> Text
<+> String -> Text
T.pack String
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
Left KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.escKM ->
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
"Try to survive a few seconds more, if you can."
Left KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.spaceKM ->
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
"Steady on."
Left KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.returnKM ->
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
"Press RET when history message selected to see it in full."
Right MenuSlot
slot ->
MenuSlot -> m ()
displayOneReport (MenuSlot -> m ()) -> MenuSlot -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MenuSlot
forall a. Enum a => Int -> a
toEnum (Int -> MenuSlot) -> Int -> MenuSlot
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
placeholderCount
KeyOrSlot
_ -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> KeyOrSlot -> String
forall v. Show v => String -> v -> String
`showFailure` KeyOrSlot
ekm
displayOneReport :: MenuSlot -> m ()
displayOneReport :: MenuSlot -> m ()
displayOneReport MenuSlot
slot0 = do
let renderOneItem :: MenuSlot -> m OKX
renderOneItem MenuSlot
slot = do
let timeReport :: AttrString
timeReport = case Int -> [AttrString] -> [AttrString]
forall a. Int -> [a] -> [a]
drop (MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot)
[AttrString]
renderedHistoryRaw of
[] -> String -> AttrString
forall a. HasCallStack => String -> a
error (String -> AttrString) -> String -> AttrString
forall a b. (a -> b) -> a -> b
$ String
"" String -> MenuSlot -> String
forall v. Show v => String -> v -> String
`showFailure` MenuSlot
slot
AttrString
tR : [AttrString]
_ -> AttrString
tR
markParagraph :: AttrCharW32 -> AttrString
markParagraph AttrCharW32
c | AttrCharW32 -> Char
Color.charFromW32 AttrCharW32
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = [AttrCharW32
c, AttrCharW32
c]
markParagraph AttrCharW32
c = [AttrCharW32
c]
reportWithParagraphs :: AttrString
reportWithParagraphs = (AttrCharW32 -> AttrString) -> AttrString -> AttrString
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AttrCharW32 -> AttrString
markParagraph AttrString
timeReport
(Overlay
ovLab, Overlay
ovDesc) =
DisplayFont -> Int -> AttrString -> (Overlay, Overlay)
labDescOverlay DisplayFont
monoFont Int
rwidth AttrString
reportWithParagraphs
ov0 :: EnumMap DisplayFont Overlay
ov0 = (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
monoFont Overlay
ovLab
(EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont Overlay
ovDesc
prompt :: Text
prompt = [Part] -> Text
makeSentence
[ Part
"the", Int -> Part
MU.Ordinal (Int -> Part) -> Int -> Part
forall a b. (a -> b) -> a -> b
$ MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
, Part
"most recent record follows" ]
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt
OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov0, [])
extraKeys :: [a]
extraKeys = []
slotBound :: Int
slotBound = Int
histLenRaw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
KM
km <- (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
forall a. [a]
extraKeys Int
slotBound MenuSlot
slot0
case KM -> Key
K.key KM
km of
Key
K.Space -> m ()
displayAllHistory
Key
K.Esc -> MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric
Text
"Try to learn from your previous mistakes."
Key
_ -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
m ()
displayAllHistory
markVisionHuman :: MonadClientUI m => Int -> m ()
markVisionHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
markVisionHuman Int
delta = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> SessionUI -> SessionUI
cycleMarkVision Int
delta
markSmellHuman :: MonadClientUI m => m ()
markSmellHuman :: forall (m :: * -> *). MonadClientUI m => m ()
markSmellHuman = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession SessionUI -> SessionUI
toggleMarkSmell
markSuspectHuman :: MonadClient m => Int -> m ()
markSuspectHuman :: forall (m :: * -> *). MonadClient m => Int -> m ()
markSuspectHuman Int
delta = do
m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsAll
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient (Int -> StateClient -> StateClient
cycleMarkSuspect Int
delta)
markAnimHuman :: MonadClient m => m ()
markAnimHuman :: forall (m :: * -> *). MonadClient m => m ()
markAnimHuman = do
Bool
noAnim <- (StateClient -> Bool) -> m Bool
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Bool) -> m Bool)
-> (StateClient -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (StateClient -> Maybe Bool) -> StateClient -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientOptions -> Maybe Bool
snoAnim (ClientOptions -> Maybe Bool)
-> (StateClient -> ClientOptions) -> StateClient -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli ->
StateClient
cli {soptions = (soptions cli) {snoAnim = Just $ not noAnim}}
overrideTutHuman :: MonadClientUI m => Int -> m ()
overrideTutHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
overrideTutHuman Int
delta = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> SessionUI -> SessionUI
cycleOverrideTut Int
delta
printScreenHuman :: MonadClientUI m => m ()
printScreenHuman :: forall (m :: * -> *). MonadClientUI m => m ()
printScreenHuman = do
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert Text
"Screenshot printed."
m ()
forall (m :: * -> *). MonadClientUI m => m ()
printScreen
cancelHuman :: MonadClientUI m => m ()
cancelHuman :: forall (m :: * -> *). MonadClientUI m => m ()
cancelHuman = do
Maybe AimMode
maimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
case Maybe AimMode
maimMode of
Just AimMode
aimMode -> do
let lidV :: LevelId
lidV = AimMode -> LevelId
aimLevelId AimMode
aimMode
LevelId
lidOur <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
if LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidOur
then m ()
forall (m :: * -> *). MonadClientUI m => m ()
clearAimMode
else do
Point
xhairPos <- m Point
forall (m :: * -> *). MonadClientUI m => m Point
xhairToPos
let sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidOur Point
xhairPos
(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 {saimMode = Just aimMode {aimLevelId = lidOur}}
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
Maybe AimMode
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
acceptHuman :: (MonadClient m, MonadClientUI m) => ActorId -> m ()
acceptHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
acceptHuman ActorId
leader = do
ActorId -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
endAiming ActorId
leader
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
endAimingMsg ActorId
leader
m ()
forall (m :: * -> *). MonadClientUI m => m ()
clearAimMode
endAiming :: (MonadClient m, MonadClientUI m) => ActorId -> m ()
endAiming :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
endAiming ActorId
leader = do
Maybe Target
sxhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
updateTarget ActorId
leader ((Maybe Target -> Maybe Target) -> StateClient -> StateClient)
-> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
forall a b. (a -> b) -> a -> b
$ Maybe Target -> Maybe Target -> Maybe Target
forall a b. a -> b -> a
const Maybe Target
sxhair
endAimingMsg :: MonadClientUI m => ActorId -> m ()
endAimingMsg :: forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
endAimingMsg ActorId
leader = do
Part
subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
leader
Maybe Target
tgt <- (StateClient -> Maybe Target) -> m (Maybe Target)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Maybe Target) -> m (Maybe Target))
-> (StateClient -> Maybe Target) -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ ActorId -> StateClient -> Maybe Target
getTarget ActorId
leader
(Maybe Text
mtargetMsg, Maybe Text
_) <- Maybe Target -> m (Maybe Text, Maybe Text)
forall (m :: * -> *).
MonadClientUI m =>
Maybe Target -> m (Maybe Text, Maybe Text)
targetDesc Maybe Target
tgt
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ case Maybe Text
mtargetMsg of
Maybe Text
Nothing ->
[Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
"clear target"]
Just Text
targetMsg ->
[Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
"target", Text -> Part
MU.Text Text
targetMsg]
detailCycleHuman :: MonadClientUI m => m ()
detailCycleHuman :: forall (m :: * -> *). MonadClientUI m => m ()
detailCycleHuman = do
(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 {saimMode =
(\AimMode
aimMode -> AimMode
aimMode {detailLevel = detailCycle $ detailLevel aimMode})
<$> saimMode sess}
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
detailCycle :: DetailLevel -> DetailLevel
detailCycle :: DetailLevel -> DetailLevel
detailCycle DetailLevel
detail = if DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
forall a. Bounded a => a
minBound then DetailLevel
forall a. Bounded a => a
maxBound else DetailLevel -> DetailLevel
forall a. Enum a => a -> a
pred DetailLevel
detail
clearTargetIfItemClearHuman :: (MonadClient m, MonadClientUI m)
=> ActorId -> m ()
clearTargetIfItemClearHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
clearTargetIfItemClearHuman ActorId
leader = do
Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (ItemId, CStore, Bool) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (ItemId, CStore, Bool)
itemSel) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
forall a. Maybe a
Nothing
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
updateTarget ActorId
leader (Maybe Target -> Maybe Target -> Maybe Target
forall a b. a -> b -> a
const Maybe Target
forall a. Maybe a
Nothing)
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
itemClearHuman :: MonadClientUI m => m ()
itemClearHuman :: forall (m :: * -> *). MonadClientUI m => m ()
itemClearHuman = (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 {sitemSel = Nothing}
moveXhairHuman :: MonadClientUI m => Vector -> Int -> m MError
moveXhairHuman :: forall (m :: * -> *). MonadClientUI m => Vector -> Int -> m MError
moveXhairHuman Vector
dir Int
n = do
COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: RuleContent -> Int
rWidthMax :: Int
rWidthMax, Int
rHeightMax :: RuleContent -> Int
rHeightMax :: Int
rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
let lidV :: LevelId
lidV = LevelId -> (AimMode -> LevelId) -> Maybe AimMode -> LevelId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> LevelId
forall a. HasCallStack => String -> a
error (String -> LevelId) -> String -> LevelId
forall a b. (a -> b) -> a -> b
$ String
"" String -> (Vector, Int) -> String
forall v. Show v => String -> v -> String
`showFailure` (Vector
dir, Int
n)) AimMode -> LevelId
aimLevelId Maybe AimMode
saimMode
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
Point
xhairPos <- m Point
forall (m :: * -> *). MonadClientUI m => m Point
xhairToPos
let shiftB :: Point -> Point
shiftB Point
pos = Int -> Int -> Point -> Vector -> Point
shiftBounded Int
rWidthMax Int
rHeightMax Point
pos Vector
dir
newPos :: Point
newPos = (Point -> Point) -> Point -> [Point]
forall a. (a -> a) -> a -> [a]
iterate Point -> Point
shiftB Point
xhairPos [Point] -> Int -> Point
forall a. HasCallStack => [a] -> Int -> a
!! Int
n
if Point
newPos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
xhairPos then Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"never mind"
else do
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Maybe Target
sxhair <- case (Maybe Target
xhair, Maybe ActorId
mleader) of
(Just TVector{}, Just ActorId
leader) -> do
Point
lpos <- (State -> Point) -> m Point
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Point) -> m Point) -> (State -> Point) -> m Point
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
Maybe Target -> m (Maybe Target)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Target -> m (Maybe Target))
-> Maybe Target -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ Vector -> Target
TVector (Vector -> Target) -> Vector -> Target
forall a b. (a -> b) -> a -> b
$ Point
newPos Point -> Point -> Vector
`vectorToFrom` Point
lpos
(Maybe Target, Maybe ActorId)
_ -> Maybe Target -> m (Maybe Target)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Target -> m (Maybe Target))
-> Maybe Target -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidV Point
newPos
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
aimTgtHuman :: MonadClientUI m => m ()
aimTgtHuman :: forall (m :: * -> *). MonadClientUI m => m ()
aimTgtHuman = do
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
(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 {saimMode =
let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel (SessionUI -> Maybe AimMode
saimMode SessionUI
sess)
in Just $ AimMode lidV newDetail}
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptAction Text
"*flinging started; press again to project*"
aimFloorHuman :: MonadClientUI m => m ()
aimFloorHuman :: forall (m :: * -> *). MonadClientUI m => m ()
aimFloorHuman = do
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Maybe Point
mlpos <- case Maybe ActorId
mleader of
Maybe ActorId
Nothing -> Maybe Point -> m (Maybe Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
forall a. Maybe a
Nothing
Just ActorId
leader -> (State -> Maybe Point) -> m (Maybe Point)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> (State -> Point) -> State -> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
Point
xhairPos <- m Point
forall (m :: * -> *). MonadClientUI m => m Point
xhairToPos
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
[(ActorId, Actor)]
bsAll <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (Bool -> FactionId -> Bool
forall a b. a -> b -> a
const Bool
True) LevelId
lidV
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
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.! FactionId
side) (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
let sxhair :: Maybe Target
sxhair = case Maybe Target
xhair of
Maybe Target
_ | Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode ->
Maybe Target
xhair
Just TEnemy{} -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidV Point
xhairPos
Just TNonEnemy{} -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidV Point
xhairPos
Just TPoint{} | Just Point
lpos <- Maybe Point
mlpos, Point
xhairPos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
lpos ->
Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ Vector -> Target
TVector (Vector -> Target) -> Vector -> Target
forall a b. (a -> b) -> a -> b
$ Point
xhairPos Point -> Point -> Vector
`vectorToFrom` Point
lpos
Just TVector{} ->
case ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> Maybe (ActorId, Actor)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(ActorId
_, Actor
b) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
xhairPos) [(ActorId, Actor)]
bsAll of
Just (ActorId
aid, Actor
b) -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ if FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b)
then ActorId -> Target
TEnemy ActorId
aid
else ActorId -> Target
TNonEnemy ActorId
aid
Maybe (ActorId, Actor)
Nothing -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown LevelId
lidV Point
xhairPos
Maybe Target
_ -> Maybe Target
xhair
(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 {saimMode =
let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
in Just $ AimMode lidV newDetail}
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
aimEnemyHuman :: MonadClientUI m => m ()
aimEnemyHuman :: forall (m :: * -> *). MonadClientUI m => m ()
aimEnemyHuman = do
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Maybe Point
mlpos <- case Maybe ActorId
mleader of
Maybe ActorId
Nothing -> Maybe Point -> m (Maybe Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
forall a. Maybe a
Nothing
Just ActorId
leader -> (State -> Maybe Point) -> m (Maybe Point)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> (State -> Point) -> State -> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
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.! FactionId
side) (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
[(ActorId, Actor)]
bsAll <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (Bool -> FactionId -> Bool
forall a b. a -> b -> a
const Bool
True) LevelId
lidV
let
ordPos :: Point -> (a, Actor) -> (Int, Point, Bool)
ordPos Point
lpos (a
_, Actor
b) = (Point -> Point -> Int
chessDist Point
lpos (Point -> Int) -> Point -> Int
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
b, Actor -> Point
bpos Actor
b, Actor -> Bool
bproj Actor
b)
dbs :: [(ActorId, Actor)]
dbs = case Maybe Point
mlpos of
Maybe Point
Nothing -> [(ActorId, Actor)]
bsAll
Just Point
lpos -> ((ActorId, Actor) -> (Int, Point, Bool))
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Point -> (ActorId, Actor) -> (Int, Point, Bool)
forall {a}. Point -> (a, Actor) -> (Int, Point, Bool)
ordPos Point
lpos) [(ActorId, Actor)]
bsAll
pickUnderXhair :: Int
pickUnderXhair =
Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Point
mxhairPos) (Maybe Point -> Bool)
-> ((ActorId, Actor) -> Maybe Point) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point)
-> ((ActorId, Actor) -> Point) -> (ActorId, Actor) -> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos (Actor -> Point)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd) [(ActorId, Actor)]
dbs
(Bool
pickEnemies, Int
i) = case Maybe Target
xhair of
Just (TEnemy ActorId
a) | Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode ->
(Bool
True, Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
a) (ActorId -> Bool)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
dbs))
Just (TEnemy ActorId
a) ->
(Bool
True, Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
a) (ActorId -> Bool)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
dbs)
Just (TNonEnemy ActorId
a) | Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode ->
(Bool
False, Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
a) (ActorId -> Bool)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
dbs))
Just (TNonEnemy ActorId
a) ->
(Bool
False, Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
a) (ActorId -> Bool)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
dbs)
Maybe Target
_ -> (Bool
True, Int
pickUnderXhair)
([(ActorId, Actor)]
lt, [(ActorId, Actor)]
gt) = Int
-> [(ActorId, Actor)] -> ([(ActorId, Actor)], [(ActorId, Actor)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [(ActorId, Actor)]
dbs
isEnemy :: Actor -> Bool
isEnemy Actor
b = FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b)
Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)
Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
cond :: Actor -> Bool
cond = if Bool
pickEnemies then Actor -> Bool
isEnemy else Bool -> Bool
not (Bool -> Bool) -> (Actor -> Bool) -> Actor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Bool
isEnemy
lf :: [(ActorId, Actor)]
lf = ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Actor -> Bool
cond (Actor -> Bool)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd) ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ [(ActorId, Actor)]
gt [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. [a] -> [a] -> [a]
++ [(ActorId, Actor)]
lt
sxhair :: Maybe Target
sxhair = case [(ActorId, Actor)]
lf of
(ActorId
a, Actor
_) : [(ActorId, Actor)]
_ -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ if Bool
pickEnemies then ActorId -> Target
TEnemy ActorId
a else ActorId -> Target
TNonEnemy ActorId
a
[] -> Maybe Target
xhair
(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 {saimMode =
let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
in Just $ AimMode lidV newDetail}
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
aimItemHuman :: MonadClientUI m => m ()
aimItemHuman :: forall (m :: * -> *). MonadClientUI m => m ()
aimItemHuman = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
Maybe Point
mlpos <- case Maybe ActorId
mleader of
Maybe ActorId
Nothing -> Maybe Point -> m (Maybe Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
forall a. Maybe a
Nothing
Just ActorId
leader -> (State -> Maybe Point) -> m (Maybe Point)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> (State -> Point) -> State -> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
Level{ItemFloor
lfloor :: ItemFloor
lfloor :: Level -> ItemFloor
lfloor} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lidV
Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side
let lfloorBarStash :: ItemFloor
lfloorBarStash = case Maybe (LevelId, Point)
mstash of
Just (LevelId
lid, Point
pos) | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV -> Point -> ItemFloor -> ItemFloor
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete Point
pos ItemFloor
lfloor
Maybe (LevelId, Point)
_ -> ItemFloor
lfloor
bsAll :: [Point]
bsAll = ItemFloor -> [Point]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemFloor
lfloorBarStash
ordPos :: Point -> Point -> (Int, Point)
ordPos Point
lpos Point
p = (Point -> Point -> Int
chessDist Point
lpos Point
p, Point
p)
dbs :: [Point]
dbs = case Maybe Point
mlpos of
Maybe Point
Nothing -> [Point]
bsAll
Just Point
lpos -> (Point -> (Int, Point)) -> [Point] -> [Point]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Point -> Point -> (Int, Point)
ordPos Point
lpos) [Point]
bsAll
pickUnderXhair :: ([Point], [Point])
pickUnderXhair =
let i :: Int
i = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1)
(Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Point
mxhairPos) (Maybe Point -> Bool) -> (Point -> Maybe Point) -> Point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Maybe Point
forall a. a -> Maybe a
Just) [Point]
dbs
in Int -> [Point] -> ([Point], [Point])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [Point]
dbs
([Point]
lt, [Point]
gt) = case Maybe Target
xhair of
Just (TPoint TGoal
_ LevelId
lid Point
pos)
| Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode Bool -> Bool -> Bool
&& LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV ->
let i :: Int
i = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Point -> [Point] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Point
pos [Point]
dbs
in Int -> [Point] -> ([Point], [Point])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Point]
dbs
Just (TPoint TGoal
_ LevelId
lid Point
pos)
| LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV ->
let i :: Int
i = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Point -> [Point] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Point
pos [Point]
dbs
in Int -> [Point] -> ([Point], [Point])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [Point]
dbs
Maybe Target
_ -> ([Point], [Point])
pickUnderXhair
gtlt :: [Point]
gtlt = [Point]
gt [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ [Point]
lt
sxhair :: Maybe Target
sxhair = case [Point]
gtlt of
Point
p : [Point]
_ -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidV Point
p
[] -> Maybe Target
xhair
(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 {saimMode =
let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
in Just $ AimMode lidV newDetail}
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
aimAscendHuman :: MonadClientUI m => Int -> m MError
aimAscendHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m MError
aimAscendHuman Int
k = do
Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
let up :: Bool
up = Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
case Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch Dungeon
dungeon Bool
up LevelId
lidV of
[] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"no more levels in this direction"
LevelId
_ : [LevelId]
_ -> do
let ascendOne :: LevelId -> LevelId
ascendOne LevelId
lid = case Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch Dungeon
dungeon Bool
up LevelId
lid of
[] -> LevelId
lid
LevelId
nlid : [LevelId]
_ -> LevelId
nlid
lidK :: LevelId
lidK = (LevelId -> LevelId) -> LevelId -> [LevelId]
forall a. (a -> a) -> a -> [a]
iterate LevelId -> LevelId
ascendOne LevelId
lidV [LevelId] -> Int -> LevelId
forall a. HasCallStack => [a] -> Int -> a
!! Int -> Int
forall a. Num a => a -> a
abs Int
k
Point
xhairPos <- m Point
forall (m :: * -> *). MonadClientUI m => m Point
xhairToPos
let sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidK Point
xhairPos
(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 {saimMode =
let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel (SessionUI -> Maybe AimMode
saimMode SessionUI
sess)
in Just $ AimMode lidK newDetail}
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
epsIncrHuman :: (MonadClient m, MonadClientUI m) => Direction -> m ()
epsIncrHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Direction -> m ()
epsIncrHuman Direction
d = do
let sepsDelta :: Int
sepsDelta = case Direction
d of
Direction
Forward -> Int
1
Direction
Backward -> -Int
1
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {seps = seps cli + sepsDelta}
m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsPathAll
(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 {sreportNull = False}
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
(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 {saimMode =
let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
DetailLow AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
in Just $ AimMode lidV newDetail}
m ()
forall (m :: * -> *). MonadClientUI m => m ()
flashAiming
(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 {saimMode}
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptAction Text
"Aiming line (possibly) modified."
flashAiming :: MonadClientUI m => m ()
flashAiming :: forall (m :: * -> *). MonadClientUI m => m ()
flashAiming = do
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
LevelId -> Animation -> m ()
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Animation -> m ()
animate LevelId
lidV Animation
pushAndDelay
xhairUnknownHuman :: (MonadClient m, MonadClientUI m) => ActorId -> m MError
xhairUnknownHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m MError
xhairUnknownHuman ActorId
leader = do
Actor
b <- (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
leader
Maybe Point
mpos <- ActorId -> m (Maybe Point)
forall (m :: * -> *). MonadClient m => ActorId -> m (Maybe Point)
closestUnknown ActorId
leader
case Maybe Point
mpos of
Maybe Point
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"no more unknown spots left"
Just Point
p -> do
let sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown (Actor -> LevelId
blid Actor
b) Point
p
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
xhairItemHuman :: (MonadClient m, MonadClientUI m) => ActorId -> m MError
xhairItemHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m MError
xhairItemHuman ActorId
leader = do
Actor
b <- (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
leader
[(Int, (Point, EnumMap ItemId ItemQuant))]
items <- ActorId -> m [(Int, (Point, EnumMap ItemId ItemQuant))]
forall (m :: * -> *).
MonadClient m =>
ActorId -> m [(Int, (Point, EnumMap ItemId ItemQuant))]
closestItems ActorId
leader
case [(Int, (Point, EnumMap ItemId ItemQuant))]
items of
[] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"no more reachable items remembered or visible"
[(Int, (Point, EnumMap ItemId ItemQuant))]
_ -> do
let (Int
_, (Point
p, EnumMap ItemId ItemQuant
bag)) = ((Int, (Point, EnumMap ItemId ItemQuant))
-> (Int, (Point, EnumMap ItemId ItemQuant)) -> Ordering)
-> [(Int, (Point, EnumMap ItemId ItemQuant))]
-> (Int, (Point, EnumMap ItemId ItemQuant))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((Int, (Point, EnumMap ItemId ItemQuant)) -> Int)
-> (Int, (Point, EnumMap ItemId ItemQuant))
-> (Int, (Point, EnumMap ItemId ItemQuant))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (Point, EnumMap ItemId ItemQuant)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (Point, EnumMap ItemId ItemQuant))]
items
sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint (EnumMap ItemId ItemQuant -> TGoal
TItem EnumMap ItemId ItemQuant
bag) (Actor -> LevelId
blid Actor
b) Point
p
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
xhairStairHuman :: (MonadClient m, MonadClientUI m)
=> ActorId -> Bool -> m MError
xhairStairHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> Bool -> m MError
xhairStairHuman ActorId
leader Bool
up = do
Actor
b <- (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
leader
[(Int, (Point, (Point, EnumMap ItemId ItemQuant)))]
stairs <- FleeViaStairsOrEscape
-> ActorId -> m [(Int, (Point, (Point, EnumMap ItemId ItemQuant)))]
forall (m :: * -> *).
MonadClient m =>
FleeViaStairsOrEscape
-> ActorId -> m [(Int, (Point, (Point, EnumMap ItemId ItemQuant)))]
closestTriggers (if Bool
up then FleeViaStairsOrEscape
ViaStairsUp else FleeViaStairsOrEscape
ViaStairsDown) ActorId
leader
case [(Int, (Point, (Point, EnumMap ItemId ItemQuant)))]
stairs of
[] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ Text
"no reachable stairs" Text -> Text -> Text
<+> if Bool
up then Text
"up" else Text
"down"
[(Int, (Point, (Point, EnumMap ItemId ItemQuant)))]
_ -> do
let (Int
_, (Point
p, (Point
p0, EnumMap ItemId ItemQuant
bag))) = ((Int, (Point, (Point, EnumMap ItemId ItemQuant)))
-> (Int, (Point, (Point, EnumMap ItemId ItemQuant))) -> Ordering)
-> [(Int, (Point, (Point, EnumMap ItemId ItemQuant)))]
-> (Int, (Point, (Point, EnumMap ItemId ItemQuant)))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((Int, (Point, (Point, EnumMap ItemId ItemQuant))) -> Int)
-> (Int, (Point, (Point, EnumMap ItemId ItemQuant)))
-> (Int, (Point, (Point, EnumMap ItemId ItemQuant)))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (Point, (Point, EnumMap ItemId ItemQuant))) -> Int
forall a b. (a, b) -> a
fst) [(Int, (Point, (Point, EnumMap ItemId ItemQuant)))]
stairs
sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint (EnumMap ItemId ItemQuant -> Point -> TGoal
TEmbed EnumMap ItemId ItemQuant
bag Point
p0) (Actor -> LevelId
blid Actor
b) Point
p
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
xhairPointerFloorHuman :: MonadClientUI m => m ()
xhairPointerFloorHuman :: forall (m :: * -> *). MonadClientUI m => m ()
xhairPointerFloorHuman = do
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
m ()
forall (m :: * -> *). MonadClientUI m => m ()
aimPointerFloorHuman
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(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 {saimMode}
xhairPointerMuteHuman :: MonadClientUI m => m ()
xhairPointerMuteHuman :: forall (m :: * -> *). MonadClientUI m => m ()
xhairPointerMuteHuman = do
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
aimPointerFloorLoud Bool
False
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(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 {saimMode}
xhairPointerEnemyHuman :: MonadClientUI m => m ()
xhairPointerEnemyHuman :: forall (m :: * -> *). MonadClientUI m => m ()
xhairPointerEnemyHuman = do
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
m ()
forall (m :: * -> *). MonadClientUI m => m ()
aimPointerEnemyHuman
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(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 {saimMode}
aimPointerFloorHuman :: MonadClientUI m => m ()
aimPointerFloorHuman :: forall (m :: * -> *). MonadClientUI m => m ()
aimPointerFloorHuman = Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
aimPointerFloorLoud Bool
True
aimPointerFloorLoud :: MonadClientUI m => Bool -> m ()
aimPointerFloorLoud :: forall (m :: * -> *). MonadClientUI m => Bool -> m ()
aimPointerFloorLoud Bool
loud = do
COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: RuleContent -> Int
rWidthMax :: Int
rWidthMax, Int
rHeightMax :: RuleContent -> Int
rHeightMax :: Int
rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
let p :: Point
p = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
if (Int, Int, Int, Int) -> Point -> Bool
insideP (Int
0, Int
0, Int
rWidthMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
rHeightMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Point
p
then do
Maybe Target
oldXhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
let sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown LevelId
lidV Point
p
sxhairMoused :: Bool
sxhairMoused = Maybe Target
sxhair Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
oldXhair
detailSucc :: AimMode -> DetailLevel
detailSucc = if Bool
sxhairMoused
then AimMode -> DetailLevel
detailLevel
else DetailLevel -> DetailLevel
detailCycle (DetailLevel -> DetailLevel)
-> (AimMode -> DetailLevel) -> AimMode -> DetailLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AimMode -> DetailLevel
detailLevel
(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 { saimMode =
let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailSucc
(SessionUI -> Maybe AimMode
saimMode SessionUI
sess)
in Just $ AimMode lidV newDetail
, sxhairMoused }
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
loud m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
else m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
aimPointerEnemyHuman :: MonadClientUI m => m ()
aimPointerEnemyHuman :: forall (m :: * -> *). MonadClientUI m => m ()
aimPointerEnemyHuman = do
COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: RuleContent -> Int
rWidthMax :: Int
rWidthMax, Int
rHeightMax :: RuleContent -> Int
rHeightMax :: Int
rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
let p :: Point
p = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
if (Int, Int, Int, Int) -> Point -> Bool
insideP (Int
0, Int
0, Int
rWidthMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
rHeightMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Point
p
then do
[(ActorId, Actor)]
bsAll <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (Bool -> FactionId -> Bool
forall a b. a -> b -> a
const Bool
True) LevelId
lidV
Maybe Target
oldXhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
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.! FactionId
side) (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
let sxhair :: Maybe Target
sxhair =
case ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> Maybe (ActorId, Actor)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(ActorId
_, Actor
b) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p) [(ActorId, Actor)]
bsAll of
Just (ActorId
aid, Actor
b) -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ if FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b)
then ActorId -> Target
TEnemy ActorId
aid
else ActorId -> Target
TNonEnemy ActorId
aid
Maybe (ActorId, Actor)
Nothing -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown LevelId
lidV Point
p
sxhairMoused :: Bool
sxhairMoused = Maybe Target
sxhair Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
oldXhair
detailSucc :: AimMode -> DetailLevel
detailSucc = if Bool
sxhairMoused
then AimMode -> DetailLevel
detailLevel
else DetailLevel -> DetailLevel
detailCycle (DetailLevel -> DetailLevel)
-> (AimMode -> DetailLevel) -> AimMode -> DetailLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AimMode -> DetailLevel
detailLevel
(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 { saimMode =
let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailSucc
(SessionUI -> Maybe AimMode
saimMode SessionUI
sess)
in Just $ AimMode lidV newDetail
, sxhairMoused }
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
else m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack