module Game.LambdaHack.Client.UI.HandleHumanLocalM
(
macroHuman
, chooseItemHuman, chooseItemDialogMode
, chooseItemProjectHuman, chooseItemApplyHuman
, psuitReq, triggerSymbols, pickLeaderHuman, pickLeaderWithPointerHuman
, memberCycleHuman, memberBackHuman
, selectActorHuman, selectNoneHuman, selectWithPointerHuman
, repeatHuman, recordHuman, allHistoryHuman, lastHistoryHuman
, markVisionHuman, markSmellHuman, markSuspectHuman, printScreenHuman
, cancelHuman, acceptHuman, clearTargetIfItemClearHuman, itemClearHuman
, moveXhairHuman, aimTgtHuman, aimFloorHuman, aimEnemyHuman, aimItemHuman
, aimAscendHuman, epsIncrHuman
, xhairUnknownHuman, xhairItemHuman, xhairStairHuman
, xhairPointerFloorHuman, xhairPointerEnemyHuman
, aimPointerFloorHuman, aimPointerEnemyHuman
#ifdef EXPOSE_INTERNAL
, permittedProjectClient, projectCheck, xhairLegalEps, posFromXhair
, permittedApplyClient, selectAid, eitherHistory, endAiming, endAimingMsg
, doLook, flashAiming
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Ord
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Client.BfsM
import Game.LambdaHack.Client.ClientOptions
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.FrameM
import Game.LambdaHack.Client.UI.HandleHelperM
import Game.LambdaHack.Client.UI.HumanCmd
import Game.LambdaHack.Client.UI.InventoryM
import Game.LambdaHack.Client.UI.ItemSlot
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.SessionUI
import Game.LambdaHack.Client.UI.SlideshowM
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
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.ItemKind as IK
import Game.LambdaHack.Content.ModeKind (fhasGender)
import qualified Game.LambdaHack.Content.PlaceKind as PK
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
macroHuman :: MonadClientUI m => [String] -> m ()
macroHuman :: [String] -> m ()
macroHuman kms :: [String]
kms = 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
$ \sess :: SessionUI
sess -> SessionUI
sess {slastPlay :: [KM]
slastPlay = (String -> KM) -> [String] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map String -> KM
K.mkKM [String]
kms [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ SessionUI -> [KM]
slastPlay SessionUI
sess}
MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgMacro (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Macro activated:" Text -> Text -> Text
<+> String -> Text
T.pack (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [String]
kms)
chooseItemHuman :: MonadClientUI m => ItemDialogMode -> m MError
chooseItemHuman :: ItemDialogMode -> m MError
chooseItemHuman c :: ItemDialogMode
c = (FailError -> MError)
-> (ItemDialogMode -> MError)
-> Either FailError ItemDialogMode
-> MError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FailError -> MError
forall a. a -> Maybe a
Just (MError -> ItemDialogMode -> MError
forall a b. a -> b -> a
const MError
forall a. Maybe a
Nothing) (Either FailError ItemDialogMode -> MError)
-> m (Either FailError ItemDialogMode) -> m MError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode ItemDialogMode
c
chooseItemDialogMode :: MonadClientUI m
=> ItemDialogMode -> m (FailOrCmd ItemDialogMode)
chooseItemDialogMode :: ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode c :: ItemDialogMode
c = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: ScreenContent -> X
rwidth :: X
rwidth, X
rheight :: ScreenContent -> X
rheight :: X
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
let prompt :: Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text
prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt body :: Actor
body bodyUI :: ActorUI
bodyUI actorMaxSk :: Skills
actorMaxSk c2 :: ItemDialogMode
c2 s :: State
s =
let (tIn :: Text
tIn, t :: Text
t) = ItemDialogMode -> (Text, Text)
ppItemDialogMode ItemDialogMode
c2
subject :: Part
subject = ActorUI -> Part
partActor ActorUI
bodyUI
f :: (a, b) -> a -> a
f (k :: a
k, _) acc :: a
acc = a
k a -> a -> a
forall a. Num a => a -> a -> a
+ a
acc
countItems :: CStore -> X
countItems store :: CStore
store = ((X, ItemTimer) -> X -> X)
-> X -> EnumMap ItemId (X, ItemTimer) -> X
forall a b k. (a -> b -> b) -> b -> EnumMap k a -> b
EM.foldr' (X, ItemTimer) -> X -> X
forall a b. Num a => (a, b) -> a -> a
f 0 (EnumMap ItemId (X, ItemTimer) -> X)
-> EnumMap ItemId (X, ItemTimer) -> X
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId (X, ItemTimer)
getBodyStoreBag Actor
body CStore
store State
s
in case ItemDialogMode
c2 of
MStore CGround ->
let n :: X
n = CStore -> X
countItems CStore
CGround
nItems :: Part
nItems = X -> Part -> Part
MU.CarAWs X
n "item"
in [Part] -> Text
makePhrase
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "notice"
, Part
nItems, "at"
, Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text "feet" ]
MStore CSha ->
let currencyName :: Text
currencyName = ItemKind -> Text
IK.iname (ItemKind -> Text) -> ItemKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem
(ContentId ItemKind -> ItemKind) -> ContentId ItemKind -> ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> GroupName ItemKind -> ContentId ItemKind
forall a. Show a => ContentData a -> GroupName a -> ContentId a
ouniqGroup ContentData ItemKind
coitem "currency"
dungeonTotal :: X
dungeonTotal = State -> X
sgold State
s
(_, total :: X
total) = FactionId -> State -> (EnumMap ItemId (X, ItemTimer), X)
calculateTotal FactionId
side State
s
n :: X
n = CStore -> X
countItems CStore
CSha
verbSha :: Part
verbSha = if | X
n X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> "find nothing"
| Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorMaxSk -> "notice"
| Bool
otherwise -> "paw distractedly"
in [Part] -> Text
makePhrase
[ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text -> X -> X -> Text
spoilsBlurb Text
currencyName X
total X
dungeonTotal
, Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbSha
, Text -> Part
MU.Text Text
tIn
, Text -> Part
MU.Text Text
t ]
MStore cstore :: CStore
cstore ->
let n :: X
n = CStore -> X
countItems CStore
cstore
nItems :: Part
nItems = X -> Part -> Part
MU.CarAWs X
n "item"
in [Part] -> Text
makePhrase
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "see"
, Part
nItems, Text -> Part
MU.Text Text
tIn
, Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
MOrgans ->
[Part] -> Text
makePhrase
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "feel"
, Text -> Part
MU.Text Text
tIn
, Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
MOwned ->
[Part] -> Text
makePhrase
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "recall"
, Text -> Part
MU.Text Text
tIn
, Text -> Part
MU.Text Text
t ]
MSkills ->
[Part] -> Text
makePhrase
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "estimate"
, Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
MLore{} ->
[Part] -> Text
makePhrase
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "recall"
, Text -> Part
MU.Text Text
t ]
MPlaces ->
[Part] -> Text
makePhrase
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "recall"
, Text -> Part
MU.Text Text
t ]
(Either
Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
ggi <- (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> m (Either
Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
(Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> m (Either
Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
getStoreItem Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt ItemDialogMode
c
m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Skills
actorMaxSk <- (State -> Skills) -> m Skills
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 :: X
meleeSkill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkHurtMelee Skills
actorMaxSk
ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
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 (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
ggi of
(Right (iid :: ItemId
iid, itemBag :: EnumMap ItemId (X, ItemTimer)
itemBag, lSlots :: SingleItemSlots
lSlots), (c2 :: ItemDialogMode
c2, _)) ->
case ItemDialogMode
c2 of
MStore fromCStore :: CStore
fromCStore -> 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
$ \sess :: SessionUI
sess ->
SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
fromCStore, Bool
False)}
Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode))
-> Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ItemDialogMode -> Either FailError ItemDialogMode
forall a b. b -> Either a b
Right ItemDialogMode
c2
MOrgans -> do
let blurb :: ItemFull -> p
blurb itemFull :: ItemFull
itemFull =
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 "condition"
else "organ"
promptFun :: ItemId -> ItemFull -> X -> Text
promptFun _ itemFull :: ItemFull
itemFull _ =
[Part] -> Text
makeSentence [ ActorUI -> Part
partActor ActorUI
bUI, "can't remove"
, Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ ItemFull -> Part
forall p. IsString p => ItemFull -> p
blurb ItemFull
itemFull ]
ix0 :: X
ix0 = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error (String -> X) -> String -> X
forall a b. (a -> b) -> a -> b
$ ItemId -> String
forall a. Show a => a -> String
show ItemId
iid)
(Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ (ItemId -> Bool) -> [ItemId] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
findIndex (ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== ItemId
iid) ([ItemId] -> Maybe X) -> [ItemId] -> Maybe X
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
lSlots
Bool
go <- EnumMap ItemId (X, ItemTimer)
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
MonadClientUI m =>
EnumMap ItemId (X, ItemTimer)
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> m Bool
displayItemLore EnumMap ItemId (X, ItemTimer)
itemBag X
meleeSkill ItemId -> ItemFull -> X -> Text
promptFun X
ix0 SingleItemSlots
lSlots
if Bool
go then ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode ItemDialogMode
c2 else Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
MOwned -> do
[(ActorId, (Actor, CStore))]
found <- (State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))]
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 (newAid :: ActorId
newAid, bestStore :: 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 (_, store :: CStore
store) -> (ActorId
leader, CStore
store)
Nothing -> case [(ActorId, (Actor, CStore))]
found of
(aid :: ActorId
aid, (_, store :: CStore
store)) : _ -> (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 -> ItemId -> String
forall v. Show v => String -> v -> String
`showFailure` ItemId
iid
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
bestStore, Bool
False)}
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
Actor
b2 <- (State -> Actor) -> m Actor
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
Faction
fact <- (State -> Faction) -> m Faction
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 (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
if | ActorId
newAid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
leader -> Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode))
-> Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ItemDialogMode -> Either FailError ItemDialogMode
forall a b. b -> Either a b
Right ItemDialogMode
c2
| Actor -> LevelId
blid Actor
b2 LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
arena Bool -> Bool -> Bool
&& Bool
autoDun ->
ReqFailure -> m (Either FailError ItemDialogMode)
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 ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode))
-> Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ItemDialogMode -> Either FailError ItemDialogMode
forall a b. b -> Either a b
Right ItemDialogMode
c2
MSkills -> String -> m (Either FailError ItemDialogMode)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ItemDialogMode))
-> String -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ "" String
-> (Either
Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` (Either
Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
ggi
MLore slore :: SLore
slore -> do
let ix0 :: X
ix0 = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error (String -> X) -> String -> X
forall a b. (a -> b) -> a -> b
$ ItemId -> String
forall a. Show a => a -> String
show ItemId
iid)
(Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ (ItemId -> Bool) -> [ItemId] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
findIndex (ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== ItemId
iid) ([ItemId] -> Maybe X) -> [ItemId] -> Maybe X
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
lSlots
promptFun :: ItemId -> ItemFull -> X -> Text
promptFun _ _ _ =
[Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg (ActorUI -> Part
partActor ActorUI
bUI) "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) ]
Bool
go <- EnumMap ItemId (X, ItemTimer)
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
MonadClientUI m =>
EnumMap ItemId (X, ItemTimer)
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> m Bool
displayItemLore EnumMap ItemId (X, ItemTimer)
itemBag X
meleeSkill ItemId -> ItemFull -> X -> Text
promptFun X
ix0 SingleItemSlots
lSlots
if Bool
go then ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode ItemDialogMode
c2 else Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
MPlaces -> String -> m (Either FailError ItemDialogMode)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ItemDialogMode))
-> String -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ "" String
-> (Either
Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` (Either
Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
ggi
(Left err :: Text
err, (MSkills, ekm :: Either KM SlotChar
ekm)) -> case Either KM SlotChar
ekm of
Right slot0 :: SlotChar
slot0 -> Bool
-> m (Either FailError ItemDialogMode)
-> m (Either FailError ItemDialogMode)
forall a. HasCallStack => Bool -> a -> a
assert (Text
err Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "skills") (m (Either FailError ItemDialogMode)
-> m (Either FailError ItemDialogMode))
-> m (Either FailError ItemDialogMode)
-> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ do
let slotListBound :: X
slotListBound = [Skill] -> X
forall a. [a] -> X
length [Skill]
skillSlots X -> X -> X
forall a. Num a => a -> a -> a
- 1
displayOneSlot :: X -> m (Either FailError ItemDialogMode)
displayOneSlot slotIndex :: X
slotIndex = do
Actor
b <- (State -> Actor) -> m Actor
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 slot :: SlotChar
slot = [SlotChar]
allSlots [SlotChar] -> X -> SlotChar
forall a. [a] -> X -> a
!! X
slotIndex
skill :: Skill
skill = [Skill]
skillSlots [Skill] -> X -> Skill
forall a. [a] -> X -> a
!! X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error (String -> X) -> String -> X
forall a b. (a -> b) -> a -> b
$ SlotChar -> String
forall a. Show a => a -> String
show SlotChar
slot)
(SlotChar -> [SlotChar] -> Maybe X
forall a. Eq a => a -> [a] -> Maybe X
elemIndex SlotChar
slot [SlotChar]
allSlots)
valueText :: Text
valueText =
Skill -> Actor -> X -> Text
skillToDecorator Skill
skill Actor
b (X -> Text) -> X -> Text
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> X
Ability.getSk Skill
skill Skills
actorMaxSk
prompt2 :: Text
prompt2 = [Part] -> Text
makeSentence
[ Part -> Part -> Part
MU.WownW (ActorUI -> Part
partActor ActorUI
bUI) (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Skill -> Text
skillName Skill
skill)
, "is", Text -> Part
MU.Text Text
valueText ]
ov0 :: [AttrLine]
ov0 = X -> AttrLine -> [AttrLine]
indentSplitAttrLine X
rwidth (AttrLine -> [AttrLine]) -> AttrLine -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Text -> AttrLine
textToAL
(Text -> AttrLine) -> Text -> AttrLine
forall a b. (a -> b) -> a -> b
$ Skill -> Text
skillDesc Skill
skill
keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | X
slotIndex X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= 0]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | X
slotIndex X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= X
slotListBound]
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
prompt2
Slideshow
slides <- X -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
X -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2) [KM]
keys ([AttrLine]
ov0, [])
KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
case KM -> Key
K.key KM
km of
K.Space -> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode ItemDialogMode
MSkills
K.Up -> X -> m (Either FailError ItemDialogMode)
displayOneSlot (X -> m (Either FailError ItemDialogMode))
-> X -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ X
slotIndex X -> X -> X
forall a. Num a => a -> a -> a
- 1
K.Down -> X -> m (Either FailError ItemDialogMode)
displayOneSlot (X -> m (Either FailError ItemDialogMode))
-> X -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ X
slotIndex X -> X -> X
forall a. Num a => a -> a -> a
+ 1
K.Esc -> Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
_ -> String -> m (Either FailError ItemDialogMode)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ItemDialogMode))
-> String -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
slotIndex0 :: X
slotIndex0 = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error "displayOneSlot: illegal slot")
(Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ SlotChar -> [SlotChar] -> Maybe X
forall a. Eq a => a -> [a] -> Maybe X
elemIndex SlotChar
slot0 [SlotChar]
allSlots
X -> m (Either FailError ItemDialogMode)
displayOneSlot X
slotIndex0
Left _ -> Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
(Left err :: Text
err, (MPlaces, ekm :: Either KM SlotChar
ekm)) -> case Either KM SlotChar
ekm of
Right slot0 :: SlotChar
slot0 -> Bool
-> m (Either FailError ItemDialogMode)
-> m (Either FailError ItemDialogMode)
forall a. HasCallStack => Bool -> a -> a
assert (Text
err Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "places") (m (Either FailError ItemDialogMode)
-> m (Either FailError ItemDialogMode))
-> m (Either FailError ItemDialogMode)
-> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ do
COps{ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
[(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
places <- (State -> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))])
-> (State -> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId PlaceKind) (EnumSet LevelId, X, X, X)
-> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap (ContentId PlaceKind) (EnumSet LevelId, X, X, X)
-> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))])
-> (State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, X, X, X))
-> State
-> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentData PlaceKind
-> ClientOptions
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, X, X, X)
placesFromState ContentData PlaceKind
coplace ClientOptions
soptions
let slotListBound :: X
slotListBound = [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))] -> X
forall a. [a] -> X
length [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
places X -> X -> X
forall a. Num a => a -> a -> a
- 1
displayOneSlot :: X -> m (Either FailError ItemDialogMode)
displayOneSlot slotIndex :: X
slotIndex = do
let slot :: SlotChar
slot = [SlotChar]
allSlots [SlotChar] -> X -> SlotChar
forall a. [a] -> X -> a
!! X
slotIndex
(pk :: ContentId PlaceKind
pk, figures :: (EnumSet LevelId, X, X, X)
figures@(es :: EnumSet LevelId
es, _, _, _)) =
[(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
places [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
-> X -> (ContentId PlaceKind, (EnumSet LevelId, X, X, X))
forall a. [a] -> X -> a
!! X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error (String -> X) -> String -> X
forall a b. (a -> b) -> a -> b
$ SlotChar -> String
forall a. Show a => a -> String
show SlotChar
slot)
(SlotChar -> [SlotChar] -> Maybe X
forall a. Eq a => a -> [a] -> Maybe X
elemIndex SlotChar
slot [SlotChar]
allSlots)
pkind :: PlaceKind
pkind = ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk
partsPhrase :: Text
partsPhrase = [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ (EnumSet LevelId, X, X, X) -> [Part]
placeParts (EnumSet LevelId, X, X, X)
figures
prompt2 :: Text
prompt2 = [Part] -> Text
makeSentence
[ Part -> Part -> Part
MU.SubjectVerbSg (ActorUI -> Part
partActor ActorUI
bUI) "remember"
, Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ PlaceKind -> Text
PK.pname PlaceKind
pkind ]
freqsText :: Text
freqsText = "Frequencies:" Text -> Text -> Text
<+> Text -> [Text] -> Text
T.intercalate " "
(((GroupName PlaceKind, X) -> Text)
-> [(GroupName PlaceKind, X)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(grp :: GroupName PlaceKind
grp, n :: X
n) -> "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GroupName PlaceKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName PlaceKind
grp
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> X -> Text
forall a. Show a => a -> Text
tshow X
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")")
([(GroupName PlaceKind, X)] -> [Text])
-> [(GroupName PlaceKind, X)] -> [Text]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, X)]
PK.pfreq PlaceKind
pkind)
onLevels :: [Text]
onLevels | EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es = []
| Bool
otherwise =
[[Part] -> Text
makeSentence
[ "Appears on"
, X -> Part -> Part
MU.CarWs (EnumSet LevelId -> X
forall k. EnumSet k -> X
ES.size EnumSet LevelId
es) "level" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> ":"
, [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ (X -> Part) -> [X] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map X -> Part
MU.Car ([X] -> [Part]) -> [X] -> [Part]
forall a b. (a -> b) -> a -> b
$ [X] -> [X]
forall a. Ord a => [a] -> [a]
sort
([X] -> [X]) -> [X] -> [X]
forall a b. (a -> b) -> a -> b
$ (LevelId -> X) -> [LevelId] -> [X]
forall a b. (a -> b) -> [a] -> [b]
map (X -> X
forall a. Num a => a -> a
abs (X -> X) -> (LevelId -> X) -> LevelId -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LevelId -> X
forall a. Enum a => a -> X
fromEnum) ([LevelId] -> [X]) -> [LevelId] -> [X]
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
es ]]
ov0 :: [AttrLine]
ov0 = X -> AttrLine -> [AttrLine]
indentSplitAttrLine X
rwidth (AttrLine -> [AttrLine]) -> AttrLine -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Text -> AttrLine
textToAL (Text -> AttrLine) -> Text -> AttrLine
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
(if ClientOptions -> Bool
sexposePlaces ClientOptions
soptions
then [ "", Text
partsPhrase
, "", Text
freqsText
, "" ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ PlaceKind -> [Text]
PK.ptopLeft PlaceKind
pkind
else [])
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [""] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
onLevels
keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | X
slotIndex X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= 0]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | X
slotIndex X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= X
slotListBound]
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
prompt2
Slideshow
slides <- X -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
X -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2) [KM]
keys ([AttrLine]
ov0, [])
KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
case KM -> Key
K.key KM
km of
K.Space -> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode ItemDialogMode
MPlaces
K.Up -> X -> m (Either FailError ItemDialogMode)
displayOneSlot (X -> m (Either FailError ItemDialogMode))
-> X -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ X
slotIndex X -> X -> X
forall a. Num a => a -> a -> a
- 1
K.Down -> X -> m (Either FailError ItemDialogMode)
displayOneSlot (X -> m (Either FailError ItemDialogMode))
-> X -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ X
slotIndex X -> X -> X
forall a. Num a => a -> a -> a
+ 1
K.Esc -> Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
_ -> String -> m (Either FailError ItemDialogMode)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ItemDialogMode))
-> String -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
slotIndex0 :: X
slotIndex0 = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error "displayOneSlot: illegal slot")
(Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ SlotChar -> [SlotChar] -> Maybe X
forall a. Eq a => a -> [a] -> Maybe X
elemIndex SlotChar
slot0 [SlotChar]
allSlots
X -> m (Either FailError ItemDialogMode)
displayOneSlot X
slotIndex0
Left _ -> Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
(Left err :: Text
err, _) -> Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err
chooseItemProjectHuman :: forall m. (MonadClient m, MonadClientUI m)
=> [TriggerItem] -> m MError
chooseItemProjectHuman :: [TriggerItem] -> m MError
chooseItemProjectHuman ts :: [TriggerItem]
ts = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
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
Skills
actorMaxSk <- (State -> Skills) -> m Skills
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 calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
cLegalRaw :: [CStore]
cLegalRaw = [CStore
CGround, CStore
CInv, CStore
CSha, CStore
CEqp]
cLegal :: [CStore]
cLegal | Bool
calmE = [CStore]
cLegalRaw
| Bool
otherwise = CStore -> [CStore] -> [CStore]
forall a. Eq a => a -> [a] -> [a]
delete CStore
CSha [CStore]
cLegalRaw
(verb1 :: Part
verb1, object1 :: Part
object1) = case [TriggerItem]
ts of
[] -> ("aim", "item")
tr :: TriggerItem
tr : _ -> (TriggerItem -> Part
tiverb TriggerItem
tr, TriggerItem -> Part
tiobject TriggerItem
tr)
triggerSyms :: String
triggerSyms = [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
Either Text (ItemFull -> Either ReqFailure (Point, Bool))
mpsuitReq <- m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq
case Either Text (ItemFull -> Either ReqFailure (Point, Bool))
mpsuitReq of
Left err :: Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err
Right psuitReqFun :: ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun -> do
Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
case Maybe (ItemId, CStore, Bool)
itemSel of
Just (_, _, True) -> MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, False) -> do
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
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 (X, ItemTimer)
bag <- (State -> EnumMap ItemId (X, ItemTimer))
-> m (EnumMap ItemId (X, ItemTimer))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId (X, ItemTimer))
-> m (EnumMap ItemId (X, ItemTimer)))
-> (State -> EnumMap ItemId (X, ItemTimer))
-> m (EnumMap ItemId (X, ItemTimer))
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId (X, ItemTimer)
getBodyStoreBag Actor
b CStore
fromCStore
case ItemId
iid ItemId -> EnumMap ItemId (X, ItemTimer) -> Maybe (X, ItemTimer)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ItemId (X, ItemTimer)
bag of
Just _ | (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) ->
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
_ -> 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
$ \sess :: SessionUI
sess -> SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing}
[TriggerItem] -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[TriggerItem] -> m MError
chooseItemProjectHuman [TriggerItem]
ts
Nothing -> do
let psuit :: m Suitability
psuit =
Suitability -> m Suitability
forall (m :: * -> *) a. Monad m => a -> m a
return (Suitability -> m Suitability) -> Suitability -> m Suitability
forall a b. (a -> b) -> a -> b
$ (ItemFull -> (X, ItemTimer) -> Bool) -> Suitability
SuitsSomething ((ItemFull -> (X, ItemTimer) -> Bool) -> Suitability)
-> (ItemFull -> (X, ItemTimer) -> Bool) -> Suitability
forall a b. (a -> b) -> a -> b
$ \itemFull :: ItemFull
itemFull _kit :: (X, ItemTimer)
_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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
triggerSyms)
prompt :: Text
prompt = [Part] -> Text
makePhrase ["What", Part
object1, "to", Part
verb1]
promptGeneric :: Text
promptGeneric = "What to fling"
Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi <- m Suitability
-> Text
-> Text
-> [CStore]
-> [CStore]
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> Text
-> Text
-> [CStore]
-> [CStore]
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
getGroupItem m Suitability
psuit Text
prompt Text
promptGeneric [CStore]
cLegalRaw [CStore]
cLegal
case Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi of
Right ((iid :: ItemId
iid, _itemFull :: ItemFull
_itemFull), (MStore fromCStore :: CStore
fromCStore, _)) -> 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
$ \sess :: SessionUI
sess ->
SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
fromCStore, Bool
False)}
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
Left err :: Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err
_ -> String -> m MError
forall a. HasCallStack => String -> a
error (String -> m MError) -> String -> m MError
forall a b. (a -> b) -> a -> b
$ "" String
-> Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi
permittedProjectClient :: MonadClientUI m
=> m (ItemFull -> Either ReqFailure Bool)
permittedProjectClient :: m (ItemFull -> Either ReqFailure Bool)
permittedProjectClient = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
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
Skills
actorMaxSk <- (State -> Skills) -> m Skills
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
Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
let skill :: X
skill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkProject Skills
actorSk
calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
(ItemFull -> Either ReqFailure Bool)
-> m (ItemFull -> Either ReqFailure Bool)
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 -> X -> Bool -> ItemFull -> Either ReqFailure Bool
permittedProject Bool
False X
skill Bool
calmE
projectCheck :: MonadClientUI m => Point -> m (Maybe ReqFailure)
projectCheck :: Point -> m (Maybe ReqFailure)
projectCheck tpos :: Point
tpos = do
COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: RuleContent -> X
rXmax :: X
rXmax, X
rYmax :: RuleContent -> X
rYmax :: X
rYmax}, TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
X
eps <- (StateClient -> X) -> m X
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> X
seps
Actor
sb <- (State -> Actor) -> m Actor
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 X -> X -> X -> Point -> Point -> Maybe [Point]
bla X
rXmax X
rYmax X
eps Point
spos Point
tpos of
Nothing -> Maybe ReqFailure -> m (Maybe ReqFailure)
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
$ "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 (pos :: Point
pos : _) -> 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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe ReqFailure
forall a. Maybe a
Nothing
xhairLegalEps :: MonadClientUI m => m (Either Text Int)
xhairLegalEps :: m (Either Text X)
xhairLegalEps = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
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 X)
findNewEps onlyFirst :: Bool
onlyFirst pos :: Point
pos = do
X
oldEps <- (StateClient -> X) -> m X
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> X
seps
Maybe X
mnewEps <- Bool -> Actor -> Point -> X -> m (Maybe X)
forall (m :: * -> *).
MonadStateRead m =>
Bool -> Actor -> Point -> X -> m (Maybe X)
makeLine Bool
onlyFirst Actor
b Point
pos X
oldEps
Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$! case Maybe X
mnewEps of
Just newEps :: X
newEps -> X -> Either Text X
forall a b. b -> Either a b
Right X
newEps
Nothing -> Text -> Either Text X
forall a b. a -> Either a b
Left (Text -> Either Text X) -> Text -> Either Text X
forall a b. (a -> b) -> a -> b
$ if Bool
onlyFirst
then "aiming blocked at the first step"
else "aiming line blocked somewhere"
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
case Maybe Target
xhair of
Nothing -> Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "no aim designated"
Just (TEnemy a :: ActorId
a) -> do
Actor
body <- (State -> Actor) -> m Actor
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 X)
findNewEps Bool
False Point
pos
else Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "can't fling at an enemy on remote level"
Just (TNonEnemy a :: ActorId
a) -> do
Actor
body <- (State -> Actor) -> m Actor
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 X)
findNewEps Bool
False Point
pos
else Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "can't fling at a non-enemy on remote level"
Just (TPoint TEnemyPos{} _ _) ->
Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "selected opponent not visible"
Just (TPoint _ lid :: LevelId
lid pos :: Point
pos) ->
if LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV
then Bool -> Point -> m (Either Text X)
findNewEps Bool
True Point
pos
else Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "can't fling at a target on remote level"
Just (TVector v :: Vector
v) -> do
COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: X
rXmax :: RuleContent -> X
rXmax, X
rYmax :: X
rYmax :: RuleContent -> X
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
let shifted :: Point
shifted = X -> X -> Point -> Vector -> Point
shiftBounded X
rXmax X
rYmax (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
/= X -> X -> Vector
Vector 0 0
then Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "selected translation is void"
else Bool -> Point -> m (Either Text X)
findNewEps Bool
True Point
shifted
posFromXhair :: (MonadClient m, MonadClientUI m) => m (Either Text Point)
posFromXhair :: m (Either Text Point)
posFromXhair = do
Either Text X
canAim <- m (Either Text X)
forall (m :: * -> *). MonadClientUI m => m (Either Text X)
xhairLegalEps
case Either Text X
canAim of
Right newEps :: X
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
$ \cli :: StateClient
cli -> StateClient
cli {seps :: X
seps = X
newEps}
Maybe Point
mpos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
case Maybe Point
mpos of
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 -> Maybe Point -> String
forall v. Show v => String -> v -> String
`showFailure` Maybe Point
mpos
Just pos :: Point
pos -> do
Maybe ReqFailure
munit <- Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadClientUI m =>
Point -> m (Maybe ReqFailure)
projectCheck Point
pos
case Maybe ReqFailure
munit of
Nothing -> Either Text Point -> m (Either Text Point)
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 reqFail :: ReqFailure
reqFail -> Either Text Point -> m (Either Text Point)
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 cause :: Text
cause -> Either Text Point -> m (Either Text Point)
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)
=> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq :: m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
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 (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 "can't fling on remote level"
else do
Either Text Point
mpos <- m (Either Text Point)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Either Text Point)
posFromXhair
ItemFull -> Either ReqFailure Bool
p <- m (ItemFull -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
m (ItemFull -> Either ReqFailure Bool)
permittedProjectClient
case Either Text Point
mpos of
Left err :: Text
err -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
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 pos :: Point
pos -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
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
itemFull ->
case ItemFull -> Either ReqFailure Bool
p ItemFull
itemFull of
Left err :: ReqFailure
err -> ReqFailure -> Either ReqFailure (Point, Bool)
forall a b. a -> Either a b
Left ReqFailure
err
Right False -> (Point, Bool) -> Either ReqFailure (Point, Bool)
forall a b. b -> Either a b
Right (Point
pos, Bool
False)
Right 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, AspectRecord -> ItemKind -> X
IA.totalRange AspectRecord
arItem (ItemFull -> ItemKind
itemKind ItemFull
itemFull)
X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= Point -> Point -> X
chessDist (Actor -> Point
bpos Actor
b) Point
pos)
triggerSymbols :: [TriggerItem] -> [Char]
triggerSymbols :: [TriggerItem] -> String
triggerSymbols [] = []
triggerSymbols (TriggerItem{String
tisymbols :: TriggerItem -> String
tisymbols :: String
tisymbols} : ts :: [TriggerItem]
ts) = String
tisymbols String -> String -> String
forall a. [a] -> [a] -> [a]
++ [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
chooseItemApplyHuman :: forall m. MonadClientUI m => [TriggerItem] -> m MError
chooseItemApplyHuman :: [TriggerItem] -> m MError
chooseItemApplyHuman ts :: [TriggerItem]
ts = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
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
Skills
actorMaxSk <- (State -> Skills) -> m Skills
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 calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
cLegalRaw :: [CStore]
cLegalRaw = [CStore
CGround, CStore
CInv, CStore
CSha, CStore
CEqp]
cLegal :: [CStore]
cLegal | Bool
calmE = [CStore]
cLegalRaw
| Bool
otherwise = CStore -> [CStore] -> [CStore]
forall a. Eq a => a -> [a] -> [a]
delete CStore
CSha [CStore]
cLegalRaw
(verb1 :: Part
verb1, object1 :: Part
object1) = case [TriggerItem]
ts of
[] -> ("apply", "item")
tr :: TriggerItem
tr : _ -> (TriggerItem -> Part
tiverb TriggerItem
tr, TriggerItem -> Part
tiobject TriggerItem
tr)
triggerSyms :: String
triggerSyms = [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
prompt :: Text
prompt = [Part] -> Text
makePhrase ["What", Part
object1, "to", Part
verb1]
promptGeneric :: Text
promptGeneric = "What to apply"
Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
case Maybe (ItemId, CStore, Bool)
itemSel of
Just (_, _, True) -> MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, False) -> do
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
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 (X, ItemTimer)
bag <- (State -> EnumMap ItemId (X, ItemTimer))
-> m (EnumMap ItemId (X, ItemTimer))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId (X, ItemTimer))
-> m (EnumMap ItemId (X, ItemTimer)))
-> (State -> EnumMap ItemId (X, ItemTimer))
-> m (EnumMap ItemId (X, ItemTimer))
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId (X, ItemTimer)
getBodyStoreBag Actor
b CStore
fromCStore
ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool
mp <- m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
permittedApplyClient
case ItemId
iid ItemId -> EnumMap ItemId (X, ItemTimer) -> Maybe (X, ItemTimer)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ItemId (X, ItemTimer)
bag of
Just kit :: (X, ItemTimer)
kit | (ReqFailure -> Bool)
-> (Bool -> Bool) -> Either ReqFailure 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) Bool -> Bool
forall a. a -> a
id (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool
mp ItemFull
itemFull (X, ItemTimer)
kit) ->
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
_ -> 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
$ \sess :: SessionUI
sess -> SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing}
[TriggerItem] -> m MError
forall (m :: * -> *). MonadClientUI m => [TriggerItem] -> m MError
chooseItemApplyHuman [TriggerItem]
ts
Nothing -> do
let psuit :: m Suitability
psuit :: m Suitability
psuit = do
ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool
mp <- m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
permittedApplyClient
Suitability -> m Suitability
forall (m :: * -> *) a. Monad m => a -> m a
return (Suitability -> m Suitability) -> Suitability -> m Suitability
forall a b. (a -> b) -> a -> b
$ (ItemFull -> (X, ItemTimer) -> Bool) -> Suitability
SuitsSomething ((ItemFull -> (X, ItemTimer) -> Bool) -> Suitability)
-> (ItemFull -> (X, ItemTimer) -> Bool) -> Suitability
forall a b. (a -> b) -> a -> b
$ \itemFull :: ItemFull
itemFull kit :: (X, ItemTimer)
kit ->
(ReqFailure -> Bool)
-> (Bool -> Bool) -> Either ReqFailure 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) Bool -> Bool
forall a. a -> a
id (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool
mp ItemFull
itemFull (X, ItemTimer)
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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
triggerSyms)
Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi <- m Suitability
-> Text
-> Text
-> [CStore]
-> [CStore]
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> Text
-> Text
-> [CStore]
-> [CStore]
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
getGroupItem m Suitability
psuit Text
prompt Text
promptGeneric [CStore]
cLegalRaw [CStore]
cLegal
case Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi of
Right ((iid :: ItemId
iid, _itemFull :: ItemFull
_itemFull), (MStore fromCStore :: CStore
fromCStore, _)) -> 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
$ \sess :: SessionUI
sess ->
SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
fromCStore, Bool
False)}
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
Left err :: Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err
_ -> String -> m MError
forall a. HasCallStack => String -> a
error (String -> m MError) -> String -> m MError
forall a b. (a -> b) -> a -> b
$ "" String
-> Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi
permittedApplyClient :: MonadClientUI m
=> m (ItemFull -> ItemQuant -> Either ReqFailure Bool)
permittedApplyClient :: m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
permittedApplyClient = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
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
Skills
actorMaxSk <- (State -> Skills) -> m Skills
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
Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
let skill :: X
skill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkApply Skills
actorSk
calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
Time
localTime <- (State -> Time) -> m Time
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)
(ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
-> m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
-> m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool))
-> (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
-> m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
forall a b. (a -> b) -> a -> b
$ Time
-> X
-> Bool
-> ItemFull
-> (X, ItemTimer)
-> Either ReqFailure Bool
permittedApply Time
localTime X
skill Bool
calmE
pickLeaderHuman :: MonadClientUI m => Int -> m MError
pickLeaderHuman :: X -> m MError
pickLeaderHuman k :: X
k = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
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 (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 (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 -> X -> State -> Maybe (ActorId, Actor)
tryFindHeroK ActorDictUI
sactorUI FactionId
side X
k
[(ActorId, Actor)]
allOurs <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
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 (\(aid :: ActorId
aid, b :: 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 X -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. X -> [a] -> [a]
drop X
k [(ActorId, Actor, ActorUI)]
hs of
[] -> Maybe (ActorId, Actor)
forall a. Maybe a
Nothing
(aid :: ActorId
aid, b :: Actor
b, _) : _ -> (ActorId, Actor) -> Maybe (ActorId, Actor)
forall a. a -> Maybe a
Just (ActorId
aid, Actor
b)
mchoice :: Maybe (ActorId, Actor)
mchoice = if Player -> Bool
fhasGender (Faction -> Player
gplayer Faction
fact) then Maybe (ActorId, Actor)
mhero else Maybe (ActorId, Actor)
mactor
(autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
case Maybe (ActorId, Actor)
mchoice of
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "no such member of the party"
Just (aid :: ActorId
aid, b :: Actor
b)
| Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
arena Bool -> Bool -> Bool
&& Bool
autoDun ->
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 (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
pickLeaderWithPointerHuman :: MonadClientUI m => m MError
pickLeaderWithPointerHuman :: m MError
pickLeaderWithPointerHuman = m MError
forall (m :: * -> *). MonadClientUI m => m MError
pickLeaderWithPointer
memberCycleHuman :: MonadClientUI m => m MError
memberCycleHuman :: m MError
memberCycleHuman = Bool -> m MError
forall (m :: * -> *). MonadClientUI m => Bool -> m MError
memberCycle Bool
True
memberBackHuman :: MonadClientUI m => m MError
memberBackHuman :: m MError
memberBackHuman = Bool -> m MError
forall (m :: * -> *). MonadClientUI m => Bool -> m MError
memberBack Bool
True
selectActorHuman :: MonadClientUI m => m ()
selectActorHuman :: m ()
selectActorHuman = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
selectAid ActorId
leader
selectAid :: MonadClientUI m => ActorId -> m ()
selectAid :: ActorId -> m ()
selectAid leader :: ActorId
leader = do
ActorUI
bodyUI <- (SessionUI -> ActorUI) -> m ActorUI
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 (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
$ \sess :: SessionUI
sess -> SessionUI
sess {sselected :: EnumSet ActorId
sselected = EnumSet ActorId -> EnumSet ActorId
upd (EnumSet ActorId -> EnumSet ActorId)
-> EnumSet ActorId -> EnumSet ActorId
forall a b. (a -> b) -> a -> b
$ SessionUI -> EnumSet ActorId
sselected SessionUI
sess}
let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
bodyUI
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, if Bool
wasMemeber
then "deselected"
else "selected"]
selectNoneHuman :: MonadClientUI m => m ()
selectNoneHuman :: m ()
selectNoneHuman = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
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 (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 (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
$ \sess :: SessionUI
sess -> SessionUI
sess {sselected :: EnumSet ActorId
sselected = EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
upd (SessionUI -> EnumSet ActorId
sselected SessionUI
sess) EnumSet ActorId
ours}
let subject :: Part
subject = "all party members on the level"
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, if Bool
wasNone
then "selected"
else "deselected"]
selectWithPointerHuman :: MonadClientUI m => m MError
selectWithPointerHuman :: m MError
selectWithPointerHuman = do
COps{corule :: COps -> RuleContent
corule=RuleContent{X
rYmax :: X
rYmax :: RuleContent -> X
rYmax}} <- (State -> COps) -> m COps
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 (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
[(ActorId, Actor)]
ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
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 (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 (\(aid :: ActorId
aid, b :: 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
Point{..} <- (SessionUI -> Point) -> m Point
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Point
spointer
if | X
py X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
rYmax X -> X -> X
forall a. Num a => a -> a -> a
+ 2 Bool -> Bool -> Bool
&& X
px X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> m ()
forall (m :: * -> *). MonadClientUI m => m ()
selectNoneHuman m () -> m MError -> m MError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
| X
py X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
rYmax X -> X -> X
forall a. Num a => a -> a -> a
+ 2 ->
case X -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. X -> [a] -> [a]
drop (X
px X -> X -> X
forall a. Num a => a -> a -> a
- 1) [(ActorId, Actor, ActorUI)]
viewed of
[] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "not pointing at an actor"
(aid :: ActorId
aid, _, _) : _ -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
selectAid ActorId
aid m () -> m MError -> m MError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MError -> m MError
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 (\(_, b :: Actor
b) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== X -> X -> Point
Point X
px (X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY)) [(ActorId, Actor)]
ours of
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "not pointing at an actor"
Just (aid :: ActorId
aid, _) -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
selectAid ActorId
aid m () -> m MError -> m MError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
repeatHuman :: MonadClientUI m => Int -> m ()
repeatHuman :: X -> m ()
repeatHuman n :: X
n = do
LastRecord _ seqPrevious :: [KM]
seqPrevious k :: X
k <- (SessionUI -> LastRecord) -> m LastRecord
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> LastRecord
slastRecord
let macro :: [KM]
macro = [[KM]] -> [KM]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KM]] -> [KM]) -> [[KM]] -> [KM]
forall a b. (a -> b) -> a -> b
$ X -> [KM] -> [[KM]]
forall a. X -> a -> [a]
replicate X
n ([KM] -> [[KM]]) -> [KM] -> [[KM]]
forall a b. (a -> b) -> a -> b
$ [KM] -> [KM]
forall a. [a] -> [a]
reverse [KM]
seqPrevious
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {slastPlay :: [KM]
slastPlay = [KM]
macro [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ SessionUI -> [KM]
slastPlay SessionUI
sess}
let slastRecord :: LastRecord
slastRecord = [KM] -> [KM] -> X -> LastRecord
LastRecord [] [] (if X
k X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 0 else X
maxK)
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {LastRecord
slastRecord :: LastRecord
slastRecord :: LastRecord
slastRecord}
maxK :: Int
maxK :: X
maxK = 100
recordHuman :: MonadClientUI m => m ()
recordHuman :: m ()
recordHuman = do
[KM]
lastPlayOld <- (SessionUI -> [KM]) -> m [KM]
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> [KM]
slastPlay
LastRecord _seqCurrent :: [KM]
_seqCurrent seqPrevious :: [KM]
seqPrevious k :: X
k <- (SessionUI -> LastRecord) -> m LastRecord
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> LastRecord
slastRecord
case X
k of
0 -> do
let slastRecord :: LastRecord
slastRecord = [KM] -> [KM] -> X -> LastRecord
LastRecord [] [] X
maxK
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {LastRecord
slastRecord :: LastRecord
slastRecord :: LastRecord
slastRecord}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([KM] -> Bool
forall a. [a] -> Bool
null [KM]
lastPlayOld) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Macro will be recorded for up to"
Text -> Text -> Text
<+> X -> Text
forall a. Show a => a -> Text
tshow X
maxK
Text -> Text -> Text
<+> "actions. Stop recording with the same key."
_ -> do
let slastRecord :: LastRecord
slastRecord = [KM] -> [KM] -> X -> LastRecord
LastRecord [KM]
seqPrevious [] 0
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {LastRecord
slastRecord :: LastRecord
slastRecord :: LastRecord
slastRecord}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([KM] -> Bool
forall a. [a] -> Bool
null [KM]
lastPlayOld) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Macro recording stopped after"
Text -> Text -> Text
<+> X -> Text
forall a. Show a => a -> Text
tshow (X
maxK X -> X -> X
forall a. Num a => a -> a -> a
- X
k X -> X -> X
forall a. Num a => a -> a -> a
- 1) Text -> Text -> Text
<+> "actions."
allHistoryHuman :: MonadClientUI m => m ()
allHistoryHuman :: m ()
allHistoryHuman = Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
eitherHistory Bool
True
eitherHistory :: forall m. MonadClientUI m => Bool -> m ()
eitherHistory :: Bool -> m ()
eitherHistory showAll :: Bool
showAll = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: X
rwidth :: ScreenContent -> X
rwidth, X
rheight :: X
rheight :: ScreenContent -> X
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
History
history <- (SessionUI -> History) -> m History
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 (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 (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
let rh :: [AttrLine]
rh = History -> [AttrLine]
renderHistory History
history
turnsGlobal :: X
turnsGlobal = Time
global Time -> Time -> X
`timeFitUp` Time
timeTurn
turnsLocal :: X
turnsLocal = Time
localTime Time -> Time -> X
`timeFitUp` Time
timeTurn
msg :: Text
msg = [Part] -> Text
makeSentence
[ "You survived for"
, X -> Part -> Part
MU.CarWs X
turnsGlobal "half-second turn"
, "(this level:"
, X -> Part
MU.Car X
turnsLocal Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> ")" ]
kxs :: [(Either [KM] SlotChar, (X, X, X))]
kxs = [ (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
sn, (SlotChar -> X
slotPrefix SlotChar
sn, 0, X
rwidth))
| SlotChar
sn <- X -> [SlotChar] -> [SlotChar]
forall a. X -> [a] -> [a]
take ([AttrLine] -> X
forall a. [a] -> X
length [AttrLine]
rh) [SlotChar]
intSlots ]
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
msg
Slideshow
okxs <- X -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
X -> [KM] -> OKX -> m Slideshow
overlayToSlideshow X
rheight [KM
K.escKM] ([AttrLine]
rh, [(Either [KM] SlotChar, (X, X, X))]
kxs)
let displayAllHistory :: m ()
displayAllHistory = do
Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
MonadClientUI m =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "history" ColorMode
ColorFull Bool
True Slideshow
okxs
[KM
K.spaceKM, KM
K.escKM]
case Either KM SlotChar
ekm of
Left km :: KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.escKM ->
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 "Try to survive a few seconds more, if you can."
Left km :: KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.spaceKM ->
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 "Steady on."
Right SlotChar{..} | Char
slotChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'a' ->
X -> m ()
displayOneReport X
slotPrefix
_ -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "" String -> Either KM SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` Either KM SlotChar
ekm
histBound :: X
histBound = History -> X
lengthHistory History
history X -> X -> X
forall a. Num a => a -> a -> a
- 1
displayOneReport :: Int -> m ()
displayOneReport :: X -> m ()
displayOneReport histSlot :: X
histSlot = do
let timeReport :: AttrLine
timeReport = case X -> [AttrLine] -> [AttrLine]
forall a. X -> [a] -> [a]
drop X
histSlot [AttrLine]
rh of
[] -> String -> AttrLine
forall a. HasCallStack => String -> a
error (String -> AttrLine) -> String -> AttrLine
forall a b. (a -> b) -> a -> b
$ "" String -> X -> String
forall v. Show v => String -> v -> String
`showFailure` X
histSlot
tR :: AttrLine
tR : _ -> AttrLine
tR
ov0 :: [AttrLine]
ov0 = X -> AttrLine -> [AttrLine]
indentSplitAttrLine X
rwidth AttrLine
timeReport
prompt :: Text
prompt = [Part] -> Text
makeSentence
[ "the", X -> Part
MU.Ordinal (X -> Part) -> X -> Part
forall a b. (a -> b) -> a -> b
$ X
histSlot X -> X -> X
forall a. Num a => a -> a -> a
+ 1
, "record of all history follows" ]
keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM] [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | X
histSlot X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= 0]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | X
histSlot X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= X
histBound]
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
prompt
Slideshow
slides <- X -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
X -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2) [KM]
keys ([AttrLine]
ov0, [])
KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
case KM -> Key
K.key KM
km of
K.Space -> m ()
displayAllHistory
K.Up -> X -> m ()
displayOneReport (X -> m ()) -> X -> m ()
forall a b. (a -> b) -> a -> b
$ X
histSlot X -> X -> X
forall a. Num a => a -> a -> a
- 1
K.Down -> X -> m ()
displayOneReport (X -> m ()) -> X -> m ()
forall a b. (a -> b) -> a -> b
$ X
histSlot X -> X -> X
forall a. Num a => a -> a -> a
+ 1
K.Esc -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 "Try to learn from your previous mistakes."
_ -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
if Bool
showAll then m ()
displayAllHistory else X -> m ()
displayOneReport ([AttrLine] -> X
forall a. [a] -> X
length [AttrLine]
rh X -> X -> X
forall a. Num a => a -> a -> a
- 1)
lastHistoryHuman :: MonadClientUI m => m ()
lastHistoryHuman :: m ()
lastHistoryHuman = Bool -> m ()
forall (m :: * -> *). MonadClientUI m => Bool -> m ()
eitherHistory Bool
False
markVisionHuman :: MonadClientUI m => m ()
markVisionHuman :: m ()
markVisionHuman = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession SessionUI -> SessionUI
toggleMarkVision
markSmellHuman :: MonadClientUI m => m ()
markSmellHuman :: m ()
markSmellHuman = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession SessionUI -> SessionUI
toggleMarkSmell
markSuspectHuman :: MonadClient m => m ()
markSuspectHuman :: m ()
markSuspectHuman = do
m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsAll
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient StateClient -> StateClient
cycleMarkSuspect
printScreenHuman :: MonadClientUI m => m ()
printScreenHuman :: m ()
printScreenHuman = do
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd "Screenshot printed."
m ()
forall (m :: * -> *). MonadClientUI m => m ()
printScreen
cancelHuman :: MonadClientUI m => m ()
cancelHuman :: m ()
cancelHuman = do
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode) m ()
forall (m :: * -> *). MonadClientUI m => m ()
clearAimMode
acceptHuman :: (MonadClient m, MonadClientUI m) => m ()
acceptHuman :: m ()
acceptHuman = do
m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
endAiming
m ()
forall (m :: * -> *). MonadClientUI m => m ()
endAimingMsg
m ()
forall (m :: * -> *). MonadClientUI m => m ()
clearAimMode
endAiming :: (MonadClient m, MonadClientUI m) => m ()
endAiming :: m ()
endAiming = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Maybe Target
sxhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
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 => m ()
endAimingMsg :: m ()
endAimingMsg = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
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 (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
(mtargetMsg :: Maybe Text
mtargetMsg, _) <- Maybe Target -> m (Maybe Text, Maybe Text)
forall (m :: * -> *).
MonadClientUI m =>
Maybe Target -> m (Maybe Text, Maybe Text)
targetDesc Maybe Target
tgt
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ case Maybe Text
mtargetMsg of
Nothing ->
[Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject "clear target"]
Just targetMsg :: Text
targetMsg ->
[Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject "target", Text -> Part
MU.Text Text
targetMsg]
clearTargetIfItemClearHuman :: (MonadClient m, MonadClientUI m) => m ()
clearTargetIfItemClearHuman :: m ()
clearTargetIfItemClearHuman = do
Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
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
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sxhair :: Maybe Target
sxhair = Maybe Target
forall a. Maybe a
Nothing}
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
(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
doLook :: MonadClientUI m => m ()
doLook :: m ()
doLook = do
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
case Maybe AimMode
saimMode of
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just aimMode :: AimMode
aimMode -> do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
let lidV :: LevelId
lidV = AimMode -> LevelId
aimLevelId AimMode
aimMode
Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
Actor
b <- (State -> Actor) -> m Actor
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 xhairPos :: Point
xhairPos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe (Actor -> Point
bpos Actor
b) Maybe Point
mxhairPos
Text
blurb <- LevelId -> Point -> m Text
forall (m :: * -> *). MonadClientUI m => LevelId -> Point -> m Text
lookAtPosition LevelId
lidV Point
xhairPos
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
blurb
itemClearHuman :: MonadClientUI m => m ()
itemClearHuman :: 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
$ \sess :: SessionUI
sess -> SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing}
moveXhairHuman :: MonadClientUI m => Vector -> Int -> m MError
moveXhairHuman :: Vector -> X -> m MError
moveXhairHuman dir :: Vector
dir n :: X
n = do
COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: X
rXmax :: RuleContent -> X
rXmax, X
rYmax :: X
rYmax :: RuleContent -> X
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
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 -> ActorId -> String
forall v. Show v => String -> v -> String
`showFailure` ActorId
leader) AimMode -> LevelId
aimLevelId Maybe AimMode
saimMode
Point
lpos <- (State -> Point) -> m Point
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
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
let xhairPos :: Point
xhairPos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
lpos Maybe Point
mxhairPos
shiftB :: Point -> Point
shiftB pos :: Point
pos = X -> X -> Point -> Vector -> Point
shiftBounded X
rXmax X
rYmax Point
pos Vector
dir
newPos :: Point
newPos = (Point -> Point) -> Point -> [Point]
forall a. (a -> a) -> a -> [a]
iterate Point -> Point
shiftB Point
xhairPos [Point] -> X -> Point
forall a. [a] -> X -> a
!! X
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 "never mind"
else do
let sxhair :: Maybe Target
sxhair = case Maybe Target
xhair of
Just TVector{} -> 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
_ -> 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
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair}
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
aimTgtHuman :: MonadClientUI m => m MError
aimTgtHuman :: m MError
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
$ \sess :: SessionUI
sess -> SessionUI
sess {saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV}
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "aiming started"
aimFloorHuman :: MonadClientUI m => m ()
aimFloorHuman :: m ()
aimFloorHuman = do
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Point
lpos <- (State -> Point) -> m Point
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 Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
[(ActorId, Actor)]
bsAll <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
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 (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
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 xhairPos :: Point
xhairPos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
lpos Maybe Point
mxhairPos
sxhair :: Maybe Target
sxhair = case Maybe Target
xhair of
_ | 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{} | 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 (\(_, b :: Actor
b) -> Point -> Maybe Point
forall a. a -> Maybe a
Just (Actor -> Point
bpos Actor
b) Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Point
mxhairPos) [(ActorId, Actor)]
bsAll of
Just (aid :: ActorId
aid, b :: 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
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
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
$ \sess :: SessionUI
sess -> SessionUI
sess { saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV
, Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair }
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
aimEnemyHuman :: MonadClientUI m => m ()
aimEnemyHuman :: m ()
aimEnemyHuman = do
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Point
lpos <- (State -> Point) -> m Point
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 Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
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 (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 :: (ActorId, Actor) -> (X, Point, Bool)
ordPos (_, b :: Actor
b) = (Point -> Point -> X
chessDist Point
lpos (Point -> X) -> Point -> X
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 = ((ActorId, Actor) -> (X, Point, Bool))
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ActorId, Actor) -> (X, Point, Bool)
ordPos [(ActorId, Actor)]
bsAll
pickUnderXhair :: X
pickUnderXhair =
X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (-1) (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
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
(pickEnemies :: Bool
pickEnemies, i :: X
i) = case Maybe Target
xhair of
Just (TEnemy a :: ActorId
a) | Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode ->
(Bool
True, 1 X -> X -> X
forall a. Num a => a -> a -> a
+ X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (-1) (((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
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 a :: ActorId
a) ->
(Bool
True, X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (-1) (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
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 a :: ActorId
a) | Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode ->
(Bool
False, 1 X -> X -> X
forall a. Num a => a -> a -> a
+ X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (-1) (((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
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 a :: ActorId
a) ->
(Bool
False, X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (-1) (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
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)
_ -> (Bool
True, X
pickUnderXhair)
(lt :: [(ActorId, Actor)]
lt, gt :: [(ActorId, Actor)]
gt) = X -> [(ActorId, Actor)] -> ([(ActorId, Actor)], [(ActorId, Actor)])
forall a. X -> [a] -> ([a], [a])
splitAt X
i [(ActorId, Actor)]
dbs
isEnemy :: Actor -> Bool
isEnemy b :: 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
> 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
(a :: ActorId
a, _) : _ -> 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
$ \sess :: SessionUI
sess -> SessionUI
sess { saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV
, Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair }
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
aimItemHuman :: MonadClientUI m => m ()
aimItemHuman :: m ()
aimItemHuman = do
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Point
lpos <- (State -> Point) -> m Point
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 Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
[Point]
bsAll <- (State -> [Point]) -> m [Point]
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
$ EnumMap Point (EnumMap ItemId (X, ItemTimer)) -> [Point]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap Point (EnumMap ItemId (X, ItemTimer)) -> [Point])
-> (State -> EnumMap Point (EnumMap ItemId (X, ItemTimer)))
-> State
-> [Point]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Level -> EnumMap Point (EnumMap ItemId (X, ItemTimer))
lfloor (Level -> EnumMap Point (EnumMap ItemId (X, ItemTimer)))
-> (State -> Level)
-> State
-> EnumMap Point (EnumMap ItemId (X, ItemTimer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap LevelId Level -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lidV) (EnumMap LevelId Level -> Level)
-> (State -> EnumMap LevelId Level) -> State -> Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap LevelId Level
sdungeon
let ordPos :: Point -> (X, Point)
ordPos p :: Point
p = (Point -> Point -> X
chessDist Point
lpos Point
p, Point
p)
dbs :: [Point]
dbs = (Point -> (X, Point)) -> [Point] -> [Point]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Point -> (X, Point)
ordPos [Point]
bsAll
pickUnderXhair :: ([Point], [Point])
pickUnderXhair =
let i :: X
i = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (-1)
(Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
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 X -> [Point] -> ([Point], [Point])
forall a. X -> [a] -> ([a], [a])
splitAt X
i [Point]
dbs
(lt :: [Point]
lt, gt :: [Point]
gt) = case Maybe Target
xhair of
Just (TPoint _ lid :: LevelId
lid pos :: 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 :: X
i = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (-1) (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
findIndex (Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pos) [Point]
dbs
in X -> [Point] -> ([Point], [Point])
forall a. X -> [a] -> ([a], [a])
splitAt (X
i X -> X -> X
forall a. Num a => a -> a -> a
+ 1) [Point]
dbs
Just (TPoint _ lid :: LevelId
lid pos :: Point
pos)
| LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV ->
let i :: X
i = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (-1) (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
findIndex (Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pos) [Point]
dbs
in X -> [Point] -> ([Point], [Point])
forall a. X -> [a] -> ([a], [a])
splitAt X
i [Point]
dbs
_ -> ([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
p :: Point
p : _ -> 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
$ \sess :: SessionUI
sess -> SessionUI
sess { saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV
, Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair }
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
aimAscendHuman :: MonadClientUI m => Int -> m MError
aimAscendHuman :: X -> m MError
aimAscendHuman k :: X
k = do
EnumMap LevelId Level
dungeon <- (State -> EnumMap LevelId Level) -> m (EnumMap LevelId Level)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap LevelId Level
sdungeon
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
let up :: Bool
up = X
k X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0
case EnumMap LevelId Level -> Bool -> LevelId -> [LevelId]
ascendInBranch EnumMap LevelId Level
dungeon Bool
up LevelId
lidV of
[] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "no more levels in this direction"
_ : _ -> do
let ascendOne :: LevelId -> LevelId
ascendOne lid :: LevelId
lid = case EnumMap LevelId Level -> Bool -> LevelId -> [LevelId]
ascendInBranch EnumMap LevelId Level
dungeon Bool
up LevelId
lid of
[] -> LevelId
lid
nlid :: LevelId
nlid : _ -> LevelId
nlid
lidK :: LevelId
lidK = (LevelId -> LevelId) -> LevelId -> [LevelId]
forall a. (a -> a) -> a -> [a]
iterate LevelId -> LevelId
ascendOne LevelId
lidV [LevelId] -> X -> LevelId
forall a. [a] -> X -> a
!! X -> X
forall a. Num a => a -> a
abs X
k
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Point
lpos <- (State -> Point) -> m Point
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 Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
let xhairPos :: Point
xhairPos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
lpos Maybe Point
mxhairPos
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
$ \sess :: SessionUI
sess -> SessionUI
sess { saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (LevelId -> AimMode
AimMode LevelId
lidK)
, Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair }
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
epsIncrHuman :: (MonadClient m, MonadClientUI m) => Bool -> m ()
epsIncrHuman :: Bool -> m ()
epsIncrHuman b :: Bool
b = do
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
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
$ \sess :: SessionUI
sess -> SessionUI
sess {saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV}
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli -> StateClient
cli {seps :: X
seps = StateClient -> X
seps StateClient
cli X -> X -> X
forall a. Num a => a -> a -> a
+ if Bool
b then 1 else -1}
m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsPathAll
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
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: Maybe AimMode
saimMode}
flashAiming :: MonadClientUI m => m ()
flashAiming :: 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) => m MError
xhairUnknownHuman :: m MError
xhairUnknownHuman = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
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
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "no more unknown spots left"
Just p :: 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
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair}
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
xhairItemHuman :: (MonadClient m, MonadClientUI m) => m MError
xhairItemHuman :: m MError
xhairItemHuman = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
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
[(X, (Point, EnumMap ItemId (X, ItemTimer)))]
items <- ActorId -> m [(X, (Point, EnumMap ItemId (X, ItemTimer)))]
forall (m :: * -> *).
MonadClient m =>
ActorId -> m [(X, (Point, EnumMap ItemId (X, ItemTimer)))]
closestItems ActorId
leader
case [(X, (Point, EnumMap ItemId (X, ItemTimer)))]
items of
[] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "no more reachable items remembered or visible"
_ -> do
let (_, (p :: Point
p, bag :: EnumMap ItemId (X, ItemTimer)
bag)) = ((X, (Point, EnumMap ItemId (X, ItemTimer)))
-> (X, (Point, EnumMap ItemId (X, ItemTimer))) -> Ordering)
-> [(X, (Point, EnumMap ItemId (X, ItemTimer)))]
-> (X, (Point, EnumMap ItemId (X, ItemTimer)))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((X, (Point, EnumMap ItemId (X, ItemTimer))) -> X)
-> (X, (Point, EnumMap ItemId (X, ItemTimer)))
-> (X, (Point, EnumMap ItemId (X, ItemTimer)))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (X, (Point, EnumMap ItemId (X, ItemTimer))) -> X
forall a b. (a, b) -> a
fst) [(X, (Point, EnumMap ItemId (X, ItemTimer)))]
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 (X, ItemTimer) -> TGoal
TItem EnumMap ItemId (X, ItemTimer)
bag) (Actor -> LevelId
blid Actor
b) Point
p
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair}
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
xhairStairHuman :: (MonadClient m, MonadClientUI m) => Bool -> m MError
xhairStairHuman :: Bool -> m MError
xhairStairHuman up :: Bool
up = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
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
[(X, (Point, (Point, EnumMap ItemId (X, ItemTimer))))]
stairs <- FleeViaStairsOrEscape
-> ActorId
-> m [(X, (Point, (Point, EnumMap ItemId (X, ItemTimer))))]
forall (m :: * -> *).
MonadClient m =>
FleeViaStairsOrEscape
-> ActorId
-> m [(X, (Point, (Point, EnumMap ItemId (X, ItemTimer))))]
closestTriggers (if Bool
up then FleeViaStairsOrEscape
ViaStairsUp else FleeViaStairsOrEscape
ViaStairsDown) ActorId
leader
case [(X, (Point, (Point, EnumMap ItemId (X, ItemTimer))))]
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
$ "no reachable stairs" Text -> Text -> Text
<+> if Bool
up then "up" else "down"
_ -> do
let (_, (p :: Point
p, (p0 :: Point
p0, bag :: EnumMap ItemId (X, ItemTimer)
bag))) = ((X, (Point, (Point, EnumMap ItemId (X, ItemTimer))))
-> (X, (Point, (Point, EnumMap ItemId (X, ItemTimer))))
-> Ordering)
-> [(X, (Point, (Point, EnumMap ItemId (X, ItemTimer))))]
-> (X, (Point, (Point, EnumMap ItemId (X, ItemTimer))))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((X, (Point, (Point, EnumMap ItemId (X, ItemTimer)))) -> X)
-> (X, (Point, (Point, EnumMap ItemId (X, ItemTimer))))
-> (X, (Point, (Point, EnumMap ItemId (X, ItemTimer))))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (X, (Point, (Point, EnumMap ItemId (X, ItemTimer)))) -> X
forall a b. (a, b) -> a
fst) [(X, (Point, (Point, EnumMap ItemId (X, ItemTimer))))]
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 (X, ItemTimer) -> Point -> TGoal
TEmbed EnumMap ItemId (X, ItemTimer)
bag Point
p0) (Actor -> LevelId
blid Actor
b) Point
p
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair}
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
xhairPointerFloorHuman :: MonadClientUI m => m ()
xhairPointerFloorHuman :: m ()
xhairPointerFloorHuman = do
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
m ()
forall (m :: * -> *). MonadClientUI m => m ()
aimPointerFloorHuman
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: Maybe AimMode
saimMode}
xhairPointerEnemyHuman :: MonadClientUI m => m ()
xhairPointerEnemyHuman :: m ()
xhairPointerEnemyHuman = do
Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
m ()
forall (m :: * -> *). MonadClientUI m => m ()
aimPointerEnemyHuman
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: Maybe AimMode
saimMode}
aimPointerFloorHuman :: MonadClientUI m => m ()
aimPointerFloorHuman :: m ()
aimPointerFloorHuman = do
COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: X
rXmax :: RuleContent -> X
rXmax, X
rYmax :: X
rYmax :: RuleContent -> X
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Point{..} <- (SessionUI -> Point) -> m Point
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Point
spointer
if X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
Bool -> Bool -> Bool
&& X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rXmax Bool -> Bool -> Bool
&& X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rYmax
then do
Maybe Target
oldXhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
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 -> Target) -> Point -> Target
forall a b. (a -> b) -> a -> b
$ X -> X -> Point
Point X
px (X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY)
sxhairMoused :: Bool
sxhairMoused = Maybe Target
sxhair Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
oldXhair
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
SessionUI
sess { saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV
, Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair
, Bool
sxhairMoused :: Bool
sxhairMoused :: Bool
sxhairMoused }
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
else m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
aimPointerEnemyHuman :: MonadClientUI m => m ()
aimPointerEnemyHuman :: m ()
aimPointerEnemyHuman = do
COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: X
rXmax :: RuleContent -> X
rXmax, X
rYmax :: X
rYmax :: RuleContent -> X
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
Point{..} <- (SessionUI -> Point) -> m Point
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Point
spointer
if X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
Bool -> Bool -> Bool
&& X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rXmax Bool -> Bool -> Bool
&& X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rYmax
then do
[(ActorId, Actor)]
bsAll <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
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 (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
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 newPos :: Point
newPos = X -> X -> Point
Point X
px (X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY)
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 (\(_, b :: Actor
b) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
newPos) [(ActorId, Actor)]
bsAll of
Just (aid :: ActorId
aid, b :: 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
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
newPos
sxhairMoused :: Bool
sxhairMoused = Maybe Target
sxhair Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
oldXhair
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
SessionUI
sess { saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV
, Bool
sxhairMoused :: Bool
sxhairMoused :: Bool
sxhairMoused
, Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair }
m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
else m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack