-- | 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
  , pointmanCycleHuman, pointmanCycleLevelHuman
  , selectActorHuman, selectNoneHuman, selectWithPointerHuman
  , repeatHuman, repeatHumanTransition
  , repeatLastHuman, repeatLastHumanTransition
  , recordHuman, recordHumanTransition, allHistoryHuman
  , 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, projectCheck
  , posFromXhair, permittedApplyClient, endAiming, endAimingMsg
  , flashAiming
#endif
    -- * Operations both internal and used in unit tests
  , permittedProjectClient, xhairLegalEps
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

import           Game.LambdaHack.Client.BfsM
import           Game.LambdaHack.Client.CommonM
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.ActorUI
import           Game.LambdaHack.Client.UI.Animation
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.DrawM
import           Game.LambdaHack.Client.UI.EffectDescription
import           Game.LambdaHack.Client.UI.Frame
import           Game.LambdaHack.Client.UI.FrameM
import           Game.LambdaHack.Client.UI.HandleHelperM
import qualified Game.LambdaHack.Client.UI.HumanCmd as HumanCmd
import           Game.LambdaHack.Client.UI.InventoryM
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.MonadClientUI
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.MsgM
import           Game.LambdaHack.Client.UI.Overlay
import           Game.LambdaHack.Client.UI.PointUI
import           Game.LambdaHack.Client.UI.SessionUI
import           Game.LambdaHack.Client.UI.Slideshow
import           Game.LambdaHack.Client.UI.SlideshowM
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.ClientOptions
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.FactionKind as FK
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.ModeKind as MK
import           Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import           Game.LambdaHack.Definition.Defs

-- * Macro

macroHuman :: MonadClientUI m => [String] -> m ()
macroHuman :: forall (m :: * -> *). MonadClientUI m => [String] -> m ()
macroHuman [String]
ks = do
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess ->
    let kms :: [KM]
kms = String -> KM
K.mkKM (String -> KM) -> [String] -> [KM]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ks
        (KeyMacroFrame
smacroFrameNew, [KeyMacroFrame]
smacroStackMew) =
           [KM]
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
macroHumanTransition [KM]
kms (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) (SessionUI -> [KeyMacroFrame]
smacroStack SessionUI
sess)
    in SessionUI
sess { smacroFrame = smacroFrameNew
            , smacroStack = smacroStackMew }
  MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgMacroOperation (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Macro activated:" Text -> Text -> Text
<+> String -> Text
T.pack ([String] -> String
unwords [String]
ks)

-- | 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 [KM]
kms KeyMacroFrame
macroFrame [KeyMacroFrame]
macroFrames =
  let smacroFrameNew :: KeyMacroFrame
smacroFrameNew = KeyMacroFrame
emptyMacroFrame {keyPending = KeyMacro kms}
  in (KeyMacroFrame
smacroFrameNew, KeyMacroFrame
macroFrame KeyMacroFrame -> [KeyMacroFrame] -> [KeyMacroFrame]
forall a. a -> [a] -> [a]
: [KeyMacroFrame]
macroFrames)

-- * ChooseItem

-- | Display items from a given container store and possibly let the user
-- chose one.
chooseItemHuman :: MonadClientUI m => ActorId -> ItemDialogMode -> m MError
chooseItemHuman :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> ItemDialogMode -> m MError
chooseItemHuman ActorId
leader ItemDialogMode
c =
  (FailError -> MError)
-> (ActorId -> MError) -> Either FailError ActorId -> MError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FailError -> MError
forall a. a -> Maybe a
Just (MError -> ActorId -> MError
forall a b. a -> b -> a
const MError
forall a. Maybe a
Nothing) (Either FailError ActorId -> MError)
-> m (Either FailError ActorId) -> m MError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False ItemDialogMode
c

chooseItemDialogModeLore :: forall m . MonadClientUI m
                         => m (Maybe ResultItemDialogMode)
chooseItemDialogModeLore :: forall (m :: * -> *).
MonadClientUI m =>
m (Maybe ResultItemDialogMode)
chooseItemDialogModeLore = do
  schosenLoreOld <- (SessionUI -> ChosenLore) -> m ChosenLore
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChosenLore
schosenLore
  (inhabitants, embeds) <- case schosenLoreOld of
    ChosenLore [(ActorId, Actor)]
inh [(ItemId, ItemQuant)]
emb -> ([(ActorId, Actor)], [(ItemId, ItemQuant)])
-> m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ActorId, Actor)]
inh, [(ItemId, ItemQuant)]
emb)
    ChosenLore
ChosenNothing -> m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
forall (m :: * -> *).
MonadClientUI m =>
m ([(ActorId, Actor)], [(ItemId, ItemQuant)])
computeChosenLore
  bagHuge <- getsState $ EM.map (const quantSingle) . sitemD
  itemToF <- getsState $ flip itemToFull
  ItemRoles itemRoles <- getsSession sroles
  let rlore :: ItemId -> SLore -> ChosenLore -> m (Maybe ResultItemDialogMode)
      rlore ItemId
iid SLore
slore ChosenLore
schosenLore = do
        let itemRole :: EnumSet ItemId
itemRole = EnumMap SLore (EnumSet ItemId)
itemRoles EnumMap SLore (EnumSet ItemId) -> SLore -> EnumSet ItemId
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore
            bagAll :: EnumMap ItemId ItemQuant
bagAll = (ItemId -> ItemQuant -> Bool)
-> EnumMap ItemId ItemQuant -> EnumMap ItemId ItemQuant
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey (\ItemId
iid2 ItemQuant
_ -> ItemId
iid2 ItemId -> EnumSet ItemId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet ItemId
itemRole)
                                      EnumMap ItemId ItemQuant
bagHuge
        (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {schosenLore}
        let iids :: [(ItemId, ItemQuant)]
iids = (ItemId -> ItemFull)
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
sortIids ItemId -> ItemFull
itemToF ([(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)])
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId ItemQuant -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ItemId ItemQuant
bagAll
            slot :: MenuSlot
slot = Int -> MenuSlot
forall a. Enum a => Int -> a
toEnum (Int -> MenuSlot) -> Int -> MenuSlot
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"" String -> (ItemId, [(ItemId, ItemQuant)]) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemId
iid, [(ItemId, ItemQuant)]
iids))
                          (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ItemId -> [ItemId] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex ItemId
iid ([ItemId] -> Maybe Int) -> [ItemId] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemQuant) -> ItemId)
-> [(ItemId, ItemQuant)] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, ItemQuant) -> ItemId
forall a b. (a, b) -> a
fst [(ItemId, ItemQuant)]
iids
        Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode))
-> Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ResultItemDialogMode -> Maybe ResultItemDialogMode
forall a. a -> Maybe a
Just (ResultItemDialogMode -> Maybe ResultItemDialogMode)
-> ResultItemDialogMode -> Maybe ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ SLore -> MenuSlot -> [(ItemId, ItemQuant)] -> ResultItemDialogMode
RLore SLore
slore MenuSlot
slot [(ItemId, ItemQuant)]
iids
  case inhabitants of
    (ActorId
_, Actor
b) : [(ActorId, Actor)]
rest -> do
      let iid :: ItemId
iid = Actor -> ItemId
btrunk Actor
b
      arItem <- (State -> AspectRecord) -> m AspectRecord
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid
      let slore | 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
      rlore iid slore (ChosenLore rest embeds)
    [] ->
      case [(ItemId, ItemQuant)]
embeds of
        (ItemId
iid, ItemQuant
_) : [(ItemId, ItemQuant)]
rest -> do
          let slore :: SLore
slore = SLore
SEmbed
          ItemId -> SLore -> ChosenLore -> m (Maybe ResultItemDialogMode)
rlore ItemId
iid SLore
slore ([(ActorId, Actor)] -> [(ItemId, ItemQuant)] -> ChosenLore
ChosenLore [(ActorId, Actor)]
inhabitants [(ItemId, ItemQuant)]
rest)
        [] -> do
          (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {schosenLore = ChosenNothing}
          Maybe ResultItemDialogMode -> m (Maybe ResultItemDialogMode)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ResultItemDialogMode
forall a. Maybe a
Nothing

chooseItemDialogMode :: forall m. MonadClientUI m
                     => ActorId -> Bool -> ItemDialogMode
                     -> m (FailOrCmd ActorId)
chooseItemDialogMode :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader0 Bool
permitLoreCycle ItemDialogMode
c = do
  CCUI{coscreen=ScreenContent{rwidth, rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  FontSetup{propFont} <- getFontSetup
  side <- getsClient sside
  fact <- getsState $ (EM.! side) . sfactionD
  (ggi, loreFound) <- do
    mggiLore <- if permitLoreCycle && c == MLore SItem
                then chooseItemDialogModeLore
                else return Nothing
    case mggiLore of
      Just ResultItemDialogMode
rlore -> (Either Text ResultItemDialogMode, Bool)
-> m (Either Text ResultItemDialogMode, Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right ResultItemDialogMode
rlore, Bool
True)
      Maybe ResultItemDialogMode
Nothing -> do
        ggi <- ActorId -> ItemDialogMode -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> ItemDialogMode -> m (Either Text ResultItemDialogMode)
getStoreItem ActorId
leader0 ItemDialogMode
c
        return (ggi, False)
  -- Pointman could have been changed in @getStoreItem@ above.
  mleader <- getsClient sleader
  -- When run inside a test, without mleader, assume leader not changed.
  let leader = ActorId -> Maybe ActorId -> ActorId
forall a. a -> Maybe a -> a
fromMaybe ActorId
leader0 Maybe ActorId
mleader
  recordHistory  -- item chosen, wipe out already shown msgs
  actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
  let meleeSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHurtMelee Skills
actorCurAndMaxSk
  bUI <- getsSession $ getActorUI leader
  case ggi of
    Right ResultItemDialogMode
result -> case ResultItemDialogMode
result of
      RStore CStore
fromCStore [ItemId
iid] -> do
        (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess ->
          SessionUI
sess {sitemSel = Just (iid, fromCStore, False)}
        Either FailError ActorId -> m (Either FailError ActorId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FailError ActorId -> m (Either FailError ActorId))
-> Either FailError ActorId -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ ActorId -> Either FailError ActorId
forall a b. b -> Either a b
Right ActorId
leader
      RStore{} -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> ResultItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ResultItemDialogMode
result
      ROwned ItemId
iid -> do
        found <- (State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, (Actor, CStore))])
 -> m [(ActorId, (Actor, CStore))])
-> (State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))]
forall a b. (a -> b) -> a -> b
$ ActorId
-> FactionId -> ItemId -> State -> [(ActorId, (Actor, CStore))]
findIid ActorId
leader FactionId
side ItemId
iid
        let (newAid, bestStore) = case leader `lookup` found of
              Just (Actor
_, CStore
store) -> (ActorId
leader, CStore
store)
              Maybe (Actor, CStore)
Nothing -> case [(ActorId, (Actor, CStore))]
found of
                (ActorId
aid, (Actor
_, CStore
store)) : [(ActorId, (Actor, CStore))]
_ -> (ActorId
aid, CStore
store)
                [] -> String -> (ActorId, CStore)
forall a. HasCallStack => String -> a
error (String -> (ActorId, CStore)) -> String -> (ActorId, CStore)
forall a b. (a -> b) -> a -> b
$ String
"" String -> ResultItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ResultItemDialogMode
result
        modifySession $ \SessionUI
sess ->
          SessionUI
sess {sitemSel = Just (iid, bestStore, False)}
        arena <- getArenaUI
        b2 <- getsState $ getActorBody newAid
        let banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
        if | newAid == leader -> return $ Right leader
           | blid b2 /= arena && banned ->
             failSer NoChangeDunLeader
           | otherwise -> do
             -- We switch leader only here, not when processing results
             -- of lore screens, because lore is only about inspecting items.
             --
             -- This is a bit too verbose in aiming mode, but verbosity
             -- here is good to turn player's attention to the switch.
             void $ pickLeader True newAid
             return $ Right newAid
      RLore SLore
slore MenuSlot
slot [(ItemId, ItemQuant)]
iids -> do
        let promptFun :: ItemId -> ItemFull -> Int -> Text
promptFun ItemId
_ ItemFull
itemFull Int
_ = case SLore
slore of
              SLore
SBody ->
                let blurb :: Part
blurb = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition
                               (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
                            then Part
"condition"
                            else Part
"organ"
                in [Part] -> Text
makeSentence [ActorUI -> Part
partActor ActorUI
bUI, Part
"is aware of" ,Part -> Part
MU.AW Part
blurb]
              SLore
_ ->
                [Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg (ActorUI -> Part
partActor ActorUI
bUI) Part
"remember"
                             , Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (SLore -> Text
headingSLore SLore
slore) ]
        schosenLore <- (SessionUI -> ChosenLore) -> m ChosenLore
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ChosenLore
schosenLore
        let lorePending = Bool
loreFound Bool -> Bool -> Bool
&& case ChosenLore
schosenLore of
              ChosenLore [] [] -> Bool
False
              ChosenLore
_ -> Bool
True
            renderOneItem =
              (ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> MenuSlot
-> m OKX
forall (m :: * -> *).
MonadClientUI m =>
(ItemId -> ItemFull -> Int -> Text)
-> Int
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
-> MenuSlot
-> m OKX
okxItemLoreMsg ItemId -> ItemFull -> Int -> Text
promptFun Int
meleeSkill (SLore -> ItemDialogMode
MLore SLore
slore) [(ItemId, ItemQuant)]
iids
            extraKeys = [Char -> KM
K.mkChar Char
'~' | Bool
lorePending]
            slotBound = [(ItemId, ItemQuant)] -> Int
forall a. [a] -> Int
length [(ItemId, ItemQuant)]
iids Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        km <- displayOneMenuItem renderOneItem extraKeys slotBound slot
        case K.key km of
          Key
K.Space -> do
            (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {schosenLore = ChosenNothing}
            ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False (SLore -> ItemDialogMode
MLore SLore
slore)
          K.Char Char
'~' -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
True ItemDialogMode
c
          Key
K.Esc -> do
            (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {schosenLore = ChosenNothing}
            Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
          Key
_ -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
      RSkills MenuSlot
slot0 -> do
        -- This can be used in the future, e.g., to increase stats from
        -- level-up stat points, so let's keep it even if it shows
        -- no extra info compared to right pane display in menu.
        let renderOneItem :: MenuSlot -> m OKX
renderOneItem MenuSlot
slot = do
              (prompt2, attrString) <- ActorId -> MenuSlot -> m (Text, AttrString)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> MenuSlot -> m (Text, AttrString)
skillCloseUp ActorId
leader MenuSlot
slot
              let ov0 = DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont
                        (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
                        ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth AttrString
attrString
              msgAdd MsgPromptGeneric prompt2
              return (ov0, [])
            extraKeys :: [a]
extraKeys = []
            slotBound :: Int
slotBound = [Skill] -> Int
forall a. [a] -> Int
length [Skill]
skillsInDisplayOrder Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        km <- (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
forall a. [a]
extraKeys Int
slotBound MenuSlot
slot0
        case K.key km of
          Key
K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False ItemDialogMode
MSkills
          Key
K.Esc -> Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
          Key
_ -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
      RPlaces MenuSlot
slot0 -> do
        COps{coplace} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
        soptions <- getsClient soptions
        -- This is computed just once for the whole series of up and down arrow
        -- navigations, avoid quadratic blowup.
        places <- getsState $ EM.assocs
                              . placesFromState coplace (sexposePlaces soptions)
        let renderOneItem MenuSlot
slot = do
              (prompt2, blurbs) <-
                [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Bool -> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
forall (m :: * -> *).
MonadClientUI m =>
[(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
-> Bool -> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
placeCloseUp [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places (ClientOptions -> Bool
sexposePlaces ClientOptions
soptions) MenuSlot
slot
              let splitText = Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth
                  ov0 = [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap
                        ([(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay)
-> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ ((DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map (([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([AttrString] -> [AttrLine])
 -> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> ([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString])
-> (DisplayFont, [AttrLine])
forall a b. (a -> b) -> a -> b
$ (AttrString -> [AttrLine]) -> [AttrString] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AttrString -> [AttrLine]
splitText) [(DisplayFont, [AttrString])]
blurbs
              msgAdd MsgPromptGeneric prompt2
              return (ov0, [])
            extraKeys = []
            slotBound = [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))] -> Int
forall a. [a] -> Int
length [(ContentId PlaceKind, (EnumSet LevelId, Int, Int, Int))]
places Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        km <- displayOneMenuItem renderOneItem extraKeys slotBound slot0
        case K.key km of
          Key
K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False ItemDialogMode
MPlaces
          Key
K.Esc -> Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
          Key
_ -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
      RFactions MenuSlot
slot0 -> do
        sroles <- (SessionUI -> ItemRoles) -> m ItemRoles
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemRoles
sroles
        factions <- getsState $ factionsFromState sroles
        let renderOneItem MenuSlot
slot = do
              (prompt2, blurbs) <- [(FactionId, Faction)]
-> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
forall (m :: * -> *).
MonadClientUI m =>
[(FactionId, Faction)]
-> MenuSlot -> m (Text, [(DisplayFont, [AttrString])])
factionCloseUp [(FactionId, Faction)]
factions MenuSlot
slot
              let splitText = Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth
                  ov0 = [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap
                        ([(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay)
-> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ ((DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> [(DisplayFont, [AttrString])] -> [(DisplayFont, [AttrLine])]
forall a b. (a -> b) -> [a] -> [b]
map (([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([AttrString] -> [AttrLine])
 -> (DisplayFont, [AttrString]) -> (DisplayFont, [AttrLine]))
-> ([AttrString] -> [AttrLine])
-> (DisplayFont, [AttrString])
-> (DisplayFont, [AttrLine])
forall a b. (a -> b) -> a -> b
$ (AttrString -> [AttrLine]) -> [AttrString] -> [AttrLine]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AttrString -> [AttrLine]
splitText) [(DisplayFont, [AttrString])]
blurbs
              msgAdd MsgPromptGeneric prompt2
              return (ov0, [])
            extraKeys = []
            slotBound = [(FactionId, Faction)] -> Int
forall a. [a] -> Int
length [(FactionId, Faction)]
factions Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        km <- displayOneMenuItem renderOneItem extraKeys slotBound slot0
        case K.key km of
          Key
K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False ItemDialogMode
MFactions
          Key
K.Esc -> Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
          Key
_ -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
      RModes MenuSlot
slot0 -> do
        let displayOneMenuItemBig :: (MenuSlot -> m OKX)
                                  -> [K.KM] -> Int -> MenuSlot
                                  -> m K.KM
            displayOneMenuItemBig :: (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItemBig MenuSlot -> m OKX
renderOneItem [KM]
extraKeys Int
slotBound MenuSlot
slot = do
              let keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM]
                         [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
                         [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
slotBound]
                         [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM]
extraKeys
              okx <- MenuSlot -> m OKX
renderOneItem MenuSlot
slot
              -- Here it differs from @displayOneMenuItem@,
              slides <- overlayToSlideshow rheight keys okx
              ekm2 <- displayChoiceScreen "" ColorFull True slides keys
              let km = (KM -> KM) -> (MenuSlot -> KM) -> KeyOrSlot -> KM
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either KM -> KM
forall a. a -> a
id (String -> MenuSlot -> KM
forall a. HasCallStack => String -> a
error (String -> MenuSlot -> KM) -> String -> MenuSlot -> KM
forall a b. (a -> b) -> a -> b
$ String
"" String -> KeyOrSlot -> String
forall v. Show v => String -> v -> String
`showFailure` KeyOrSlot
ekm2) KeyOrSlot
ekm2
              -- Here it stops differing.
              case K.key km of
                Key
K.Up -> (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItemBig MenuSlot -> m OKX
renderOneItem [KM]
extraKeys
                                              Int
slotBound (MenuSlot -> m KM) -> MenuSlot -> m KM
forall a b. (a -> b) -> a -> b
$ MenuSlot -> MenuSlot
forall a. Enum a => a -> a
pred MenuSlot
slot
                Key
K.Down -> (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItemBig MenuSlot -> m OKX
renderOneItem [KM]
extraKeys
                                                Int
slotBound (MenuSlot -> m KM) -> MenuSlot -> m KM
forall a b. (a -> b) -> a -> b
$ MenuSlot -> MenuSlot
forall a. Enum a => a -> a
succ MenuSlot
slot
                Key
_ -> KM -> m KM
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return KM
km
        COps{comode} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
        svictories <- getsSession svictories
        nxtChal <- getsClient snxtChal
          -- mark victories only for current difficulty
        let f ![(a, b)]
acc p
_p !a
i !b
a = (a
i, b
a) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
acc
            campaignModes = ContentData ModeKind
-> GroupName ModeKind
-> ([(ContentId ModeKind, ModeKind)]
    -> Int
    -> ContentId ModeKind
    -> ModeKind
    -> [(ContentId ModeKind, ModeKind)])
-> [(ContentId ModeKind, ModeKind)]
-> [(ContentId ModeKind, ModeKind)]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode GroupName ModeKind
MK.CAMPAIGN_SCENARIO [(ContentId ModeKind, ModeKind)]
-> Int
-> ContentId ModeKind
-> ModeKind
-> [(ContentId ModeKind, ModeKind)]
forall {a} {b} {p}. [(a, b)] -> p -> a -> b -> [(a, b)]
f []
            renderOneItem MenuSlot
slot = do
              let (ContentId ModeKind
gameModeId, ModeKind
gameMode) = [(ContentId ModeKind, ModeKind)]
campaignModes [(ContentId ModeKind, ModeKind)]
-> Int -> (ContentId ModeKind, ModeKind)
forall a. HasCallStack => [a] -> Int -> a
!! MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot
              ov0 <- Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
describeMode Bool
False ContentId ModeKind
gameModeId
              let victories = case ContentId ModeKind
-> EnumMap (ContentId ModeKind) (Map Challenge Int)
-> Maybe (Map Challenge Int)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ContentId ModeKind
gameModeId EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories of
                    Maybe (Map Challenge Int)
Nothing -> Int
0
                    Just Map Challenge Int
cm -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Challenge -> Map Challenge Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Challenge
nxtChal Map Challenge Int
cm)
                  verb = if Int
victories Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Part
"remember" else Part
"forsee"
                  prompt2 = [Part] -> Text
makeSentence
                    [ Part -> Part -> Part
MU.SubjectVerbSg Part
"you" Part
verb
                    , Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text
"the '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModeKind -> Text
MK.mname ModeKind
gameMode Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' adventure" ]
              msgAdd MsgPromptGeneric prompt2
              return (ov0, [])
            extraKeys = []
            slotBound = [(ContentId ModeKind, ModeKind)] -> Int
forall a. [a] -> Int
length [(ContentId ModeKind, ModeKind)]
campaignModes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        km <- displayOneMenuItemBig renderOneItem extraKeys slotBound slot0
        case K.key km of
          Key
K.Space -> ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (Either FailError ActorId)
chooseItemDialogMode ActorId
leader Bool
False ItemDialogMode
MModes
          Key
K.Esc -> Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
          Key
_ -> String -> m (Either FailError ActorId)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ActorId))
-> String -> m (Either FailError ActorId)
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
    Left Text
err -> Text -> m (Either FailError ActorId)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err

-- * ChooseItemProject

chooseItemProjectHuman :: forall m. (MonadClient m, MonadClientUI m)
                       => ActorId -> [HumanCmd.TriggerItem] -> m MError
chooseItemProjectHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> [TriggerItem] -> m MError
chooseItemProjectHuman ActorId
leader [TriggerItem]
ts = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  mstash <- getsState $ \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 = 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
CStash, CStore
CEqp]
      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, object1) = case ts of
        [] -> (Part
"aim", Part
"item")
        TriggerItem
tr : [TriggerItem]
_ -> (TriggerItem -> Part
HumanCmd.tiverb TriggerItem
tr, TriggerItem -> Part
HumanCmd.tiobject TriggerItem
tr)
      verb = [Part] -> Text
makePhrase [Part
verb1]
      triggerSyms = [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
  mpsuitReq <- psuitReq leader
  case mpsuitReq of
    -- If xhair aim invalid, no item is considered a (suitable) missile.
    Left Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err
    Right ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun -> do
      itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
      case itemSel of
        Just (ItemId
_, CStore
_, Bool
True) -> MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
        Just (ItemId
iid, CStore
fromCStore, Bool
False) -> do
          -- We don't validate vs @ts@ here, because player has selected
          -- this item, so he knows what he's doing (unless really absurd).
          itemFull <- (State -> ItemFull) -> m ItemFull
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
          bag <- getsState $ getBodyStoreBag b fromCStore
          case iid `EM.lookup` bag of
            Just ItemQuant
_ | Either ReqFailure (Point, Bool) -> Bool
forall a b. Either a b -> Bool
isRight (ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ItemFull
itemFull) ->
              -- The player knows what he's doing. We warn him about range
              -- and experimenting with unknown precious items is fine.
              MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
            Maybe ItemQuant
_ -> do
              (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {sitemSel = Nothing}
              ActorId -> [TriggerItem] -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> [TriggerItem] -> m MError
chooseItemProjectHuman ActorId
leader [TriggerItem]
ts
        Maybe (ItemId, CStore, Bool)
Nothing -> do
          let psuit :: m Suitability
psuit =
                Suitability -> m Suitability
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Suitability -> m Suitability) -> Suitability -> m Suitability
forall a b. (a -> b) -> a -> b
$ (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
SuitsSomething ((Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability)
-> (Maybe CStore -> ItemFull -> ItemQuant -> Bool) -> Suitability
forall a b. (a -> b) -> a -> b
$ \Maybe CStore
_ ItemFull
itemFull ItemQuant
_kit ->
                  -- Here the player does not explicitly pick an item,
                  -- so we may exclude precious unknown items, etc.
                  (ReqFailure -> Bool)
-> ((Point, Bool) -> Bool)
-> Either ReqFailure (Point, Bool)
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) (Point, Bool) -> Bool
forall a b. (a, b) -> b
snd (ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ItemFull
itemFull)
                  Bool -> Bool -> Bool
&& (String -> Bool
forall a. [a] -> Bool
null String
triggerSyms
                      Bool -> Bool -> Bool
|| ItemKind -> Char
IK.isymbol (ItemFull -> ItemKind
itemKind ItemFull
itemFull) Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
triggerSyms)
              prompt :: Text
prompt = [Part] -> Text
makePhrase [Part
"What", Part
object1, Part
"to"]
              promptGeneric :: Text
promptGeneric = Text
"What to"
          ggi <- ActorId
-> m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
getGroupItem ActorId
leader m Suitability
psuit Text
prompt Text
promptGeneric Text
verb Text
"fling"
                              [CStore]
stores
          case ggi of
            Right (CStore
fromCStore, ItemId
iid) -> do
              (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess ->
                SessionUI
sess {sitemSel = Just (iid, fromCStore, False)}
              MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
            Left Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err

permittedProjectClient :: MonadClientUI m
                       => ActorId -> m (ItemFull -> Either ReqFailure Bool)
permittedProjectClient :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (ItemFull -> Either ReqFailure Bool)
permittedProjectClient ActorId
leader = do
  actorCurAndMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
  b <- getsState $ getActorBody leader
  let skill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
actorCurAndMaxSk
      calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorCurAndMaxSk
  return $ permittedProject False skill calmE

projectCheck :: MonadClientUI m => ActorId -> Point -> m (Maybe ReqFailure)
projectCheck :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> m (Maybe ReqFailure)
projectCheck ActorId
leader Point
tpos = do
  COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  eps <- getsClient seps
  sb <- getsState $ getActorBody leader
  let lid = Actor -> LevelId
blid Actor
sb
      spos = Actor -> Point
bpos Actor
sb
  -- Not @ScreenContent@, because not drawing here.
  case bresenhamsLineAlgorithm eps spos tpos of
    Maybe [Point]
Nothing -> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectAimOnself
    Just [] -> String -> m (Maybe ReqFailure)
forall a. HasCallStack => String -> a
error (String -> m (Maybe ReqFailure)) -> String -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ String
"project from the edge of level"
                       String -> (Point, Point, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (Point
spos, Point
tpos, Actor
sb)
    Just (Point
pos : [Point]
_) -> do
      lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
      let t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos
      if not $ Tile.isWalkable coTileSpeedup t
        then return $ Just ProjectBlockTerrain
        else if occupiedBigLvl pos lvl
             then return $ Just ProjectBlockActor
             else return 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 => ActorId -> m (Either Text Int)
xhairLegalEps :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Either Text Int)
xhairLegalEps ActorId
leader = do
  cops@COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  b <- getsState $ getActorBody leader
  lidV <- viewedLevelUI
  let !_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
onlyFirst Point
pos = do
        lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
        oldEps <- getsClient seps
        return $! case makeLine onlyFirst b pos oldEps cops lvl of
          Just Int
newEps -> Int -> Either Text Int
forall a b. b -> Either a b
Right Int
newEps
          Maybe Int
Nothing -> Text -> Either Text Int
forall a b. a -> Either a b
Left (Text -> Either Text Int) -> Text -> Either Text Int
forall a b. (a -> b) -> a -> b
$ if Bool
onlyFirst
                            then Text
"aiming blocked at the first step"
                            else Text
"aiming line blocked somewhere"
  xhair <- getsSession sxhair
  case xhair of
    Maybe Target
Nothing -> Either Text Int -> m (Either Text Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> m (Either Text Int))
-> Either Text Int -> m (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Int
forall a b. a -> Either a b
Left Text
"no aim designated"
    Just (TEnemy ActorId
a) -> do
      body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
a
      let pos = Actor -> Point
bpos Actor
body
      if blid body == lidV
      then findNewEps False pos
      else return $ Left "can't fling at an enemy on remote level"
    Just (TNonEnemy ActorId
a) -> do
      body <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
a
      let pos = Actor -> Point
bpos Actor
body
      if blid body == lidV
      then findNewEps False pos
      else return $ Left "can't fling at a non-enemy on remote level"
    Just (TPoint TEnemyPos{} LevelId
_ Point
_) ->
      Either Text Int -> m (Either Text Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> m (Either Text Int))
-> Either Text Int -> m (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Int
forall a b. a -> Either a b
Left Text
"selected opponent not visible"
    Just (TPoint TGoal
_ LevelId
lid Point
pos) ->
      if LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV
      then Bool -> Point -> m (Either Text Int)
findNewEps Bool
True Point
pos  -- @True@ to help pierce many foes, etc.
      else Either Text Int -> m (Either Text Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> m (Either Text Int))
-> Either Text Int -> m (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Int
forall a b. a -> Either a b
Left Text
"can't fling at a target on remote level"
    Just (TVector Vector
v) -> do
      -- Not @ScreenContent@, because not drawing here.
      let shifted :: Point
shifted = Int -> Int -> Point -> Vector -> Point
shiftBounded Int
rWidthMax Int
rHeightMax (Actor -> Point
bpos Actor
b) Vector
v
      if Point
shifted Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b Bool -> Bool -> Bool
&& Vector
v Vector -> Vector -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Int -> Vector
Vector Int
0 Int
0
      then Either Text Int -> m (Either Text Int)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Int -> m (Either Text Int))
-> Either Text Int -> m (Either Text Int)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Int
forall a b. a -> Either a b
Left Text
"selected translation is void"
      else Bool -> Point -> m (Either Text Int)
findNewEps Bool
True Point
shifted  -- @True@, because the goal is vague anyway

posFromXhair :: (MonadClient m, MonadClientUI m)
             => ActorId -> m (Either Text Point)
posFromXhair :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m (Either Text Point)
posFromXhair ActorId
leader = do
  canAim <- ActorId -> m (Either Text Int)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (Either Text Int)
xhairLegalEps ActorId
leader
  case canAim of
    Right Int
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
$ \StateClient
cli -> StateClient
cli {seps = newEps}
      mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos
      case mxhairPos of
        Maybe Point
Nothing -> String -> m (Either Text Point)
forall a. HasCallStack => String -> a
error (String -> m (Either Text Point))
-> String -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ String
"" String -> Maybe Point -> String
forall v. Show v => String -> v -> String
`showFailure` Maybe Point
mxhairPos
        Just Point
pos -> do
          munit <- ActorId -> Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> m (Maybe ReqFailure)
projectCheck ActorId
leader Point
pos
          case munit of
            Maybe ReqFailure
Nothing -> Either Text Point -> m (Either Text Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Point -> m (Either Text Point))
-> Either Text Point -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ Point -> Either Text Point
forall a b. b -> Either a b
Right Point
pos
            Just ReqFailure
reqFail -> Either Text Point -> m (Either Text Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Point -> m (Either Text Point))
-> Either Text Point -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Point
forall a b. a -> Either a b
Left (Text -> Either Text Point) -> Text -> Either Text Point
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
reqFail
    Left Text
cause -> Either Text Point -> m (Either Text Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Point -> m (Either Text Point))
-> Either Text Point -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Point
forall a b. a -> Either a b
Left Text
cause

-- | 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)
         => ActorId
         -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq ActorId
leader = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  lidV <- viewedLevelUI
  if lidV /= blid b
  then return $ Left "can't fling on remote level"
  else do
    mpos <- posFromXhair leader
    p <- permittedProjectClient leader
    case mpos of
      Left Text
err -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (ItemFull -> Either ReqFailure (Point, Bool))
 -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool))))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
forall a b. a -> Either a b
Left Text
err
      Right Point
pos -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (ItemFull -> Either ReqFailure (Point, Bool))
 -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool))))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a b. (a -> b) -> a -> b
$ (ItemFull -> Either ReqFailure (Point, Bool))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
forall a b. b -> Either a b
Right ((ItemFull -> Either ReqFailure (Point, Bool))
 -> Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
-> (ItemFull -> Either ReqFailure (Point, Bool))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
forall a b. (a -> b) -> a -> b
$ \ItemFull
itemFull ->
        case ItemFull -> Either ReqFailure Bool
p ItemFull
itemFull of
          Left ReqFailure
err -> ReqFailure -> Either ReqFailure (Point, Bool)
forall a b. a -> Either a b
Left ReqFailure
err
          Right Bool
False -> (Point, Bool) -> Either ReqFailure (Point, Bool)
forall a b. b -> Either a b
Right (Point
pos, Bool
False)
          Right Bool
True ->
            let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            in (Point, Bool) -> Either ReqFailure (Point, Bool)
forall a b. b -> Either a b
Right (Point
pos, Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AspectRecord -> ItemKind -> Int
IA.totalRange AspectRecord
arItem (ItemFull -> ItemKind
itemKind ItemFull
itemFull)
                           Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) Point
pos)

-- $setup
-- >>> import Game.LambdaHack.Definition.DefsInternal

-- |
-- >>> let trigger1 = HumanCmd.TriggerItem{tiverb="verb", tiobject="object", tisymbols=[toContentSymbol 'a', toContentSymbol 'b']}
-- >>> let trigger2 = HumanCmd.TriggerItem{tiverb="verb2", tiobject="object2", tisymbols=[toContentSymbol 'c']}
-- >>> triggerSymbols [trigger1, trigger2]
-- "abc"
--
-- >>> triggerSymbols []
-- ""
triggerSymbols :: [HumanCmd.TriggerItem] -> [ContentSymbol IK.ItemKind]
triggerSymbols :: [TriggerItem] -> String
triggerSymbols [] = []
triggerSymbols (HumanCmd.TriggerItem{String
tisymbols :: String
tisymbols :: TriggerItem -> String
tisymbols} : [TriggerItem]
ts) =
  String
tisymbols String -> String -> String
forall a. [a] -> [a] -> [a]
++ [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts

-- * ChooseItemApply

chooseItemApplyHuman :: forall m. MonadClientUI m
                     => ActorId -> [HumanCmd.TriggerItem] -> m MError
chooseItemApplyHuman :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> [TriggerItem] -> m MError
chooseItemApplyHuman ActorId
leader [TriggerItem]
ts = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  mstash <- getsState $ \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 = 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
CStash, CStore
CEqp, CStore
COrgan]
      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, object1) = case ts of
        [] -> (Part
"trigger", Part
"item")
        TriggerItem
tr : [TriggerItem]
_ -> (TriggerItem -> Part
HumanCmd.tiverb TriggerItem
tr, TriggerItem -> Part
HumanCmd.tiobject TriggerItem
tr)
      verb = [Part] -> Text
makePhrase [Part
verb1]
      triggerSyms = [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
      prompt = [Part] -> Text
makePhrase [Part
"What", Part
object1, Part
"to"]
      promptGeneric = Text
"What to"
  itemSel <- getsSession sitemSel
  case itemSel of
    Just (ItemId
_, CStore
_, Bool
True) -> MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
    Just (ItemId
iid, CStore
fromCStore, Bool
False) -> do
      -- We don't validate vs @ts@ here, because player has selected
      -- this item, so he knows what he's doing (unless really absurd).
      itemFull <- (State -> ItemFull) -> m ItemFull
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
      bag <- getsState $ getBodyStoreBag b fromCStore
      mp <- permittedApplyClient leader
      case iid `EM.lookup` bag of
        Just ItemQuant
kit | Bool -> Either ReqFailure Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
mp (CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
fromCStore) ItemFull
itemFull ItemQuant
kit) ->
          MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
        Maybe ItemQuant
_ -> do
          (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {sitemSel = Nothing}
          ActorId -> [TriggerItem] -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> [TriggerItem] -> m MError
chooseItemApplyHuman ActorId
leader [TriggerItem]
ts
    Maybe (ItemId, CStore, Bool)
Nothing -> do
      let psuit :: m Suitability
          psuit :: m Suitability
psuit = do
            mp <- ActorId
-> m (Maybe CStore
      -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m (Maybe CStore
      -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
permittedApplyClient ActorId
leader
            return $ SuitsSomething $ \Maybe CStore
cstore ItemFull
itemFull ItemQuant
kit ->
              Bool -> Either ReqFailure Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False (Maybe CStore -> ItemFull -> ItemQuant -> Either ReqFailure Bool
mp Maybe CStore
cstore ItemFull
itemFull ItemQuant
kit)
              Bool -> Bool -> Bool
&& (String -> Bool
forall a. [a] -> Bool
null String
triggerSyms
                  Bool -> Bool -> Bool
|| ItemKind -> Char
IK.isymbol (ItemFull -> ItemKind
itemKind ItemFull
itemFull) Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
triggerSyms)
      ggi <- ActorId
-> m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
getGroupItem ActorId
leader m Suitability
psuit Text
prompt Text
promptGeneric Text
verb Text
"trigger"
                          [CStore]
stores
      case ggi of
        Right (CStore
fromCStore, ItemId
iid) -> do
          (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess ->
            SessionUI
sess {sitemSel = Just (iid, fromCStore, False)}
          MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
        Left Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err

permittedApplyClient :: MonadClientUI m
                     => ActorId
                     -> m (Maybe CStore -> ItemFull -> ItemQuant
                           -> Either ReqFailure Bool)
permittedApplyClient :: forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m (Maybe CStore
      -> ItemFull -> ItemQuant -> Either ReqFailure Bool)
permittedApplyClient ActorId
leader = do
  COps{corule} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  actorCurAndMaxSk <- getsState $ getActorMaxSkills leader
  b <- getsState $ getActorBody leader
  let skill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkApply Skills
actorCurAndMaxSk
      calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorCurAndMaxSk
  localTime <- getsState $ getLocalTime (blid b)
  return $ permittedApply corule localTime skill calmE

-- * PickLeader

pickLeaderHuman :: MonadClientUI m => Int -> m MError
pickLeaderHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m MError
pickLeaderHuman Int
k = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  fact <- getsState $ (EM.! side) . sfactionD
  arena <- getArenaUI
  sactorUI <- getsSession sactorUI
  mhero <- getsState $ tryFindHeroK sactorUI side k
  allOurs <- getsState $ fidActorNotProjGlobalAssocs side -- not only on level
  let allOursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ActorId
aid, Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
allOurs
      hs = ((ActorId, Actor, ActorUI)
 -> (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 = case Int -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. Int -> [a] -> [a]
drop Int
k [(ActorId, Actor, ActorUI)]
hs of
                 [] -> Maybe (ActorId, Actor)
forall a. Maybe a
Nothing
                 (ActorId
aid, Actor
b, ActorUI
_) : [(ActorId, Actor, ActorUI)]
_ -> (ActorId, Actor) -> Maybe (ActorId, Actor)
forall a. a -> Maybe a
Just (ActorId
aid, Actor
b)
      mchoice = if FactionKind -> Bool
FK.fhasGender (Faction -> FactionKind
gkind Faction
fact) then Maybe (ActorId, Actor)
mhero else Maybe (ActorId, Actor)
mactor
      banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels Faction
fact
  case mchoice of
    Maybe (ActorId, Actor)
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"no such member of the party"
    Just (ActorId
aid, Actor
b)
      | Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
arena Bool -> Bool -> Bool
&& Bool
banned ->
          Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg (Text -> m MError) -> Text -> m MError
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
NoChangeDunLeader
      | Bool
otherwise -> do
          m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
True ActorId
aid
          MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- * PickLeaderWithPointer

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

-- * PointmanCycle

-- | Switch current pointman to the next on the viewed level, if any, wrapping.
pointmanCycleLevelHuman :: MonadClientUI m => ActorId -> Direction -> m MError
pointmanCycleLevelHuman :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Direction -> m MError
pointmanCycleLevelHuman ActorId
leader = ActorId -> Bool -> Direction -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycleLevel ActorId
leader Bool
True

-- * PointmanBack

-- | Switch current pointman to the previous in the whole dungeon, wrapping.
pointmanCycleHuman :: MonadClientUI m => ActorId -> Direction -> m MError
pointmanCycleHuman :: forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Direction -> m MError
pointmanCycleHuman ActorId
leader = ActorId -> Bool -> Direction -> m MError
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Direction -> m MError
pointmanCycle ActorId
leader Bool
True

-- * SelectActor

selectActorHuman :: MonadClientUI m => ActorId -> m ()
selectActorHuman :: forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
selectActorHuman ActorId
leader = do
  bodyUI <- (SessionUI -> ActorUI) -> m ActorUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
  wasMemeber <- getsSession $ ES.member leader . sselected
  let 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
  modifySession $ \SessionUI
sess -> SessionUI
sess {sselected = upd $ sselected sess}
  let subject = ActorUI -> Part
partActor ActorUI
bodyUI
  msgAdd MsgActionAlert $ makeSentence [subject, if wasMemeber
                                                 then "deselected"
                                                 else "selected"]

-- * SelectNone

selectNoneHuman :: MonadClientUI m => m ()
selectNoneHuman :: forall (m :: * -> *). MonadClientUI m => m ()
selectNoneHuman = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  lidV <- viewedLevelUI
  oursIds <- getsState $ fidActorRegularIds side lidV
  let ours = [ActorId] -> EnumSet ActorId
forall k. Enum k => [k] -> EnumSet k
ES.fromDistinctAscList [ActorId]
oursIds
  oldSel <- getsSession sselected
  let 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 = 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
  modifySession $ \SessionUI
sess -> SessionUI
sess {sselected = upd (sselected sess) ours}
  let subject = Part
"all party members on the level"
  msgAdd MsgActionAlert $ makeSentence [subject, if wasNone
                                                 then "selected"
                                                 else "deselected"]

-- * SelectWithPointer

selectWithPointerHuman :: MonadClientUI m => m MError
selectWithPointerHuman :: forall (m :: * -> *). MonadClientUI m => m MError
selectWithPointerHuman = do
  COps{corule=RuleContent{rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  lidV <- viewedLevelUI
  -- Not @ScreenContent@, because not drawing here.
  side <- getsClient sside
  ours <- getsState $ filter (not . bproj . snd)
                      . actorAssocs (== side) lidV
  sactorUI <- getsSession sactorUI
  let oursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ActorId
aid, Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
ours
      viewed = ((ActorId, Actor, ActorUI)
 -> (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
  pUI <- getsSession spointer
  let p@(Point px py) = squareToMap $ uiToSquare pUI
  -- Select even if no space in status line for the actor's symbol.
  if | py == rHeightMax + 1 && px == 0 -> selectNoneHuman >> return Nothing
     | py == rHeightMax + 1 ->
         case drop (px - 1) viewed of
           [] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"not pointing at an actor"
           (ActorId
aid, Actor
_, ActorUI
_) : [(ActorId, Actor, ActorUI)]
_ -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
selectActorHuman ActorId
aid m () -> m MError -> m MError
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
     | otherwise ->
         case find (\(ActorId
_, Actor
b) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p) ours of
           Maybe (ActorId, Actor)
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"not pointing at an actor"
           Just (ActorId
aid, Actor
_) -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
selectActorHuman ActorId
aid m () -> m MError -> m MError
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- * 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 :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
repeatHuman Int
n =
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess ->
    let (KeyMacroFrame
smacroFrameNew, [KeyMacroFrame]
smacroStackMew) =
           Int
-> KeyMacroFrame
-> [KeyMacroFrame]
-> (KeyMacroFrame, [KeyMacroFrame])
repeatHumanTransition Int
n (SessionUI -> KeyMacroFrame
smacroFrame SessionUI
sess) (SessionUI -> [KeyMacroFrame]
smacroStack SessionUI
sess)
    in SessionUI
sess { smacroFrame = smacroFrameNew
            , smacroStack = smacroStackMew }

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

-- * 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 :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
repeatLastHuman Int
n = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess ->
  SessionUI
sess {smacroFrame = repeatLastHumanTransition n (smacroFrame sess) }

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

-- * Record

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

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

-- * AllHistory

allHistoryHuman :: forall m. MonadClientUI m => m ()
allHistoryHuman :: forall (m :: * -> *). MonadClientUI m => m ()
allHistoryHuman = do
  CCUI{coscreen=ScreenContent{rwidth, rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  history <- getsSession shistory
  arena <- getArenaUI
  localTime <- getsState $ getLocalTime arena
  global <- getsState stime
  FontSetup{..} <- getFontSetup
  let renderedHistoryRaw = History -> [AttrString]
renderHistory History
history
      histLenRaw = [AttrString] -> Int
forall a. [a] -> Int
length [AttrString]
renderedHistoryRaw
      placeholderLine = Color -> Text -> AttrString
textFgToAS Color
Color.BrBlack
        Text
"Newest_messages_are_at_the_bottom._Press_END_to_get_there."
      placeholderCount =
        (- Int
histLenRaw Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
      renderedHistory = Int -> AttrString -> [AttrString]
forall a. Int -> a -> [a]
replicate Int
placeholderCount AttrString
placeholderLine
                        [AttrString] -> [AttrString] -> [AttrString]
forall a. [a] -> [a] -> [a]
++ [AttrString]
renderedHistoryRaw
      histLen = Int
placeholderCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
histLenRaw
      splitRow AttrString
as =
        let (AttrString
tLab, AttrString
tDesc) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrCharW32
Color.spaceAttrW32) AttrString
as
            labLen :: Int
labLen = DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
monoFont AttrString
tLab
            par1 :: AttrLine
par1 = case (AttrLine -> Bool) -> [AttrLine] -> [AttrLine]
forall a. (a -> Bool) -> [a] -> [a]
filter (AttrLine -> AttrLine -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrLine
emptyAttrLine) ([AttrLine] -> [AttrLine]) -> [AttrLine] -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ AttrString -> [AttrLine]
linesAttr AttrString
tDesc of
              [] -> AttrLine
emptyAttrLine
              [AttrLine
l] -> AttrLine
l
              [AttrLine]
ls -> AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ AttrString -> [AttrString] -> AttrString
forall a. [a] -> [[a]] -> [a]
intercalate [AttrCharW32
Color.spaceAttrW32]
                                   ([AttrString] -> AttrString) -> [AttrString] -> AttrString
forall a b. (a -> b) -> a -> b
$ (AttrLine -> AttrString) -> [AttrLine] -> [AttrString]
forall a b. (a -> b) -> [a] -> [b]
map AttrLine -> AttrString
attrLine [AttrLine]
ls
        in (AttrString -> AttrLine
attrStringToAL AttrString
tLab, (Int
labLen, AttrLine
par1))
      (tsLab, tsDesc) = unzip $ map splitRow renderedHistory
      ovs = (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
monoFont ([AttrLine] -> Overlay
offsetOverlay [AttrLine]
tsLab)
            (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
tsDesc
      turnsGlobal = Time
global Time -> Time -> Int
`timeFitUp` Time
timeTurn
      turnsLocal = Time
localTime Time -> Time -> Int
`timeFitUp` Time
timeTurn
      msg = [Part] -> Text
makeSentence
        [ Part
"You survived for"
        , Int -> Part -> Part
MU.CarWs Int
turnsGlobal Part
"half-second turn"
        , Part
"(this level:"
        , Int -> Part
MU.Car Int
turnsLocal Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Part
")" ]
      kxs = [ (MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
sn, ( Int -> Int -> PointUI
PointUI Int
0 (MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
sn)
                         , DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
propFont Int
1000 ))
            | MenuSlot
sn <- Int -> [MenuSlot] -> [MenuSlot]
forall a. Int -> [a] -> [a]
take Int
histLen [MenuSlot]
natSlots ]
  msgAdd MsgPromptGeneric msg
  let keysAllHistory =
        KM
K.returnKM
#ifndef USE_JSFILE
        KM -> [KM] -> [KM]
forall a. a -> [a] -> [a]
: Char -> KM
K.mkChar Char
'.'
#endif
        KM -> [KM] -> [KM]
forall a. a -> [a] -> [a]
: [KM
K.spaceKM, KM
K.escKM]
  slides <- overlayToSlideshow (rheight - 2) keysAllHistory (ovs, kxs)
  let historyLines = case [KYX] -> [KYX]
forall a. [a] -> [a]
reverse ([KYX] -> [KYX]) -> [KYX] -> [KYX]
forall a b. (a -> b) -> a -> b
$ (OKX -> [KYX]) -> [OKX] -> [KYX]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OKX -> [KYX]
forall a b. (a, b) -> b
snd ([OKX] -> [KYX]) -> [OKX] -> [KYX]
forall a b. (a -> b) -> a -> b
$ Slideshow -> [OKX]
slideshow Slideshow
slides of
        (Left{}, (PointUI, ButtonWidth)
_) : [KYX]
rest -> [KYX]
rest  -- don't count the @--more--@ line
        [KYX]
l -> [KYX]
l
      maxIx = [KYX] -> Int
forall a. [a] -> Int
length [KYX]
historyLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [KM] -> Int
forall a. [a] -> Int
length [KM]
keysAllHistory
      menuName = String
"history"
  modifySession $ \SessionUI
sess ->
    SessionUI
sess {smenuIxMap = M.insert menuName maxIx $ smenuIxMap sess}
  let displayAllHistory = do
        ekm <- String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreen String
menuName ColorMode
ColorFull Bool
False Slideshow
slides
                                   [KM]
keysAllHistory
        case ekm of
          Left KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> KM
K.mkChar Char
'.' -> do
            let t :: Text
t = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (AttrString -> Text) -> [AttrString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (AttrString -> String) -> AttrString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttrCharW32 -> Char) -> AttrString -> String
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> Char
Color.charFromW32)
                                    [AttrString]
renderedHistoryRaw
            path <- Text -> String -> m String
forall (m :: * -> *).
MonadClientRead m =>
Text -> String -> m String
dumpTextFile Text
t String
"history.txt"
            msgAdd MsgPromptGeneric $ "All of history dumped to file" <+> T.pack path <> "."
          Left KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.escKM ->
            MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
"Try to survive a few seconds more, if you can."
          Left KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.spaceKM ->
            MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
"Steady on."
          Left KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.returnKM ->
            MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
"Press RET when history message selected to see it in full."
          Right MenuSlot
slot ->
            MenuSlot -> m ()
displayOneReport (MenuSlot -> m ()) -> MenuSlot -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MenuSlot
forall a. Enum a => Int -> a
toEnum (Int -> MenuSlot) -> Int -> MenuSlot
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
placeholderCount
          KeyOrSlot
_ -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> KeyOrSlot -> String
forall v. Show v => String -> v -> String
`showFailure` KeyOrSlot
ekm
      displayOneReport :: MenuSlot -> m ()
      displayOneReport MenuSlot
slot0 = do
        let renderOneItem :: MenuSlot -> m OKX
renderOneItem MenuSlot
slot = do
              let timeReport :: AttrString
timeReport = case Int -> [AttrString] -> [AttrString]
forall a. Int -> [a] -> [a]
drop (MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot)
                                         [AttrString]
renderedHistoryRaw of
                    [] -> String -> AttrString
forall a. HasCallStack => String -> a
error (String -> AttrString) -> String -> AttrString
forall a b. (a -> b) -> a -> b
$ String
"" String -> MenuSlot -> String
forall v. Show v => String -> v -> String
`showFailure` MenuSlot
slot
                    AttrString
tR : [AttrString]
_ -> AttrString
tR
                  markParagraph :: AttrCharW32 -> AttrString
markParagraph AttrCharW32
c | AttrCharW32 -> Char
Color.charFromW32 AttrCharW32
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = [AttrCharW32
c, AttrCharW32
c]
                  markParagraph AttrCharW32
c = [AttrCharW32
c]
                  reportWithParagraphs :: AttrString
reportWithParagraphs = (AttrCharW32 -> AttrString) -> AttrString -> AttrString
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AttrCharW32 -> AttrString
markParagraph AttrString
timeReport
                  (Overlay
ovLab, Overlay
ovDesc) =
                    DisplayFont -> Int -> AttrString -> (Overlay, Overlay)
labDescOverlay DisplayFont
monoFont Int
rwidth AttrString
reportWithParagraphs
                  ov0 :: EnumMap DisplayFont Overlay
ov0 = (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
monoFont Overlay
ovLab
                        (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont Overlay
ovDesc
                  prompt :: Text
prompt = [Part] -> Text
makeSentence
                    [ Part
"the", Int -> Part
MU.Ordinal (Int -> Part) -> Int -> Part
forall a b. (a -> b) -> a -> b
$ MenuSlot -> Int
forall a. Enum a => a -> Int
fromEnum MenuSlot
slot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    , Part
"most recent record follows" ]
              MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
prompt
              OKX -> m OKX
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay
ov0, [])
            extraKeys :: [a]
extraKeys = []
            slotBound :: Int
slotBound = Int
histLenRaw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        km <- (MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
forall (m :: * -> *).
MonadClientUI m =>
(MenuSlot -> m OKX) -> [KM] -> Int -> MenuSlot -> m KM
displayOneMenuItem MenuSlot -> m OKX
renderOneItem [KM]
forall a. [a]
extraKeys Int
slotBound MenuSlot
slot0
        case K.key km of
          Key
K.Space -> m ()
displayAllHistory
          Key
K.Esc -> MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric
                          Text
"Try to learn from your previous mistakes."
          Key
_ -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
  displayAllHistory

-- * MarkVision

markVisionHuman :: MonadClientUI m => Int -> m ()
markVisionHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
markVisionHuman Int
delta = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> SessionUI -> SessionUI
cycleMarkVision Int
delta

-- * MarkSmell

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

-- * MarkSuspect

markSuspectHuman :: MonadClient m => Int -> m ()
markSuspectHuman :: forall (m :: * -> *). MonadClient m => Int -> m ()
markSuspectHuman Int
delta = 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 (Int -> StateClient -> StateClient
cycleMarkSuspect Int
delta)

-- * MarkAnim

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

-- * OverrideTut

overrideTutHuman :: MonadClientUI m => Int -> m ()
overrideTutHuman :: forall (m :: * -> *). MonadClientUI m => Int -> m ()
overrideTutHuman Int
delta = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> SessionUI -> SessionUI
cycleOverrideTut Int
delta

-- * PrintScreen

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

-- * Cancel

-- | End aiming mode, rejecting the current position, unless when on
-- remote level, in which case, return to our level.
cancelHuman :: MonadClientUI m => m ()
cancelHuman :: forall (m :: * -> *). MonadClientUI m => m ()
cancelHuman = do
  maimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  case maimMode of
    Just AimMode
aimMode -> do
      let lidV :: LevelId
lidV = AimMode -> LevelId
aimLevelId AimMode
aimMode
      lidOur <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
      if lidV == lidOur
      then clearAimMode
      else do
        xhairPos <- xhairToPos
        let sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidOur Point
xhairPos
        modifySession $ \SessionUI
sess ->
          SessionUI
sess {saimMode = Just aimMode {aimLevelId = lidOur}}
        setXHairFromGUI sxhair
        doLook
    Maybe AimMode
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- * Accept

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

-- | End aiming mode, accepting the current position.
endAiming :: (MonadClient m, MonadClientUI m) => ActorId -> m ()
endAiming :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
endAiming ActorId
leader = do
  sxhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
  modifyClient $ updateTarget leader $ const sxhair

endAimingMsg :: MonadClientUI m => ActorId -> m ()
endAimingMsg :: forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
endAimingMsg ActorId
leader = do
  subject <- ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partActorLeader ActorId
leader
  tgt <- getsClient $ getTarget leader
  (mtargetMsg, _) <- targetDesc tgt
  msgAdd MsgActionAlert $ case mtargetMsg of
    Maybe Text
Nothing ->
      [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
"clear target"]
    Just Text
targetMsg ->
      [Part] -> Text
makeSentence [Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
"target", Text -> Part
MU.Text Text
targetMsg]

-- * DetailCycle

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

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

-- * ClearTargetIfItemClear

clearTargetIfItemClearHuman :: (MonadClient m, MonadClientUI m)
                            => ActorId -> m ()
clearTargetIfItemClearHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m ()
clearTargetIfItemClearHuman ActorId
leader = do
  itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
  when (isNothing itemSel) $ do
    setXHairFromGUI Nothing
    modifyClient $ updateTarget leader (const Nothing)
    doLook

-- * ItemClear

itemClearHuman :: MonadClientUI m => m ()
itemClearHuman :: forall (m :: * -> *). MonadClientUI m => m ()
itemClearHuman = (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {sitemSel = Nothing}

-- * MoveXhair

-- | Move the xhair. Assumes aiming mode.
moveXhairHuman :: MonadClientUI m => Vector -> Int -> m MError
moveXhairHuman :: forall (m :: * -> *). MonadClientUI m => Vector -> Int -> m MError
moveXhairHuman Vector
dir Int
n = do
  -- Not @ScreenContent@, because not drawing here.
  COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  saimMode <- getsSession saimMode
  let lidV = LevelId -> (AimMode -> LevelId) -> Maybe AimMode -> LevelId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> LevelId
forall a. HasCallStack => String -> a
error (String -> LevelId) -> String -> LevelId
forall a b. (a -> b) -> a -> b
$ String
"" String -> (Vector, Int) -> String
forall v. Show v => String -> v -> String
`showFailure` (Vector
dir, Int
n)) AimMode -> LevelId
aimLevelId Maybe AimMode
saimMode
  xhair <- getsSession sxhair
  xhairPos <- xhairToPos
  let shiftB Point
pos = Int -> Int -> Point -> Vector -> Point
shiftBounded Int
rWidthMax Int
rHeightMax Point
pos Vector
dir
      newPos = (Point -> Point) -> Point -> [Point]
forall a. (a -> a) -> a -> [a]
iterate Point -> Point
shiftB Point
xhairPos [Point] -> Int -> Point
forall a. HasCallStack => [a] -> Int -> a
!! Int
n
  if newPos == xhairPos then failMsg "never mind"
  else do
    mleader <- getsClient sleader
    sxhair <- case (xhair, mleader) of
     (Just TVector{}, Just ActorId
leader) -> do
       lpos <- (State -> Point) -> m Point
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Point) -> m Point) -> (State -> Point) -> m Point
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
       return $ Just $ TVector $ newPos `vectorToFrom` lpos
     (Maybe Target, Maybe ActorId)
_ -> Maybe Target -> m (Maybe Target)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Target -> m (Maybe Target))
-> Maybe Target -> m (Maybe Target)
forall a b. (a -> b) -> a -> b
$ Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidV Point
newPos
    setXHairFromGUI sxhair
    doLook
    return Nothing

-- * AimTgt

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

-- * AimFloor

-- | Cycle aiming mode. Do not change position of the xhair,
-- switch target to point at different things at that position.
aimFloorHuman :: MonadClientUI m => m ()
aimFloorHuman :: forall (m :: * -> *). MonadClientUI m => m ()
aimFloorHuman = do
  lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  mleader <- getsClient sleader
  mlpos <- case mleader of
    Maybe ActorId
Nothing -> Maybe Point -> m (Maybe Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
forall a. Maybe a
Nothing
    Just ActorId
leader -> (State -> Maybe Point) -> m (Maybe Point)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> (State -> Point) -> State -> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
  xhairPos <- xhairToPos
  xhair <- getsSession sxhair
  saimMode <- getsSession saimMode
  bsAll <- getsState $ actorAssocs (const True) lidV
  side <- getsClient sside
  fact <- getsState $ (EM.! side) . sfactionD
  let sxhair = case Maybe Target
xhair of
        Maybe Target
_ | 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{} | Just Point
lpos <- Maybe Point
mlpos, Point
xhairPos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
lpos ->
          Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ Vector -> Target
TVector (Vector -> Target) -> Vector -> Target
forall a b. (a -> b) -> a -> b
$ Point
xhairPos Point -> Point -> Vector
`vectorToFrom` Point
lpos
        Just TVector{} ->
          -- 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 (\(ActorId
_, Actor
b) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
xhairPos) [(ActorId, Actor)]
bsAll of
            Just (ActorId
aid, Actor
b) -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ if FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b)
                                    then ActorId -> Target
TEnemy ActorId
aid
                                    else ActorId -> Target
TNonEnemy ActorId
aid
            Maybe (ActorId, Actor)
Nothing -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown LevelId
lidV Point
xhairPos
        Maybe Target
_ -> Maybe Target
xhair
  modifySession $ \SessionUI
sess -> SessionUI
sess {saimMode =
    let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
    in Just $ AimMode lidV newDetail}
  setXHairFromGUI sxhair
  doLook

-- * AimEnemy

aimEnemyHuman :: MonadClientUI m => m ()
aimEnemyHuman :: forall (m :: * -> *). MonadClientUI m => m ()
aimEnemyHuman = do
  lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  mleader <- getsClient sleader
  mlpos <- case mleader of
    Maybe ActorId
Nothing -> Maybe Point -> m (Maybe Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
forall a. Maybe a
Nothing
    Just ActorId
leader -> (State -> Maybe Point) -> m (Maybe Point)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> (State -> Point) -> State -> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
  mxhairPos <- mxhairToPos
  xhair <- getsSession sxhair
  saimMode <- getsSession saimMode
  side <- getsClient sside
  fact <- getsState $ (EM.! side) . sfactionD
  bsAll <- getsState $ actorAssocs (const True) lidV
  let -- On the same position, big actors come before projectiles.
      ordPos Point
lpos (a
_, Actor
b) = (Point -> Point -> Int
chessDist Point
lpos (Point -> Int) -> Point -> Int
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
b, Actor -> Point
bpos Actor
b, Actor -> Bool
bproj Actor
b)
      dbs = case Maybe Point
mlpos of
        Maybe Point
Nothing -> [(ActorId, Actor)]
bsAll
        Just Point
lpos -> ((ActorId, Actor) -> (Int, Point, Bool))
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Point -> (ActorId, Actor) -> (Int, Point, Bool)
forall {a}. Point -> (a, Actor) -> (Int, Point, Bool)
ordPos Point
lpos) [(ActorId, Actor)]
bsAll
      pickUnderXhair =  -- switch to the actor under xhair, if any
        Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Point
mxhairPos) (Maybe Point -> Bool)
-> ((ActorId, Actor) -> Maybe Point) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point)
-> ((ActorId, Actor) -> Point) -> (ActorId, Actor) -> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos (Actor -> Point)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd) [(ActorId, Actor)]
dbs
      (pickEnemies, i) = case xhair of
        Just (TEnemy ActorId
a) | Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode ->  -- pick next enemy
          (Bool
True, Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
a) (ActorId -> Bool)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
dbs))
        Just (TEnemy ActorId
a) ->  -- first key press, retarget old enemy
          (Bool
True, Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
a) (ActorId -> Bool)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
dbs)
        Just (TNonEnemy ActorId
a) | Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode ->  -- pick next non-enemy
          (Bool
False, Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
a) (ActorId -> Bool)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
dbs))
        Just (TNonEnemy ActorId
a) ->  -- first key press, retarget old non-enemy
          (Bool
False, Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool) -> [(ActorId, Actor)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
a) (ActorId -> Bool)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
dbs)
        Maybe Target
_ -> (Bool
True, Int
pickUnderXhair)
      (lt, gt) = splitAt i dbs
      isEnemy Actor
b = FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b)
                  Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)
                  Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
      cond = 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) -> 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 = case [(ActorId, Actor)]
lf of
        (ActorId
a, Actor
_) : [(ActorId, Actor)]
_ -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ if Bool
pickEnemies then ActorId -> Target
TEnemy ActorId
a else ActorId -> Target
TNonEnemy ActorId
a
        [] -> Maybe Target
xhair  -- no seen foes in sight, stick to last target
  -- Register the chosen enemy, to pick another on next invocation.
  modifySession $ \SessionUI
sess -> SessionUI
sess {saimMode =
    let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
    in Just $ AimMode lidV newDetail}
  setXHairFromGUI sxhair
  doLook

-- * AimItem

aimItemHuman :: MonadClientUI m => m ()
aimItemHuman :: forall (m :: * -> *). MonadClientUI m => m ()
aimItemHuman = do
  side <- (StateClient -> FactionId) -> m FactionId
forall a. (StateClient -> a) -> m a
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  lidV <- viewedLevelUI
  mleader <- getsClient sleader
  mlpos <- case mleader of
    Maybe ActorId
Nothing -> Maybe Point -> m (Maybe Point)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
forall a. Maybe a
Nothing
    Just ActorId
leader -> (State -> Maybe Point) -> m (Maybe Point)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe Point) -> m (Maybe Point))
-> (State -> Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> (State -> Point) -> State -> Maybe Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
  mxhairPos <- mxhairToPos
  xhair <- getsSession sxhair
  saimMode <- getsSession saimMode
  Level{lfloor} <- getLevel lidV
  mstash <- getsState $ \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 = case Maybe (LevelId, Point)
mstash of
        Just (LevelId
lid, Point
pos) | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV -> Point -> ItemFloor -> ItemFloor
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete Point
pos ItemFloor
lfloor
        Maybe (LevelId, Point)
_ -> ItemFloor
lfloor
      bsAll = ItemFloor -> [Point]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemFloor
lfloorBarStash
      ordPos Point
lpos Point
p = (Point -> Point -> Int
chessDist Point
lpos Point
p, Point
p)
      dbs = case Maybe Point
mlpos of
        Maybe Point
Nothing -> [Point]
bsAll
        Just Point
lpos -> (Point -> (Int, Point)) -> [Point] -> [Point]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Point -> Point -> (Int, Point)
ordPos Point
lpos) [Point]
bsAll
      pickUnderXhair =  -- switch to the item under xhair, if any
        let i :: Int
i = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1)
                (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Point
mxhairPos) (Maybe Point -> Bool) -> (Point -> Maybe Point) -> Point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Maybe Point
forall a. a -> Maybe a
Just) [Point]
dbs
        in Int -> [Point] -> ([Point], [Point])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [Point]
dbs
      (lt, gt) = case xhair of
        Just (TPoint TGoal
_ LevelId
lid Point
pos)
          | Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode Bool -> Bool -> Bool
&& LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV ->  -- pick next item
            let i :: Int
i = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Point -> [Point] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Point
pos [Point]
dbs
            in Int -> [Point] -> ([Point], [Point])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Point]
dbs
        Just (TPoint TGoal
_ LevelId
lid Point
pos)
          | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV ->  -- first key press, retarget old item
            let i :: Int
i = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Point -> [Point] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Point
pos [Point]
dbs
            in Int -> [Point] -> ([Point], [Point])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [Point]
dbs
        Maybe Target
_ -> ([Point], [Point])
pickUnderXhair
      gtlt = [Point]
gt [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ [Point]
lt
      sxhair = case [Point]
gtlt of
        Point
p : [Point]
_ -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidV Point
p  -- 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.
  modifySession $ \SessionUI
sess -> SessionUI
sess {saimMode =
    let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
    in Just $ AimMode lidV newDetail}
  setXHairFromGUI sxhair
  doLook

-- * AimAscend

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

-- * EpsIncr

-- | Tweak the @eps@ parameter of the aiming digital line.
epsIncrHuman :: (MonadClient m, MonadClientUI m) => Direction -> m ()
epsIncrHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Direction -> m ()
epsIncrHuman Direction
d = do
  -- Perform the change:
  let sepsDelta :: Int
sepsDelta = case Direction
d of
        Direction
Forward -> Int
1
        Direction
Backward -> -Int
1
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli -> StateClient
cli {seps = seps cli + sepsDelta}
  m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsPathAll
  -- 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
$ \SessionUI
sess -> SessionUI
sess {sreportNull = False}
  saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  lidV <- viewedLevelUI
  modifySession $ \SessionUI
sess -> SessionUI
sess {saimMode =
    let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
DetailLow AimMode -> DetailLevel
detailLevel Maybe AimMode
saimMode
    in Just $ AimMode lidV newDetail}
  flashAiming
  modifySession $ \SessionUI
sess -> SessionUI
sess {saimMode}
  -- The change may not affect the line shape, hence 'possibly'.
  msgAdd MsgPromptAction "Aiming line (possibly) modified."

-- Flash the aiming line and path.
flashAiming :: MonadClientUI m => m ()
flashAiming :: forall (m :: * -> *). MonadClientUI m => m ()
flashAiming = do
  lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  animate lidV pushAndDelay

-- * XhairUnknown

xhairUnknownHuman :: (MonadClient m, MonadClientUI m) => ActorId -> m MError
xhairUnknownHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m MError
xhairUnknownHuman ActorId
leader = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  mpos <- closestUnknown leader
  case mpos of
    Maybe Point
Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"no more unknown spots left"
    Just Point
p -> do
      let sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown (Actor -> LevelId
blid Actor
b) Point
p
      Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
      MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- * XhairItem

xhairItemHuman :: (MonadClient m, MonadClientUI m) => ActorId -> m MError
xhairItemHuman :: forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m MError
xhairItemHuman ActorId
leader = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  items <- closestItems leader
  case items of
    [] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
"no more reachable items remembered or visible"
    [(Int, (Point, EnumMap ItemId ItemQuant))]
_ -> do
      let (Int
_, (Point
p, EnumMap ItemId ItemQuant
bag)) = ((Int, (Point, EnumMap ItemId ItemQuant))
 -> (Int, (Point, EnumMap ItemId ItemQuant)) -> Ordering)
-> [(Int, (Point, EnumMap ItemId ItemQuant))]
-> (Int, (Point, EnumMap ItemId ItemQuant))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((Int, (Point, EnumMap ItemId ItemQuant)) -> Int)
-> (Int, (Point, EnumMap ItemId ItemQuant))
-> (Int, (Point, EnumMap ItemId ItemQuant))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (Point, EnumMap ItemId ItemQuant)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (Point, EnumMap ItemId ItemQuant))]
items
          sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint (EnumMap ItemId ItemQuant -> TGoal
TItem EnumMap ItemId ItemQuant
bag) (Actor -> LevelId
blid Actor
b) Point
p
      Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
      MError -> m MError
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- * XhairStair

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

-- * XhairPointerFloor

xhairPointerFloorHuman :: MonadClientUI m => m ()
xhairPointerFloorHuman :: forall (m :: * -> *). MonadClientUI m => m ()
xhairPointerFloorHuman = do
  saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  aimPointerFloorHuman
  when (isNothing saimMode) $
    modifySession $ \SessionUI
sess -> SessionUI
sess {saimMode}

-- * XhairPointerMute

xhairPointerMuteHuman :: MonadClientUI m => m ()
xhairPointerMuteHuman :: forall (m :: * -> *). MonadClientUI m => m ()
xhairPointerMuteHuman = do
  saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  aimPointerFloorLoud False
  when (isNothing saimMode) $
    modifySession $ \SessionUI
sess -> SessionUI
sess {saimMode}

-- * XhairPointerEnemy

xhairPointerEnemyHuman :: MonadClientUI m => m ()
xhairPointerEnemyHuman :: forall (m :: * -> *). MonadClientUI m => m ()
xhairPointerEnemyHuman = do
  saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall a. (SessionUI -> a) -> m a
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  aimPointerEnemyHuman
  when (isNothing saimMode) $
    modifySession $ \SessionUI
sess -> SessionUI
sess {saimMode}

-- * AimPointerFloor

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

aimPointerFloorLoud :: MonadClientUI m => Bool -> m ()
aimPointerFloorLoud :: forall (m :: * -> *). MonadClientUI m => Bool -> m ()
aimPointerFloorLoud Bool
loud = do
  COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  lidV <- viewedLevelUI
  -- Not @ScreenContent@, because not drawing here.
  pUI <- getsSession spointer
  let p = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
  if insideP (0, 0, rWidthMax - 1, rHeightMax - 1) p
  then do
    oldXhair <- getsSession sxhair
    let 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 = Maybe Target
sxhair Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
oldXhair
        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
    modifySession $ \SessionUI
sess ->
      SessionUI
sess { saimMode =
               let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailSucc
                                     (SessionUI -> Maybe AimMode
saimMode SessionUI
sess)
               in Just $ AimMode lidV newDetail
           , sxhairMoused }
    setXHairFromGUI sxhair
    when loud doLook
  else stopPlayBack

-- * AimPointerEnemy

aimPointerEnemyHuman :: MonadClientUI m => m ()
aimPointerEnemyHuman :: forall (m :: * -> *). MonadClientUI m => m ()
aimPointerEnemyHuman = do
  COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  lidV <- viewedLevelUI
  -- Not @ScreenContent@, because not drawing here.
  pUI <- getsSession spointer
  let p = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
  if insideP (0, 0, rWidthMax - 1, rHeightMax - 1) p
  then do
    bsAll <- getsState $ actorAssocs (const True) lidV
    oldXhair <- getsSession sxhair
    side <- getsClient sside
    fact <- getsState $ (EM.! side) . sfactionD
    let 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 (\(ActorId
_, Actor
b) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p) [(ActorId, Actor)]
bsAll of
            Just (ActorId
aid, Actor
b) -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ if FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b)
                                    then ActorId -> Target
TEnemy ActorId
aid
                                    else ActorId -> Target
TNonEnemy ActorId
aid
            Maybe (ActorId, Actor)
Nothing -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown LevelId
lidV Point
p
        sxhairMoused = Maybe Target
sxhair Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
oldXhair
        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
    modifySession $ \SessionUI
sess ->
      SessionUI
sess { saimMode =
               let newDetail = DetailLevel
-> (AimMode -> DetailLevel) -> Maybe AimMode -> DetailLevel
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DetailLevel
defaultDetailLevel AimMode -> DetailLevel
detailSucc
                                     (SessionUI -> Maybe AimMode
saimMode SessionUI
sess)
               in Just $ AimMode lidV newDetail
           , sxhairMoused }
    setXHairFromGUI sxhair
    doLook
  else stopPlayBack