{-# LANGUAGE TupleSections #-}
-- | Semantics of "Game.LambdaHack.Client.UI.HumanCmd"
-- client commands that do not return server requests,,
-- but only change internal client state.
-- None of such commands takes game time.
module Game.LambdaHack.Client.UI.HandleHumanLocalM
  ( -- * Meta commands
    macroHuman, macroHumanTransition
    -- * Local commands
  , chooseItemHuman, chooseItemDialogMode
  , chooseItemProjectHuman, chooseItemApplyHuman
  , psuitReq, triggerSymbols, pickLeaderHuman, pickLeaderWithPointerHuman
  , memberCycleHuman, memberCycleLevelHuman
  , selectActorHuman, selectNoneHuman, selectWithPointerHuman
  , repeatHuman, repeatHumanTransition
  , repeatLastHuman, repeatLastHumanTransition
  , recordHuman, recordHumanTransition
  , allHistoryHuman, lastHistoryHuman
  , markVisionHuman, markSmellHuman, markSuspectHuman, markAnimHuman
  , overrideTutHuman
  , printScreenHuman
    -- * Commands specific to aiming
  , cancelHuman, acceptHuman, detailCycleHuman
  , clearTargetIfItemClearHuman, itemClearHuman
  , moveXhairHuman, aimTgtHuman, aimFloorHuman, aimEnemyHuman, aimItemHuman
  , aimAscendHuman, epsIncrHuman
  , xhairUnknownHuman, xhairItemHuman, xhairStairHuman
  , xhairPointerFloorHuman, xhairPointerMuteHuman, xhairPointerEnemyHuman
  , aimPointerFloorHuman, aimPointerEnemyHuman
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , chooseItemDialogModeLore, permittedProjectClient, projectCheck
  , xhairLegalEps, posFromXhair
  , permittedApplyClient, selectAid, eitherHistory, endAiming, endAimingMsg
  , doLook, flashAiming
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Either (fromRight)
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Client.BfsM
import           Game.LambdaHack.Client.CommonM
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.ActorUI
import           Game.LambdaHack.Client.UI.Animation
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.DrawM
import           Game.LambdaHack.Client.UI.EffectDescription
import           Game.LambdaHack.Client.UI.Frame
import           Game.LambdaHack.Client.UI.FrameM
import           Game.LambdaHack.Client.UI.HandleHelperM
import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
import           Game.LambdaHack.Client.UI.InventoryM
import           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.PointUI
import           Game.LambdaHack.Client.UI.SessionUI
import           Game.LambdaHack.Client.UI.Slideshow
import           Game.LambdaHack.Client.UI.SlideshowM
import           Game.LambdaHack.Client.UI.UIOptions
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.ClientOptions
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.ModeKind as MK
import qualified Game.LambdaHack.Content.PlaceKind as PK
import           Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import           Game.LambdaHack.Definition.Defs

-- * Macro

macroHuman :: (MonadClient m, MonadClientUI m) => [String] -> m ()
macroHuman :: [String] -> m ()
macroHuman ks :: [String]
ks = do
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
    let kms :: [KM]
kms = String -> KM
K.mkKM (String -> KM) -> [String] -> [KM]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ks
        (smacroFrameNew :: KeyMacroFrame
smacroFrameNew, smacroStackMew :: [KeyMacroFrame]
smacroStackMew) =
           [KM]
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
macroHumanTransition [KM]
kms (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) (SessionUI -> [KeyMacroFrame]
smacroStack SessionUI
sess)
    in SessionUI
sess { smacroFrame :: KeyMacroFrame
smacroFrame = KeyMacroFrame
smacroFrameNew
            , smacroStack :: [KeyMacroFrame]
smacroStack = [KeyMacroFrame]
smacroStackMew }
  MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgMacroOperation (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]
ks)

-- | Push a new macro frame to the stack whenever repeating a macro.
macroHumanTransition :: [K.KM] -> KeyMacroFrame -> [KeyMacroFrame]
                     -> (KeyMacroFrame, [KeyMacroFrame])
macroHumanTransition :: [KM]
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
macroHumanTransition kms :: [KM]
kms macroFrame :: KeyMacroFrame
macroFrame macroFrames :: [KeyMacroFrame]
macroFrames =
  let smacroFrameNew :: KeyMacroFrame
smacroFrameNew = KeyMacroFrame
emptyMacroFrame {keyPending :: KeyMacro
keyPending = [KM] -> KeyMacro
KeyMacro [KM]
kms}
  in (KeyMacroFrame
smacroFrameNew, KeyMacroFrame
macroFrame KeyMacroFrame -> [KeyMacroFrame] -> [KeyMacroFrame]
forall a. a -> [a] -> [a]
: [KeyMacroFrame]
macroFrames)

-- * ChooseItem

-- | Display items from a given container store and possibly let the user
-- chose one.
chooseItemHuman :: (MonadClient m, 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
<$> Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode Bool
False ItemDialogMode
c

chooseItemDialogModeLore :: (MonadClient m, MonadClientUI m)
                         => m (Maybe ResultItemDialogMode)
chooseItemDialogModeLore :: m (Maybe ResultItemDialogMode)
chooseItemDialogModeLore = do
  ChosenLore
schosenLore <- (SessionUI -> ChosenLore) -> m ChosenLore
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChosenLore
schosenLore
  (inhabitants :: [(ActorId, Actor)]
inhabitants, embeds :: [(ItemId, ItemQuant)]
embeds) <- case ChosenLore
schosenLore of
    ChosenLore inh :: [(ActorId, Actor)]
inh emb :: [(ItemId, ItemQuant)]
emb -> ([(ActorId, Actor)], [(ItemId, ItemQuant)])
-> m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ActorId, Actor)]
inh, [(ItemId, ItemQuant)]
emb)
    ChosenNothing -> m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
forall (m :: * -> *).
MonadClientUI m =>
m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
computeChosenLore
  EnumMap ItemId ItemQuant
bagAll <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
 -> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ (Item -> ItemQuant)
-> EnumMap ItemId Item -> EnumMap ItemId ItemQuant
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (ItemQuant -> Item -> ItemQuant
forall a b. a -> b -> a
const ItemQuant
quantSingle) (EnumMap ItemId Item -> EnumMap ItemId ItemQuant)
-> (State -> EnumMap ItemId Item)
-> State
-> EnumMap ItemId ItemQuant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ItemId Item
sitemD
  case [(ActorId, Actor)]
inhabitants of
    (_, b :: Actor
b) : rest :: [(ActorId, Actor)]
rest -> do
      let iid :: ItemId
iid = Actor -> ItemId
btrunk Actor
b
      AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid
      let slore :: SLore
slore | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
b = SLore
STrunk
                | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem = SLore
SBlast
                | Bool
otherwise = SLore
SItem
      SingleItemSlots
lSlots <- ItemDialogMode -> m SingleItemSlots
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m SingleItemSlots
slotsOfItemDialogMode (ItemDialogMode -> m SingleItemSlots)
-> ItemDialogMode -> m SingleItemSlots
forall a b. (a -> b) -> a -> b
$ SLore -> ItemDialogMode
MLore SLore
slore
      (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 {schosenLore :: ChosenLore
schosenLore = [(ActorId, Actor)] -> [(ItemId, ItemQuant)] -> ChosenLore
ChosenLore [(ActorId, Actor)]
rest [(ItemId, ItemQuant)]
embeds}
      Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode))
-> Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ResultItemDialogMode -> Maybe ResultItemDialogMode
forall a. a -> Maybe a
Just (ResultItemDialogMode -> Maybe ResultItemDialogMode)
-> ResultItemDialogMode -> Maybe ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ SLore
-> ItemId
-> EnumMap ItemId ItemQuant
-> SingleItemSlots
-> ResultItemDialogMode
RLore SLore
slore ItemId
iid EnumMap ItemId ItemQuant
bagAll SingleItemSlots
lSlots
    [] ->
      case [(ItemId, ItemQuant)]
embeds of
        (iid :: ItemId
iid, _) : rest :: [(ItemId, ItemQuant)]
rest -> do
          let slore :: SLore
slore = SLore
SEmbed
          SingleItemSlots
lSlots <- ItemDialogMode -> m SingleItemSlots
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m SingleItemSlots
slotsOfItemDialogMode (ItemDialogMode -> m SingleItemSlots)
-> ItemDialogMode -> m SingleItemSlots
forall a b. (a -> b) -> a -> b
$ SLore -> ItemDialogMode
MLore SLore
slore
          (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 {schosenLore :: ChosenLore
schosenLore = [(ActorId, Actor)] -> [(ItemId, ItemQuant)] -> ChosenLore
ChosenLore [(ActorId, Actor)]
inhabitants [(ItemId, ItemQuant)]
rest}
          Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode))
-> Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ResultItemDialogMode -> Maybe ResultItemDialogMode
forall a. a -> Maybe a
Just (ResultItemDialogMode -> Maybe ResultItemDialogMode)
-> ResultItemDialogMode -> Maybe ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ SLore
-> ItemId
-> EnumMap ItemId ItemQuant
-> SingleItemSlots
-> ResultItemDialogMode
RLore SLore
slore ItemId
iid EnumMap ItemId ItemQuant
bagAll SingleItemSlots
lSlots
        [] -> 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 {schosenLore :: ChosenLore
schosenLore = ChosenLore
ChosenNothing}
          Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ResultItemDialogMode
forall a. Maybe a
Nothing

chooseItemDialogMode :: (MonadClient m, MonadClientUI m)
                     => Bool -> ItemDialogMode -> m (FailOrCmd ItemDialogMode)
chooseItemDialogMode :: Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode permitLoreCycle :: Bool
permitLoreCycle 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
  FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  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
  (ggi :: Either Text ResultItemDialogMode
ggi, loreFound :: Bool
loreFound) <- do
    Maybe ResultItemDialogMode
mggiLore <- if Bool
permitLoreCycle Bool -> Bool -> Bool
&& ItemDialogMode
c ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
== SLore -> ItemDialogMode
MLore SLore
SItem
                then m (Maybe ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Maybe ResultItemDialogMode)
chooseItemDialogModeLore
                else Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ResultItemDialogMode
forall a. Maybe a
Nothing
    case Maybe ResultItemDialogMode
mggiLore of
      Just rlore :: ResultItemDialogMode
rlore -> (Either Text ResultItemDialogMode, Bool)
-> m (Either Text ResultItemDialogMode, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right ResultItemDialogMode
rlore, Bool
True)
      Nothing -> do
        Either Text ResultItemDialogMode
ggi <- ItemDialogMode -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ItemDialogMode -> m (Either Text ResultItemDialogMode)
getStoreItem ItemDialogMode
c
        (Either Text ResultItemDialogMode, Bool)
-> m (Either Text ResultItemDialogMode, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
ggi, Bool
False)
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory  -- item chosen, wipe out already shown msgs
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  let meleeSkill :: X
meleeSkill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkHurtMelee Skills
actorCurAndMaxSk
  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 ResultItemDialogMode
ggi of
    Right result :: ResultItemDialogMode
result -> case ResultItemDialogMode
result of
      RStore fromCStore :: CStore
fromCStore [iid :: ItemId
iid] -> do
        (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \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 -> Either FailError ItemDialogMode)
-> ItemDialogMode -> Either FailError ItemDialogMode
forall a b. (a -> b) -> a -> b
$ CStore -> ItemDialogMode
MStore CStore
fromCStore
      RStore{} -> 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 -> ResultItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ResultItemDialogMode
result
      ROrgans iid :: ItemId
iid itemBag :: EnumMap ItemId ItemQuant
itemBag lSlots :: SingleItemSlots
lSlots -> 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, "is aware of"
                           , 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
$ "" String -> ResultItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ResultItemDialogMode
result)
                  (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 ItemQuant
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
EnumMap ItemId ItemQuant
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> m Bool
displayItemLore EnumMap ItemId ItemQuant
itemBag X
meleeSkill ItemId -> ItemFull -> X -> Text
promptFun X
ix0 SingleItemSlots
lSlots
        if Bool
go then Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode Bool
False ItemDialogMode
MOrgans else Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
      ROwned iid :: ItemId
iid -> 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 -> ResultItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ResultItemDialogMode
result
        (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \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
        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
MOwned
           | 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
             -- We switch leader only here, not in lore screens, because
             -- lore is only about inspecting items, no activation submenu.
             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 :: * -> *).
(MonadClient 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
MOwned
      RSkills slotIndex0 :: X
slotIndex0 -> 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 skill :: Skill
skill = [Skill]
skillSlots [Skill] -> X -> Skill
forall a. [a] -> X -> a
!! X
slotIndex
                  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
actorCurAndMaxSk
                  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 :: EnumMap DisplayFont Overlay
ov0 = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont
                        (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
                        ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ X -> AttrString -> [AttrLine]
indentSplitAttrString X
rwidth
                        (AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Text -> AttrString
textToAS (Text -> AttrString) -> Text -> AttrString
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]
              MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric 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 (EnumMap DisplayFont Overlay
ov0, [])
              KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
(MonadClient 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 -> Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode Bool
False 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
        X -> m (Either FailError ItemDialogMode)
displayOneSlot X
slotIndex0
      RLore slore :: SLore
slore iid :: ItemId
iid itemBag :: EnumMap ItemId ItemQuant
itemBag lSlots :: SingleItemSlots
lSlots -> 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
$ "" String -> ResultItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ResultItemDialogMode
result)
                  (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) ]
        ChosenLore
schosenLore <- (SessionUI -> ChosenLore) -> m ChosenLore
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChosenLore
schosenLore
        let lorePending :: Bool
lorePending = Bool
loreFound Bool -> Bool -> Bool
&& case ChosenLore
schosenLore of
              ChosenLore [] [] -> Bool
False
              _ -> Bool
True
        KM
km <- EnumMap ItemId ItemQuant
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> Bool
-> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
EnumMap ItemId ItemQuant
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> Bool
-> m KM
displayItemLorePointedAt EnumMap ItemId ItemQuant
itemBag X
meleeSkill ItemId -> ItemFull -> X -> Text
promptFun X
ix0
                                       SingleItemSlots
lSlots Bool
lorePending
        case KM -> Key
K.key KM
km of
          K.Space -> do
            (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {schosenLore :: ChosenLore
schosenLore = ChosenLore
ChosenNothing}
            Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode Bool
False (SLore -> ItemDialogMode
MLore SLore
slore)
          K.Char '~' -> Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode Bool
True ItemDialogMode
c
          K.Esc -> do
            (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {schosenLore :: ChosenLore
schosenLore = ChosenLore
ChosenNothing}
            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
      RPlaces slotIndex0 :: X
slotIndex0 -> 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 (pk :: ContentId PlaceKind
pk, (es :: EnumSet LevelId
es, ne :: X
ne, na :: X
na, _)) = [(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
slotIndex
                  pkind :: PlaceKind
pkind = ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk
                  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 ]]
                  placeParts :: [Part]
placeParts = ["it has" | X
ne X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
|| X
na X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0]
                               [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [X -> Part -> Part
MU.CarWs X
ne "entrance" | X
ne X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0]
                               [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ ["and" | X
ne X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& X
na X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0]
                               [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [X -> Part -> Part
MU.CarWs X
na "surrounding" | X
na X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0]
                  partsSentence :: Text
partsSentence | [Part] -> Bool
forall a. [a] -> Bool
null [Part]
placeParts = ""
                                | Bool
otherwise = [Part] -> Text
makeSentence [Part]
placeParts
                  -- Ideally, place layout would be in SquareFont and the rest
                  -- in PropFont, but this is mostly a debug screen, so KISS.
                  ov0 :: EnumMap DisplayFont Overlay
ov0 = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont
                        (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
                        ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ (Text -> [AttrLine]) -> [Text] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (X -> AttrString -> [AttrLine]
indentSplitAttrString X
rwidth (AttrString -> [AttrLine])
-> (Text -> AttrString) -> Text -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AttrString
textToAS)
                        ([Text] -> [AttrLine]) -> [Text] -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ ["", Text
partsSentence]
                          [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (if ClientOptions -> Bool
sexposePlaces ClientOptions
soptions
                              then [ "", 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]
              MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric 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 (EnumMap DisplayFont Overlay
ov0, [])
              KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
(MonadClient 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 -> Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode Bool
False 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
        X -> m (Either FailError ItemDialogMode)
displayOneSlot X
slotIndex0
      RModes slotIndex0 :: X
slotIndex0 -> do
        COps{ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode :: ContentData ModeKind
comode} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
        EnumMap (ContentId ModeKind) (Map Challenge X)
svictories <- (StateClient -> EnumMap (ContentId ModeKind) (Map Challenge X))
-> m (EnumMap (ContentId ModeKind) (Map Challenge X))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> EnumMap (ContentId ModeKind) (Map Challenge X)
svictories
        Challenge
nxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
          -- mark victories only for current difficulty
        let f :: [(a, b)] -> p -> a -> b -> [(a, b)]
f ![(a, b)]
acc _p :: p
_p !a
i !b
a = (a
i, b
a) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
acc
            campaignModes :: [(ContentId ModeKind, ModeKind)]
campaignModes = ContentData ModeKind
-> GroupName ModeKind
-> ([(ContentId ModeKind, ModeKind)]
    -> X
    -> ContentId ModeKind
    -> ModeKind
    -> [(ContentId ModeKind, ModeKind)])
-> [(ContentId ModeKind, ModeKind)]
-> [(ContentId ModeKind, ModeKind)]
forall a b.
ContentData a
-> GroupName a -> (b -> X -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode GroupName ModeKind
MK.CAMPAIGN_SCENARIO [(ContentId ModeKind, ModeKind)]
-> X
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)]
forall a b p. [(a, b)] -> p -> a -> b -> [(a, b)]
f []
            slotListBound :: X
slotListBound = [(ContentId ModeKind, ModeKind)] -> X
forall a. [a] -> X
length [(ContentId ModeKind, ModeKind)]
campaignModes X -> X -> X
forall a. Num a => a -> a -> a
- 1
            displayOneSlot :: X -> m (Either FailError ItemDialogMode)
displayOneSlot slotIndex :: X
slotIndex = do
              let (gameModeId :: ContentId ModeKind
gameModeId, gameMode :: ModeKind
gameMode) = [(ContentId ModeKind, ModeKind)]
campaignModes [(ContentId ModeKind, ModeKind)]
-> X -> (ContentId ModeKind, ModeKind)
forall a. [a] -> X -> a
!! X
slotIndex
              EnumMap DisplayFont Overlay
modeOKX <- Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
describeMode Bool
False ContentId ModeKind
gameModeId
              let victories :: X
victories = case ContentId ModeKind
-> EnumMap (ContentId ModeKind) (Map Challenge X)
-> Maybe (Map Challenge X)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ContentId ModeKind
gameModeId EnumMap (ContentId ModeKind) (Map Challenge X)
svictories of
                    Nothing -> 0
                    Just cm :: Map Challenge X
cm -> X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe 0 (Challenge -> Map Challenge X -> Maybe X
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Challenge
nxtChal Map Challenge X
cm)
                  verb :: Part
verb = if X
victories X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "remember" else "forsee"
                  prompt2 :: Text
prompt2 = [Part] -> Text
makeSentence
                    [ Part -> Part -> Part
MU.SubjectVerbSg (ActorUI -> Part
partActor ActorUI
bUI) Part
verb
                    , Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ "the '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModeKind -> Text
MK.mname ModeKind
gameMode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' adventure" ]
                  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]
              MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt2
              Slideshow
slides <- X -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
X -> [KM] -> OKX -> m Slideshow
overlayToSlideshow X
rheight [KM]
keys (EnumMap DisplayFont Overlay
modeOKX, [])
              Either KM SlotChar
ekm2 <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "" ColorMode
ColorFull Bool
True Slideshow
slides [KM]
keys
              let km :: KM
km = (KM -> KM) -> (SlotChar -> KM) -> Either KM SlotChar -> KM
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either KM -> KM
forall a. a -> a
id (String -> SlotChar -> KM
forall a. HasCallStack => String -> a
error (String -> SlotChar -> KM) -> String -> SlotChar -> KM
forall a b. (a -> b) -> a -> b
$ "" String -> Either KM SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` Either KM SlotChar
ekm2) Either KM SlotChar
ekm2
              case KM -> Key
K.key KM
km of
                K.Space -> Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode Bool
False ItemDialogMode
MModes
                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
        X -> m (Either FailError ItemDialogMode)
displayOneSlot X
slotIndex0
    Left err :: Text
err -> Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err

-- * ChooseItemProject

chooseItemProjectHuman :: forall m. (MonadClient m, MonadClientUI m)
                       => [HumanCmd.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
  Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
  let overStash :: Bool
overStash = Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
b, Actor -> Point
bpos Actor
b)
      storesBase :: [CStore]
storesBase = [CStore
CStash, CStore
CEqp]
      stores :: [CStore]
stores | Bool
overStash = [CStore]
storesBase [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CGround]
             | Bool
otherwise = CStore
CGround CStore -> [CStore] -> [CStore]
forall a. a -> [a] -> [a]
: [CStore]
storesBase
      (verb1 :: Part
verb1, object1 :: Part
object1) = case [TriggerItem]
ts of
        [] -> ("aim", "item")
        tr :: TriggerItem
tr : _ -> (TriggerItem -> Part
HumanCmd.tiverb TriggerItem
tr, TriggerItem -> Part
HumanCmd.tiobject TriggerItem
tr)
      verb :: Text
verb = [Part] -> Text
makePhrase [Part
verb1]
      triggerSyms :: String
triggerSyms = [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
  Either Text (ItemFull -> Either ReqFailure (Point, Bool))
mpsuitReq <- 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
    -- If xhair aim invalid, no item is considered a (suitable) missile.
    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
          -- We don't validate vs @ts@ here, because player has selected
          -- this item, so he knows what he's doing (unless really absurd).
          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 ItemQuant
bag <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
 -> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId ItemQuant
getBodyStoreBag Actor
b CStore
fromCStore
          case ItemId
iid ItemId -> EnumMap ItemId ItemQuant -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ItemId ItemQuant
bag of
            Just _ | (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
$ (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
SuitsSomething ((Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability)
-> (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
forall a b. (a -> b) -> a -> b
$ \_ itemFull :: ItemFull
itemFull _kit :: ItemQuant
_kit ->
                  (ReqFailure -> Bool)
-> ((Point, Bool) -> Bool)
-> Either ReqFailure (Point, Bool)
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) (Point, Bool) -> Bool
forall a b. (a, b) -> b
snd (ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ItemFull
itemFull)
                  Bool -> Bool -> Bool
&& (String -> Bool
forall a. [a] -> Bool
null String
triggerSyms
                      Bool -> Bool -> Bool
|| ItemKind -> Char
IK.isymbol (ItemFull -> ItemKind
itemKind ItemFull
itemFull) Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
triggerSyms)
              prompt :: Text
prompt = [Part] -> Text
makePhrase ["What", Part
object1, "to"]
              promptGeneric :: Text
promptGeneric = "What to"
          Either Text (CStore, ItemId)
ggi <- m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
getGroupItem m Suitability
psuit Text
prompt Text
promptGeneric Text
verb "fling" [CStore]
stores
          case Either Text (CStore, ItemId)
ggi of
            Right (fromCStore :: CStore
fromCStore, iid :: ItemId
iid) -> do
              (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \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

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
  Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  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 skill :: X
skill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkProject Skills
actorCurAndMaxSk
      calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorCurAndMaxSk
  (ItemFull -> Either ReqFailure Bool)
-> m (ItemFull -> Either ReqFailure Bool)
forall (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
  -- Not @ScreenContent@, because not drawing here.
  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

-- | Check whether one is permitted to aim (for projecting) at a target.
-- The check is stricter for actor targets, assuming the player simply wants
-- to hit a single actor. In order to fine tune trick-shots, e.g., piercing
-- many actors, other aiming modes should be used.
-- Returns a different @seps@ if needed to reach the target.
--
-- Note: Simple Perception check is not enough for the check,
-- e.g., because the target actor can be obscured by a glass wall.
xhairLegalEps :: MonadClientUI m => m (Either Text Int)
xhairLegalEps :: m (Either Text X)
xhairLegalEps = do
  cops :: COps
cops@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
  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
        Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
        X
oldEps <- (StateClient -> X) -> m X
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> X
seps
        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 Bool -> Actor -> Point -> X -> COps -> Level -> Maybe X
makeLine Bool
onlyFirst Actor
b Point
pos X
oldEps COps
cops Level
lvl 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  -- @True@ to help pierce many foes, etc.
      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
      -- Not @ScreenContent@, because not drawing here.
      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  -- @True@, because the goal is vague anyway

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
      -- Modify @seps@, permanently.
      (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

-- | On top of @permittedProjectClient@, it also checks legality
-- of aiming at the target and projection range. It also modifies @eps@.
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, 1 X -> X -> X
forall a. Num a => a -> a -> a
+ 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 :: [HumanCmd.TriggerItem] -> [Char]
triggerSymbols :: [TriggerItem] -> String
triggerSymbols [] = []
triggerSymbols (HumanCmd.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

-- * ChooseItemApply

chooseItemApplyHuman :: forall m. (MonadClient m, MonadClientUI m)
                     => [HumanCmd.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
  Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
  let overStash :: Bool
overStash = Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
b, Actor -> Point
bpos Actor
b)
      storesBase :: [CStore]
storesBase = [CStore
CStash, CStore
CEqp, CStore
COrgan]
      stores :: [CStore]
stores | Bool
overStash = [CStore]
storesBase [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CGround]
             | Bool
otherwise = CStore
CGround CStore -> [CStore] -> [CStore]
forall a. a -> [a] -> [a]
: [CStore]
storesBase
      (verb1 :: Part
verb1, object1 :: Part
object1) = case [TriggerItem]
ts of
        [] -> ("trigger", "item")
        tr :: TriggerItem
tr : _ -> (TriggerItem -> Part
HumanCmd.tiverb TriggerItem
tr, TriggerItem -> Part
HumanCmd.tiobject TriggerItem
tr)
      verb :: Text
verb = [Part] -> Text
makePhrase [Part
verb1]
      triggerSyms :: String
triggerSyms = [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
      prompt :: Text
prompt = [Part] -> Text
makePhrase ["What", Part
object1, "to"]
      promptGeneric :: Text
promptGeneric = "What to"
  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
      -- We don't validate vs @ts@ here, because player has selected
      -- this item, so he knows what he's doing (unless really absurd).
      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 ItemQuant
bag <- (State -> EnumMap ItemId ItemQuant) -> m (EnumMap ItemId ItemQuant)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId ItemQuant)
 -> m (EnumMap ItemId ItemQuant))
-> (State -> EnumMap ItemId ItemQuant)
-> m (EnumMap ItemId ItemQuant)
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId ItemQuant
getBodyStoreBag Actor
b CStore
fromCStore
      Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
mp <- m (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
m (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
permittedApplyClient
      case ItemId
iid ItemId -> EnumMap ItemId ItemQuant -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ItemId ItemQuant
bag of
        Just kit :: ItemQuant
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
                          (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
mp (CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
fromCStore) ItemFull
itemFull ItemQuant
kit) ->
          MError -> m MError
forall (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
chooseItemApplyHuman [TriggerItem]
ts
    Nothing -> do
      let psuit :: m Suitability
          psuit :: m Suitability
psuit = do
            Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
mp <- m (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
m (Maybe CStore -> ItemFull -> ItemQuant -> 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
$ (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
SuitsSomething ((Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability)
-> (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
forall a b. (a -> b) -> a -> b
$ \cstore :: Maybe CStore
cstore itemFull :: ItemFull
itemFull kit :: ItemQuant
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 (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
mp Maybe CStore
cstore ItemFull
itemFull ItemQuant
kit)
              Bool -> Bool -> Bool
&& (String -> Bool
forall a. [a] -> Bool
null String
triggerSyms
                  Bool -> Bool -> Bool
|| ItemKind -> Char
IK.isymbol (ItemFull -> ItemKind
itemKind ItemFull
itemFull) Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
triggerSyms)
      Either Text (CStore, ItemId)
ggi <- m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
getGroupItem m Suitability
psuit Text
prompt Text
promptGeneric Text
verb "trigger" [CStore]
stores
      case Either Text (CStore, ItemId)
ggi of
        Right (fromCStore :: CStore
fromCStore, iid :: ItemId
iid) -> do
          (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \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

permittedApplyClient :: MonadClientUI m
                     => m (Maybe CStore -> ItemFull -> ItemQuant
                           -> Either ReqFailure Bool)
permittedApplyClient :: m (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
permittedApplyClient = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  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 skill :: X
skill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkApply Skills
actorCurAndMaxSk
      calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorCurAndMaxSk
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
  (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
-> m (Maybe CStore
      -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
 -> m (Maybe CStore
       -> ItemFull -> ItemQuant -> Either ReqFailure Bool))
-> (Maybe CStore
    -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
-> m (Maybe CStore
      -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
forall a b. (a -> b) -> a -> b
$ Time
-> X
-> Bool
-> Maybe CStore
-> ItemFull
-> ItemQuant
-> Either ReqFailure Bool
permittedApply Time
localTime X
skill Bool
calmE

-- * PickLeader

pickLeaderHuman :: (MonadClient m, 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 -- not only on level
  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
MK.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 :: * -> *).
(MonadClient 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

-- * PickLeaderWithPointer

pickLeaderWithPointerHuman :: (MonadClient m, MonadClientUI m) => m MError
pickLeaderWithPointerHuman :: m MError
pickLeaderWithPointerHuman = m MError
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m MError
pickLeaderWithPointer

-- * MemberCycle

-- | Switch current member to the next on the viewed level, if any, wrapping.
memberCycleLevelHuman :: (MonadClient m, MonadClientUI m)
                      => Direction -> m MError
memberCycleLevelHuman :: Direction -> m MError
memberCycleLevelHuman = Bool -> Direction -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Direction -> m MError
memberCycleLevel Bool
True

-- * MemberBack

-- | Switch current member to the previous in the whole dungeon, wrapping.
memberCycleHuman :: (MonadClient m, MonadClientUI m) => Direction -> m MError
memberCycleHuman :: Direction -> m MError
memberCycleHuman = Bool -> Direction -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Direction -> m MError
memberCycle Bool
True

-- * SelectActor

selectActorHuman :: (MonadClient m, MonadClientUI m) => m ()
selectActorHuman :: m ()
selectActorHuman = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  ActorId -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
selectAid ActorId
leader

selectAid :: (MonadClient m, 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  -- already selected, deselect instead
            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
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, if Bool
wasMemeber
                                                 then "deselected"
                                                 else "selected"]

-- * SelectNone

selectNoneHuman :: (MonadClient m, 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  -- already all deselected; select all instead
            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"
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, if Bool
wasNone
                                                 then "selected"
                                                 else "deselected"]

-- * SelectWithPointer

selectWithPointerHuman :: (MonadClient m, 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
  -- Not @ScreenContent@, because not drawing here.
  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
  PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
  let p :: Point
p@(Point px :: X
px py :: X
py) = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
  -- Select even if no space in status line for the actor's symbol.
  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
+ 1 Bool -> Bool -> Bool
&& X
px X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> m ()
forall (m :: * -> *). (MonadClient 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
+ 1 ->
         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 :: * -> *).
(MonadClient 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
== Point
p) [(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 :: * -> *).
(MonadClient 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

-- * Repeat

-- Note that walk followed by repeat should not be equivalent to run,
-- because the player can really use a command that does not stop
-- at terrain change or when walking over items.
repeatHuman :: MonadClientUI m => Int -> m ()
repeatHuman :: X -> m ()
repeatHuman n :: X
n =
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
    let (smacroFrameNew :: KeyMacroFrame
smacroFrameNew, smacroStackMew :: [KeyMacroFrame]
smacroStackMew) =
           X
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
repeatHumanTransition X
n (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) (SessionUI -> [KeyMacroFrame]
smacroStack SessionUI
sess)
    in SessionUI
sess { smacroFrame :: KeyMacroFrame
smacroFrame = KeyMacroFrame
smacroFrameNew
            , smacroStack :: [KeyMacroFrame]
smacroStack = [KeyMacroFrame]
smacroStackMew }

repeatHumanTransition :: Int -> KeyMacroFrame -> [KeyMacroFrame]
                      -> (KeyMacroFrame, [KeyMacroFrame])
repeatHumanTransition :: X
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
repeatHumanTransition n :: X
n macroFrame :: KeyMacroFrame
macroFrame macroFrames :: [KeyMacroFrame]
macroFrames =
  let kms :: [KM]
kms = [[KM]] -> [KM]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KM]] -> [KM])
-> (Either [KM] KeyMacro -> [[KM]]) -> Either [KM] KeyMacro -> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> [KM] -> [[KM]]
forall a. X -> a -> [a]
replicate X
n ([KM] -> [[KM]])
-> (Either [KM] KeyMacro -> [KM]) -> Either [KM] KeyMacro -> [[KM]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMacro -> [KM]
unKeyMacro (KeyMacro -> [KM])
-> (Either [KM] KeyMacro -> KeyMacro)
-> Either [KM] KeyMacro
-> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMacro -> Either [KM] KeyMacro -> KeyMacro
forall b a. b -> Either a b -> b
fromRight KeyMacro
forall a. Monoid a => a
mempty
            (Either [KM] KeyMacro -> [KM]) -> Either [KM] KeyMacro -> [KM]
forall a b. (a -> b) -> a -> b
$ KeyMacroFrame -> Either [KM] KeyMacro
keyMacroBuffer KeyMacroFrame
macroFrame
  in [KM]
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
macroHumanTransition [KM]
kms KeyMacroFrame
macroFrame [KeyMacroFrame]
macroFrames

-- * RepeatLast

-- Note that walk followed by repeat should not be equivalent to run,
-- because the player can really use a command that does not stop
-- at terrain change or when walking over items.
repeatLastHuman :: MonadClientUI m => Int -> m ()
repeatLastHuman :: X -> m ()
repeatLastHuman n :: X
n = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
  SessionUI
sess {smacroFrame :: KeyMacroFrame
smacroFrame = X -> KeyMacroFrame -> KeyMacroFrame
repeatLastHumanTransition X
n (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) }

repeatLastHumanTransition :: Int -> KeyMacroFrame -> KeyMacroFrame
repeatLastHumanTransition :: X -> KeyMacroFrame -> KeyMacroFrame
repeatLastHumanTransition n :: X
n macroFrame :: KeyMacroFrame
macroFrame =
  let macro :: KeyMacro
macro = [KM] -> KeyMacro
KeyMacro ([KM] -> KeyMacro) -> (Maybe KM -> [KM]) -> Maybe KM -> KeyMacro
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[KM]] -> [KM]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KM]] -> [KM]) -> (Maybe KM -> [[KM]]) -> Maybe KM -> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> [KM] -> [[KM]]
forall a. X -> a -> [a]
replicate X
n ([KM] -> [[KM]]) -> (Maybe KM -> [KM]) -> Maybe KM -> [[KM]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe KM -> [KM]
forall a. Maybe a -> [a]
maybeToList (Maybe KM -> KeyMacro) -> Maybe KM -> KeyMacro
forall a b. (a -> b) -> a -> b
$ KeyMacroFrame -> Maybe KM
keyLast KeyMacroFrame
macroFrame
  in KeyMacroFrame
macroFrame { keyPending :: KeyMacro
keyPending = KeyMacro
macro KeyMacro -> KeyMacro -> KeyMacro
forall a. Semigroup a => a -> a -> a
<> KeyMacroFrame -> KeyMacro
keyPending KeyMacroFrame
macroFrame }

-- * Record

-- | Starts and stops recording of macros.
recordHuman :: (MonadClient m, MonadClientUI m) => m ()
recordHuman :: m ()
recordHuman = do
  KeyMacroFrame
smacroFrameOld <- (SessionUI -> KeyMacroFrame) -> m KeyMacroFrame
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> KeyMacroFrame
smacroFrame
  let (smacroFrameNew :: KeyMacroFrame
smacroFrameNew, msg :: Text
msg) = KeyMacroFrame -> (KeyMacroFrame, Text)
recordHumanTransition KeyMacroFrame
smacroFrameOld
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {smacroFrame :: KeyMacroFrame
smacroFrame = KeyMacroFrame
smacroFrameNew}
  [KeyMacroFrame]
macroStack <- (SessionUI -> [KeyMacroFrame]) -> m [KeyMacroFrame]
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> [KeyMacroFrame]
smacroStack
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
msg Bool -> Bool -> Bool
|| Bool -> Bool
not ([KeyMacroFrame] -> Bool
forall a. [a] -> Bool
null [KeyMacroFrame]
macroStack)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
msg

recordHumanTransition :: KeyMacroFrame -> (KeyMacroFrame, Text)
recordHumanTransition :: KeyMacroFrame -> (KeyMacroFrame, Text)
recordHumanTransition macroFrame :: KeyMacroFrame
macroFrame =
  let (buffer :: Either [KM] KeyMacro
buffer, msg :: Text
msg) = case KeyMacroFrame -> Either [KM] KeyMacro
keyMacroBuffer KeyMacroFrame
macroFrame of
        Right _ ->
          -- Start recording in-game macro.
          ([KM] -> Either [KM] KeyMacro
forall a b. a -> Either a b
Left [], "Recording a macro. Stop recording with the same key.")
        Left xs :: [KM]
xs ->
          -- Stop recording in-game macro.
          (KeyMacro -> Either [KM] KeyMacro
forall a b. b -> Either a b
Right (KeyMacro -> Either [KM] KeyMacro)
-> ([KM] -> KeyMacro) -> [KM] -> Either [KM] KeyMacro
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KM] -> KeyMacro
KeyMacro ([KM] -> KeyMacro) -> ([KM] -> [KM]) -> [KM] -> KeyMacro
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KM] -> [KM]
forall a. [a] -> [a]
reverse ([KM] -> Either [KM] KeyMacro) -> [KM] -> Either [KM] KeyMacro
forall a b. (a -> b) -> a -> b
$ [KM]
xs, "Macro recording stopped.")
      smacroFrameNew :: KeyMacroFrame
smacroFrameNew = KeyMacroFrame
macroFrame {keyMacroBuffer :: Either [KM] KeyMacro
keyMacroBuffer = Either [KM] KeyMacro
buffer}
  in (KeyMacroFrame
smacroFrameNew, Text
msg)

-- * AllHistory

allHistoryHuman :: (MonadClient m, MonadClientUI m) => m ()
allHistoryHuman :: m ()
allHistoryHuman = Bool -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> m ()
eitherHistory Bool
True

eitherHistory :: forall m. (MonadClient 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
  UIOptions{Bool
uHistory1PerLine :: UIOptions -> Bool
uHistory1PerLine :: Bool
uHistory1PerLine} <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
  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
  FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
  let renderedHistoryRaw :: [AttrString]
renderedHistoryRaw = Bool -> History -> [AttrString]
renderHistory Bool
uHistory1PerLine History
history
      histBoundRaw :: X
histBoundRaw = [AttrString] -> X
forall a. [a] -> X
length [AttrString]
renderedHistoryRaw
      placeholderLine :: AttrString
placeholderLine = Color -> Text -> AttrString
textFgToAS Color
Color.BrBlack
        "Newest_messages_are_at_the_bottom._Press_END_to_get_there."
      placeholderCount :: X
placeholderCount =
        (- X
histBoundRaw X -> X -> X
forall a. Integral a => a -> a -> a
`mod` (X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 4)) X -> X -> X
forall a. Integral a => a -> a -> a
`mod` (X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 4)
      renderedHistory :: [AttrString]
renderedHistory = X -> AttrString -> [AttrString]
forall a. X -> a -> [a]
replicate X
placeholderCount AttrString
placeholderLine
                        [AttrString] -> [AttrString] -> [AttrString]
forall a. [a] -> [a] -> [a]
++ [AttrString]
renderedHistoryRaw
      histBound :: X
histBound = X
placeholderCount X -> X -> X
forall a. Num a => a -> a -> a
+ X
histBoundRaw
      splitRow :: AttrString -> (AttrLine, (X, AttrLine))
splitRow as :: AttrString
as =
        let (spNo :: AttrString
spNo, spYes :: AttrString
spYes) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrCharW32
Color.spaceAttrW32) AttrString
as
            par1 :: AttrLine
par1 = case (AttrLine -> Bool) -> [AttrLine] -> [AttrLine]
forall a. (a -> Bool) -> [a] -> [a]
filter (AttrLine -> AttrLine -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrLine
emptyAttrLine) ([AttrLine] -> [AttrLine]) -> [AttrLine] -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ AttrString -> [AttrLine]
linesAttr AttrString
spYes of
              [] -> AttrLine
emptyAttrLine
              [l :: AttrLine
l] -> AttrLine
l
              ls :: [AttrLine]
ls -> AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ AttrString -> [AttrString] -> AttrString
forall a. [a] -> [[a]] -> [a]
intercalate [AttrCharW32
Color.spaceAttrW32]
                                   ([AttrString] -> AttrString) -> [AttrString] -> AttrString
forall a b. (a -> b) -> a -> b
$ (AttrLine -> AttrString) -> [AttrLine] -> [AttrString]
forall a b. (a -> b) -> [a] -> [b]
map AttrLine -> AttrString
attrLine [AttrLine]
ls
        in (AttrString -> AttrLine
attrStringToAL AttrString
spNo, (DisplayFont -> AttrString -> X
forall a. DisplayFont -> [a] -> X
textSize DisplayFont
monoFont AttrString
spNo, AttrLine
par1))
      (histLab :: [AttrLine]
histLab, histDesc :: [(X, AttrLine)]
histDesc) = [(AttrLine, (X, AttrLine))] -> ([AttrLine], [(X, AttrLine)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(AttrLine, (X, AttrLine))] -> ([AttrLine], [(X, AttrLine)]))
-> [(AttrLine, (X, AttrLine))] -> ([AttrLine], [(X, AttrLine)])
forall a b. (a -> b) -> a -> b
$ (AttrString -> (AttrLine, (X, AttrLine)))
-> [AttrString] -> [(AttrLine, (X, AttrLine))]
forall a b. (a -> b) -> [a] -> [b]
map AttrString -> (AttrLine, (X, AttrLine))
splitRow [AttrString]
renderedHistory
      rhLab :: EnumMap DisplayFont Overlay
rhLab = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay [AttrLine]
histLab
      rhDesc :: EnumMap DisplayFont Overlay
rhDesc = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(X, AttrLine)] -> Overlay
offsetOverlayX [(X, AttrLine)]
histDesc
      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, (PointUI, ButtonWidth))]
kxs = [ (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
sn, ( X -> X -> PointUI
PointUI 0 (SlotChar -> X
slotPrefix SlotChar
sn)
                         , DisplayFont -> X -> ButtonWidth
ButtonWidth DisplayFont
propFont 1000 ))
            | SlotChar
sn <- X -> [SlotChar] -> [SlotChar]
forall a. X -> [a] -> [a]
take X
histBound [SlotChar]
intSlots ]
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
msg
  let keysAllHistory :: [KM]
keysAllHistory =
        KM
K.returnKM
#ifndef USE_JSFILE
        KM -> [KM] -> [KM]
forall a. a -> [a] -> [a]
: Char -> KM
K.mkChar '.'
#endif
        KM -> [KM] -> [KM]
forall a. a -> [a] -> [a]
: [KM
K.escKM]
  Slideshow
okxs <- 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]
keysAllHistory
                             ((Overlay -> Overlay -> Overlay)
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) EnumMap DisplayFont Overlay
rhLab EnumMap DisplayFont Overlay
rhDesc, [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kxs)
  let maxIx :: X
maxIx = [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> X
forall a. [a] -> X
length ((OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
-> [OKX] -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b. (a, b) -> b
snd ([OKX] -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
-> [OKX] -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b. (a -> b) -> a -> b
$ Slideshow -> [OKX]
slideshow Slideshow
okxs) X -> X -> X
forall a. Num a => a -> a -> a
- 1
      menuName :: String
menuName = "history"
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
    SessionUI
sess {smenuIxMap :: Map String X
smenuIxMap = String -> X -> Map String X -> Map String X
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
menuName X
maxIx (Map String X -> Map String X) -> Map String X -> Map String X
forall a b. (a -> b) -> a -> b
$ SessionUI -> Map String X
smenuIxMap SessionUI
sess}
  let displayAllHistory :: m ()
displayAllHistory = do
        Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen String
menuName ColorMode
ColorFull Bool
False Slideshow
okxs [KM]
keysAllHistory
        case Either KM SlotChar
ekm of
          Left km :: KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> KM
K.mkChar '.' -> do
            let t :: Text
t = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (AttrString -> Text) -> [AttrString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (AttrString -> String) -> AttrString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrCharW32 -> Char) -> AttrString -> String
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> Char
Color.charFromW32)
                                    [AttrString]
renderedHistoryRaw
            String
path <- Text -> String -> m String
forall (m :: * -> *).
MonadClientRead m =>
Text -> String -> m String
dumpTextFile Text
t "history.txt"
            MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "All of history dumped to file" Text -> Text -> Text
<+> String -> Text
T.pack String
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
          Left km :: KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.escKM ->
            MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric "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 ->  -- click in any unused space
            MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric "Steady on."
          Right SlotChar{..} | Char
slotChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'a' ->
            X -> m ()
displayOneReport (X -> m ()) -> X -> m ()
forall a b. (a -> b) -> a -> b
$ X -> X -> X
forall a. Ord a => a -> a -> a
max 0 (X -> X) -> X -> X
forall a b. (a -> b) -> a -> b
$ X
slotPrefix X -> X -> X
forall a. Num a => a -> a -> a
- X
placeholderCount
          _ -> 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
      displayOneReport :: Int -> m ()
      displayOneReport :: X -> m ()
displayOneReport histSlot :: X
histSlot = do
        let timeReport :: AttrString
timeReport = case X -> [AttrString] -> [AttrString]
forall a. X -> [a] -> [a]
drop X
histSlot [AttrString]
renderedHistoryRaw of
              [] -> String -> AttrString
forall a. HasCallStack => String -> a
error (String -> AttrString) -> String -> AttrString
forall a b. (a -> b) -> a -> b
$ "" String -> X -> String
forall v. Show v => String -> v -> String
`showFailure` X
histSlot
              tR :: AttrString
tR : _ -> AttrString
tR
            ov0 :: EnumMap DisplayFont Overlay
ov0 =
              let (spNo :: AttrString
spNo, spYes :: AttrString
spYes) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrCharW32
Color.spaceAttrW32) AttrString
timeReport
                  lenNo :: X
lenNo = DisplayFont -> AttrString -> X
forall a. DisplayFont -> [a] -> X
textSize DisplayFont
monoFont AttrString
spNo
                  spYesX :: [(X, AttrLine)]
spYesX = case X -> X -> AttrString -> [AttrLine]
splitAttrString (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- X
lenNo X -> X -> X
forall a. Num a => a -> a -> a
- 1) X
rwidth
                                                AttrString
spYes of
                    [] -> []
                    l :: AttrLine
l : ls :: [AttrLine]
ls ->
                      ( X
lenNo
                      , AttrString -> AttrLine
firstParagraph (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ AttrCharW32
Color.spaceAttrW32 AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: AttrLine -> AttrString
attrLine AttrLine
l )
                      (X, AttrLine) -> [(X, AttrLine)] -> [(X, AttrLine)]
forall a. a -> [a] -> [a]
: (AttrLine -> (X, AttrLine)) -> [AttrLine] -> [(X, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (0,) [AttrLine]
ls
              in (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
monoFont
                               ([AttrLine] -> Overlay
offsetOverlay [AttrString -> AttrLine
attrStringToAL AttrString
spNo])
                 (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(X, AttrLine)] -> Overlay
offsetOverlayX [(X, AttrLine)]
spYesX
            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
              , "most recent record 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
histBoundRaw X -> X -> X
forall a. Num a => a -> a -> a
- 1]
        MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric 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 (EnumMap DisplayFont Overlay
ov0, [])
        KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
(MonadClient 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 -> MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric "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 (X
histBoundRaw X -> X -> X
forall a. Num a => a -> a -> a
- 1)

-- * LastHistory

lastHistoryHuman :: (MonadClient m, MonadClientUI m) => m ()
lastHistoryHuman :: m ()
lastHistoryHuman = Bool -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> m ()
eitherHistory Bool
False

-- * MarkVision

markVisionHuman :: MonadClientUI m => m ()
markVisionHuman :: m ()
markVisionHuman = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession SessionUI -> SessionUI
toggleMarkVision

-- * MarkSmell

markSmellHuman :: MonadClientUI m => m ()
markSmellHuman :: m ()
markSmellHuman = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession SessionUI -> SessionUI
toggleMarkSmell

-- * MarkSuspect

markSuspectHuman :: MonadClient m => m ()
markSuspectHuman :: m ()
markSuspectHuman = do
  -- @condBFS@ depends on the setting we change here.
  m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsAll
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient StateClient -> StateClient
cycleMarkSuspect

-- * MarkAnim

markAnimHuman :: MonadClient m => m ()
markAnimHuman :: m ()
markAnimHuman = do
  Bool
noAnim <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Bool) -> m Bool)
-> (StateClient -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (StateClient -> Maybe Bool) -> StateClient -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientOptions -> Maybe Bool
snoAnim (ClientOptions -> Maybe Bool)
-> (StateClient -> ClientOptions) -> StateClient -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli ->
    StateClient
cli {soptions :: ClientOptions
soptions = (StateClient -> ClientOptions
soptions StateClient
cli) {snoAnim :: Maybe Bool
snoAnim = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
noAnim}}

-- * OverrideTut

overrideTutHuman :: MonadClientUI m => m ()
overrideTutHuman :: m ()
overrideTutHuman = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession SessionUI -> SessionUI
cycleOverrideTut

-- * PrintScreen

printScreenHuman :: (MonadClient m, MonadClientUI m) => m ()
printScreenHuman :: m ()
printScreenHuman = do
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert "Screenshot printed."
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
printScreen

-- * Cancel

-- | End aiming mode, rejecting the current position.
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

-- * Accept

-- | Accept the current crosshair position as target, ending
-- aiming mode, if active.
acceptHuman :: (MonadClient m, MonadClientUI m) => m ()
acceptHuman :: m ()
acceptHuman = do
  m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
endAiming
  m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
endAimingMsg
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
clearAimMode

-- | End aiming mode, accepting the current position.
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 :: (MonadClient m, 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
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgActionAlert (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ case Maybe Text
mtargetMsg of
    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]

-- * DetailCycle

-- | Cycle detail level of aiming mode descriptions, starting up.
detailCycleHuman :: (MonadClient m, MonadClientUI m) => m ()
detailCycleHuman :: m ()
detailCycleHuman = do
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {saimMode :: Maybe AimMode
saimMode =
    (\aimMode :: AimMode
aimMode -> AimMode
aimMode {detailLevel :: DetailLevel
detailLevel = DetailLevel -> DetailLevel
detailCycle (DetailLevel -> DetailLevel) -> DetailLevel -> DetailLevel
forall a b. (a -> b) -> a -> b
$ AimMode -> DetailLevel
detailLevel AimMode
aimMode})
                 (AimMode -> AimMode) -> Maybe AimMode -> Maybe AimMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionUI -> Maybe AimMode
saimMode SessionUI
sess}
  m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook

detailCycle :: DetailLevel -> DetailLevel
detailCycle :: DetailLevel -> DetailLevel
detailCycle detail :: DetailLevel
detail = if DetailLevel
detail DetailLevel -> DetailLevel -> Bool
forall a. Eq a => a -> a -> Bool
== DetailLevel
forall a. Bounded a => a
maxBound then DetailLevel
forall a. Bounded a => a
minBound else DetailLevel -> DetailLevel
forall a. Enum a => a -> a
succ DetailLevel
detail

-- * ClearTargetIfItemClear

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
    Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI 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 :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook

-- | Perform look around in the current position of the xhair.
-- Does nothing outside aiming mode.
doLook :: (MonadClient m, 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
      [(MsgClassShow, Text)]
blurb <- LevelId -> Point -> m [(MsgClassShow, Text)]
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Point -> m [(MsgClassShow, Text)]
lookAtPosition LevelId
lidV Point
xhairPos
      ((MsgClassShow, Text) -> m ()) -> [(MsgClassShow, Text)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ((MsgClassShow -> Text -> m ()) -> (MsgClassShow, Text) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd) [(MsgClassShow, Text)]
blurb

-- * ItemClear

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}

-- * MoveXhair

-- | Move the xhair. Assumes aiming mode.
moveXhairHuman :: (MonadClient m, 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
  -- Not @ScreenContent@, because not drawing here.
  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
    Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
    m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook
    MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- * AimTgt

-- | Start aiming.
aimTgtHuman :: (MonadClient m, MonadClientUI m) => m ()
aimTgtHuman :: m ()
aimTgtHuman = do
  -- (Re)start aiming at the current level.
  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 =
    let newDetail :: DetailLevel
newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel (SessionUI -> Maybe AimMode
saimMode SessionUI
sess)
    in AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> DetailLevel -> AimMode
AimMode LevelId
lidV DetailLevel
newDetail}
  m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptAction "*flinging started; press again to project*"

-- * AimFloor

-- | Cycle aiming mode. Do not change position of the xhair,
-- switch among things at that position.
aimFloorHuman :: (MonadClient m, 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 ->  -- first key press: keep target
          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{} ->
          -- If many actors, we pick here the first that would be picked
          -- by '*', so that all other projectiles on the tile come next,
          -- when pressing '*', without any intervening actors from other tiles.
          -- This is why we use @actorAssocs@ above instead of @posToAidAssocs@.
          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 =
    let newDetail :: DetailLevel
newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
    in AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> DetailLevel -> AimMode
AimMode LevelId
lidV DetailLevel
newDetail}
  Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
  m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook

-- * AimEnemy

aimEnemyHuman :: (MonadClient m, 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 -- On the same position, big actors come before projectiles.
      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 =  -- switch to the actor under xhair, if any
        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 ->  -- pick next enemy
          (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) ->  -- first key press, retarget old enemy
          (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 ->  -- pick next non-enemy
          (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) ->  -- first key press, retarget old non-enemy
          (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  -- no seen foes in sight, stick to last target
  -- Register the chosen enemy, to pick another on next invocation.
  (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 =
    let newDetail :: DetailLevel
newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
    in AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> DetailLevel -> AimMode
AimMode LevelId
lidV DetailLevel
newDetail}
  Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
  m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook

-- * AimItem

aimItemHuman :: (MonadClient m, MonadClientUI m) => m ()
aimItemHuman :: m ()
aimItemHuman = 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
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
  Level{ItemFloor
lfloor :: Level -> ItemFloor
lfloor :: ItemFloor
lfloor} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lidV
  Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side
  -- Don't consider own stash an ordinary pile of items.
  let lfloorBarStash :: ItemFloor
lfloorBarStash = case Maybe (LevelId, Point)
mstash of
        Just (lid :: LevelId
lid, pos :: Point
pos) | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV -> Point -> ItemFloor -> ItemFloor
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete Point
pos ItemFloor
lfloor
        _ -> ItemFloor
lfloor
      bsAll :: [Point]
bsAll = ItemFloor -> [Point]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemFloor
lfloorBarStash
      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 =  -- switch to the item under xhair, if any
        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 ->  -- pick next item
            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 ->  -- first key press, retarget old item
            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  -- don't force AI to collect it
        [] -> Maybe Target
xhair  -- no items remembered, stick to last target
  -- Register the chosen enemy, to pick another on next invocation.
  (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 =
    let newDetail :: DetailLevel
newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
    in AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> DetailLevel -> AimMode
AimMode LevelId
lidV DetailLevel
newDetail}
  Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
  m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook

-- * AimAscend

-- | Change the displayed level in aiming mode to (at most)
-- k levels shallower. Enters aiming mode, if not already in one.
aimAscendHuman :: (MonadClient m, MonadClientUI m) => Int -> m MError
aimAscendHuman :: X -> m MError
aimAscendHuman k :: X
k = do
  Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  let up :: Bool
up = X
k X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0
  case Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch Dungeon
dungeon Bool
up LevelId
lidV of
    [] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "no more levels in this direction"
    _ : _ -> do
      let ascendOne :: LevelId -> LevelId
ascendOne lid :: LevelId
lid = case Dungeon -> Bool -> LevelId -> [LevelId]
ascendInBranch Dungeon
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 =
        let newDetail :: DetailLevel
newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel (SessionUI -> Maybe AimMode
saimMode SessionUI
sess)
        in AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> DetailLevel -> AimMode
AimMode LevelId
lidK DetailLevel
newDetail}
      Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
      m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook
      MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- * EpsIncr

-- | Tweak the @eps@ parameter of the aiming digital line.
epsIncrHuman :: (MonadClient m, MonadClientUI m) => Direction -> m ()
epsIncrHuman :: Direction -> m ()
epsIncrHuman d :: Direction
d = do
  -- Perform the change:
  let sepsDelta :: X
sepsDelta = case Direction
d of
        Forward -> 1
        Backward -> -1
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli -> StateClient
cli {seps :: X
seps = StateClient -> X
seps StateClient
cli X -> X -> X
forall a. Num a => a -> a -> a
+ X
sepsDelta}
  m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsPathAll
  -- Provide UI feedback:
  -- Hack @sreportNull@ to display the new line even if no earlier messages.
  (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 {sreportNull :: Bool
sreportNull = Bool
False}
  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 =
    let newDetail :: DetailLevel
newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
DetailLow AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
    in AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> DetailLevel -> AimMode
AimMode LevelId
lidV DetailLevel
newDetail}
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
flashAiming
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: Maybe AimMode
saimMode}
  -- The change may not affect the line shape, hence 'possibly'.
  MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptAction "Aiming line (possibly) modified."

-- Flash the aiming line and path.
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

-- * XhairUnknown

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
      Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
      m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook
      MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- * XhairItem

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 ItemQuant))]
items <- ActorId -> m [(X, (Point, EnumMap ItemId ItemQuant))]
forall (m :: * -> *).
MonadClient m =>
ActorId -> m [(X, (Point, EnumMap ItemId ItemQuant))]
closestItems ActorId
leader
  case [(X, (Point, EnumMap ItemId ItemQuant))]
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 ItemQuant
bag)) = ((X, (Point, EnumMap ItemId ItemQuant))
 -> (X, (Point, EnumMap ItemId ItemQuant)) -> Ordering)
-> [(X, (Point, EnumMap ItemId ItemQuant))]
-> (X, (Point, EnumMap ItemId ItemQuant))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((X, (Point, EnumMap ItemId ItemQuant)) -> X)
-> (X, (Point, EnumMap ItemId ItemQuant))
-> (X, (Point, EnumMap ItemId ItemQuant))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (X, (Point, EnumMap ItemId ItemQuant)) -> X
forall a b. (a, b) -> a
fst) [(X, (Point, EnumMap ItemId ItemQuant))]
items
          sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint (EnumMap ItemId ItemQuant -> TGoal
TItem EnumMap ItemId ItemQuant
bag) (Actor -> LevelId
blid Actor
b) Point
p
      Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
      m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook
      MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- * XhairStair

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 ItemQuant)))]
stairs <- FleeViaStairsOrEscape
-> ActorId -> m [(X, (Point, (Point, EnumMap ItemId ItemQuant)))]
forall (m :: * -> *).
MonadClient m =>
FleeViaStairsOrEscape
-> ActorId -> m [(X, (Point, (Point, EnumMap ItemId ItemQuant)))]
closestTriggers (if Bool
up then FleeViaStairsOrEscape
ViaStairsUp else FleeViaStairsOrEscape
ViaStairsDown) ActorId
leader
  case [(X, (Point, (Point, EnumMap ItemId ItemQuant)))]
stairs of
    [] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ "no reachable stairs" Text -> Text -> Text
<+> if Bool
up then "up" else "down"
    _ -> do
      let (_, (p :: Point
p, (p0 :: Point
p0, bag :: EnumMap ItemId ItemQuant
bag))) = ((X, (Point, (Point, EnumMap ItemId ItemQuant)))
 -> (X, (Point, (Point, EnumMap ItemId ItemQuant))) -> Ordering)
-> [(X, (Point, (Point, EnumMap ItemId ItemQuant)))]
-> (X, (Point, (Point, EnumMap ItemId ItemQuant)))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((X, (Point, (Point, EnumMap ItemId ItemQuant))) -> X)
-> (X, (Point, (Point, EnumMap ItemId ItemQuant)))
-> (X, (Point, (Point, EnumMap ItemId ItemQuant)))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (X, (Point, (Point, EnumMap ItemId ItemQuant))) -> X
forall a b. (a, b) -> a
fst) [(X, (Point, (Point, EnumMap ItemId ItemQuant)))]
stairs
          sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint (EnumMap ItemId ItemQuant -> Point -> TGoal
TEmbed EnumMap ItemId ItemQuant
bag Point
p0) (Actor -> LevelId
blid Actor
b) Point
p
      Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
      m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook
      MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- * XhairPointerFloor

xhairPointerFloorHuman :: (MonadClient m, 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 :: * -> *). (MonadClient m, MonadClientUI m) => m ()
aimPointerFloorHuman
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: Maybe AimMode
saimMode}

-- * XhairPointerMute

xhairPointerMuteHuman :: (MonadClient m, MonadClientUI m) => m ()
xhairPointerMuteHuman :: m ()
xhairPointerMuteHuman = 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 ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> m ()
aimPointerFloorLoud Bool
False
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: Maybe AimMode
saimMode}

-- * XhairPointerEnemy

xhairPointerEnemyHuman :: (MonadClient m, 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 :: * -> *). (MonadClient m, MonadClientUI m) => m ()
aimPointerEnemyHuman
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: Maybe AimMode
saimMode}

-- * AimPointerFloor

aimPointerFloorHuman :: (MonadClient m, MonadClientUI m) => m ()
aimPointerFloorHuman :: m ()
aimPointerFloorHuman = Bool -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> m ()
aimPointerFloorLoud Bool
True

aimPointerFloorLoud :: (MonadClient m, MonadClientUI m) => Bool -> m ()
aimPointerFloorLoud :: Bool -> m ()
aimPointerFloorLoud loud :: Bool
loud = 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
  -- Not @ScreenContent@, because not drawing here.
  PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
  let p :: Point
p@(Point px :: X
px py :: X
py) = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
  if X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& X
py 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 -> 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
p
        sxhairMoused :: Bool
sxhairMoused = Maybe Target
sxhair Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
oldXhair
        detailSucc :: AimMode -> DetailLevel
detailSucc = if Bool
sxhairMoused
                     then AimMode -> DetailLevel
detailLevel
                     else DetailLevel -> DetailLevel
detailCycle (DetailLevel -> DetailLevel)
-> (AimMode -> DetailLevel) -> AimMode -> DetailLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AimMode -> DetailLevel
detailLevel
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
      SessionUI
sess { saimMode :: Maybe AimMode
saimMode =
               let newDetail :: DetailLevel
newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailSucc
                                     (SessionUI -> Maybe AimMode
saimMode SessionUI
sess)
               in AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> DetailLevel -> AimMode
AimMode LevelId
lidV DetailLevel
newDetail
           , Bool
sxhairMoused :: Bool
sxhairMoused :: Bool
sxhairMoused }
    Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
loud m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook
  else m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
stopPlayBack

-- * AimPointerEnemy

aimPointerEnemyHuman :: (MonadClient m, 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
  -- Not @ScreenContent@, because not drawing here.
  PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
  let p :: Point
p@(Point px :: X
px py :: X
py) = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
  if X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& X
py 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 -> 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 sxhair :: Maybe Target
sxhair =
          -- If many actors, we pick here the first that would be picked
          -- by '*', so that all other projectiles on the tile come next,
          -- when pressing '*', without any intervening actors from other tiles.
          -- This is why we use @actorAssocs@ above instead of @posToAidAssocs@.
          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
p) [(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
p
        sxhairMoused :: Bool
sxhairMoused = Maybe Target
sxhair Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
oldXhair
        detailSucc :: AimMode -> DetailLevel
detailSucc = if Bool
sxhairMoused
                     then AimMode -> DetailLevel
detailLevel
                     else DetailLevel -> DetailLevel
detailCycle (DetailLevel -> DetailLevel)
-> (AimMode -> DetailLevel) -> AimMode -> DetailLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AimMode -> DetailLevel
detailLevel
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
      SessionUI
sess { saimMode :: Maybe AimMode
saimMode =
               let newDetail :: DetailLevel
newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailSucc
                                     (SessionUI -> Maybe AimMode
saimMode SessionUI
sess)
               in AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> DetailLevel -> AimMode
AimMode LevelId
lidV DetailLevel
newDetail
           , Bool
sxhairMoused :: Bool
sxhairMoused :: Bool
sxhairMoused }
    Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
    m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
doLook
  else m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
stopPlayBack