-- | 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
    -- * Local commands
  , chooseItemHuman, chooseItemDialogMode
  , chooseItemProjectHuman, chooseItemApplyHuman
  , psuitReq, triggerSymbols, pickLeaderHuman, pickLeaderWithPointerHuman
  , memberCycleHuman, memberBackHuman
  , selectActorHuman, selectNoneHuman, selectWithPointerHuman
  , repeatHuman, recordHuman, allHistoryHuman, lastHistoryHuman
  , markVisionHuman, markSmellHuman, markSuspectHuman, printScreenHuman
    -- * Commands specific to aiming
  , cancelHuman, acceptHuman, clearTargetIfItemClearHuman, itemClearHuman
  , moveXhairHuman, aimTgtHuman, aimFloorHuman, aimEnemyHuman, aimItemHuman
  , aimAscendHuman, epsIncrHuman
  , xhairUnknownHuman, xhairItemHuman, xhairStairHuman
  , xhairPointerFloorHuman, xhairPointerEnemyHuman
  , aimPointerFloorHuman, aimPointerEnemyHuman
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , permittedProjectClient, projectCheck, xhairLegalEps, posFromXhair
  , permittedApplyClient, selectAid, eitherHistory, endAiming, endAimingMsg
  , doLook, flashAiming
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

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

-- * Macro

macroHuman :: MonadClientUI m => [String] -> m ()
macroHuman :: [String] -> m ()
macroHuman kms :: [String]
kms = do
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {slastPlay :: [KM]
slastPlay = (String -> KM) -> [String] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map String -> KM
K.mkKM [String]
kms [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ SessionUI -> [KM]
slastPlay SessionUI
sess}
  MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgMacro (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Macro activated:" Text -> Text -> Text
<+> String -> Text
T.pack (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " " [String]
kms)

-- * ChooseItem

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

chooseItemDialogMode :: MonadClientUI m
                     => ItemDialogMode -> m (FailOrCmd ItemDialogMode)
chooseItemDialogMode :: ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode c :: ItemDialogMode
c = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: ScreenContent -> X
rwidth :: X
rwidth, X
rheight :: ScreenContent -> X
rheight :: X
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  let prompt :: Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
             -> Text
      prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt body :: Actor
body bodyUI :: ActorUI
bodyUI actorMaxSk :: Skills
actorMaxSk c2 :: ItemDialogMode
c2 s :: State
s =
        let (tIn :: Text
tIn, t :: Text
t) = ItemDialogMode -> (Text, Text)
ppItemDialogMode ItemDialogMode
c2
            subject :: Part
subject = ActorUI -> Part
partActor ActorUI
bodyUI
            f :: (a, b) -> a -> a
f (k :: a
k, _) acc :: a
acc = a
k a -> a -> a
forall a. Num a => a -> a -> a
+ a
acc
            countItems :: CStore -> X
countItems store :: CStore
store = ((X, ItemTimer) -> X -> X)
-> X -> EnumMap ItemId (X, ItemTimer) -> X
forall a b k. (a -> b -> b) -> b -> EnumMap k a -> b
EM.foldr' (X, ItemTimer) -> X -> X
forall a b. Num a => (a, b) -> a -> a
f 0 (EnumMap ItemId (X, ItemTimer) -> X)
-> EnumMap ItemId (X, ItemTimer) -> X
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId (X, ItemTimer)
getBodyStoreBag Actor
body CStore
store State
s
        in case ItemDialogMode
c2 of
        MStore CGround ->
          let n :: X
n = CStore -> X
countItems CStore
CGround
              nItems :: Part
nItems = X -> Part -> Part
MU.CarAWs X
n "item"
          in [Part] -> Text
makePhrase
               [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "notice"
               , Part
nItems, "at"
               , Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text "feet" ]
        MStore CSha ->
          -- We assume "gold grain", not "grain" with label "of gold":
          let currencyName :: Text
currencyName = ItemKind -> Text
IK.iname (ItemKind -> Text) -> ItemKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem
                             (ContentId ItemKind -> ItemKind) -> ContentId ItemKind -> ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData ItemKind -> GroupName ItemKind -> ContentId ItemKind
forall a. Show a => ContentData a -> GroupName a -> ContentId a
ouniqGroup ContentData ItemKind
coitem "currency"
              dungeonTotal :: X
dungeonTotal = State -> X
sgold State
s
              (_, total :: X
total) = FactionId -> State -> (EnumMap ItemId (X, ItemTimer), X)
calculateTotal FactionId
side State
s
              n :: X
n = CStore -> X
countItems CStore
CSha
              verbSha :: Part
verbSha = if | X
n X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> "find nothing"
                           | Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorMaxSk -> "notice"
                           | Bool
otherwise -> "paw distractedly"
          in [Part] -> Text
makePhrase
               [ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text -> X -> X -> Text
spoilsBlurb Text
currencyName X
total X
dungeonTotal
               , Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbSha
               , Text -> Part
MU.Text Text
tIn
               , Text -> Part
MU.Text Text
t ]
        MStore cstore :: CStore
cstore ->
          let n :: X
n = CStore -> X
countItems CStore
cstore
              nItems :: Part
nItems = X -> Part -> Part
MU.CarAWs X
n "item"
          in [Part] -> Text
makePhrase
               [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "see"
               , Part
nItems, Text -> Part
MU.Text Text
tIn
               , Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
        MOrgans ->
          [Part] -> Text
makePhrase
            [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "feel"
            , Text -> Part
MU.Text Text
tIn
            , Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
        MOwned ->
          [Part] -> Text
makePhrase
            [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "recall"
            , Text -> Part
MU.Text Text
tIn
            , Text -> Part
MU.Text Text
t ]
        MSkills ->
          [Part] -> Text
makePhrase
            [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "estimate"
            , Part -> Part -> Part
MU.WownW (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ ActorUI -> Text
bpronoun ActorUI
bodyUI) (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
        MLore{} ->
          [Part] -> Text
makePhrase
            [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "recall"
            , Text -> Part
MU.Text Text
t ]
        MPlaces ->
          [Part] -> Text
makePhrase
            [ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject "recall"
            , Text -> Part
MU.Text Text
t ]
  (Either
   Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
ggi <- (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> m (Either
        Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
(Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> m (Either
        Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
      (ItemDialogMode, Either KM SlotChar))
getStoreItem Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt ItemDialogMode
c
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory  -- item chosen, wipe out already shown msgs
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
  let meleeSkill :: X
meleeSkill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkHurtMelee Skills
actorMaxSk
  ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
  case (Either
   Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
ggi of
    (Right (iid :: ItemId
iid, itemBag :: EnumMap ItemId (X, ItemTimer)
itemBag, lSlots :: SingleItemSlots
lSlots), (c2 :: ItemDialogMode
c2, _)) ->
      case ItemDialogMode
c2 of
        MStore fromCStore :: CStore
fromCStore -> do
          (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
            SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
fromCStore, Bool
False)}
          Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FailError ItemDialogMode
 -> m (Either FailError ItemDialogMode))
-> Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ItemDialogMode -> Either FailError ItemDialogMode
forall a b. b -> Either a b
Right ItemDialogMode
c2
        MOrgans -> do
          let blurb :: ItemFull -> p
blurb itemFull :: ItemFull
itemFull =
                if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
                then "condition"
                else "organ"
              promptFun :: ItemId -> ItemFull -> X -> Text
promptFun _ itemFull :: ItemFull
itemFull _ =
                [Part] -> Text
makeSentence [ ActorUI -> Part
partActor ActorUI
bUI, "can't remove"
                             , Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ ItemFull -> Part
forall p. IsString p => ItemFull -> p
blurb ItemFull
itemFull ]
              ix0 :: X
ix0 = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error (String -> X) -> String -> X
forall a b. (a -> b) -> a -> b
$ ItemId -> String
forall a. Show a => a -> String
show ItemId
iid)
                    (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ (ItemId -> Bool) -> [ItemId] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
findIndex (ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== ItemId
iid) ([ItemId] -> Maybe X) -> [ItemId] -> Maybe X
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
lSlots
          Bool
go <- EnumMap ItemId (X, ItemTimer)
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
MonadClientUI m =>
EnumMap ItemId (X, ItemTimer)
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> m Bool
displayItemLore EnumMap ItemId (X, ItemTimer)
itemBag X
meleeSkill ItemId -> ItemFull -> X -> Text
promptFun X
ix0 SingleItemSlots
lSlots
          if Bool
go then ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode ItemDialogMode
c2 else Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
        MOwned -> do
          [(ActorId, (Actor, CStore))]
found <- (State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, (Actor, CStore))])
 -> m [(ActorId, (Actor, CStore))])
-> (State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))]
forall a b. (a -> b) -> a -> b
$ ActorId
-> FactionId -> ItemId -> State -> [(ActorId, (Actor, CStore))]
findIid ActorId
leader FactionId
side ItemId
iid
          let (newAid :: ActorId
newAid, bestStore :: CStore
bestStore) = case ActorId
leader ActorId -> [(ActorId, (Actor, CStore))] -> Maybe (Actor, CStore)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(ActorId, (Actor, CStore))]
found of
                Just (_, store :: CStore
store) -> (ActorId
leader, CStore
store)
                Nothing -> case [(ActorId, (Actor, CStore))]
found of
                  (aid :: ActorId
aid, (_, store :: CStore
store)) : _ -> (ActorId
aid, CStore
store)
                  [] -> String -> (ActorId, CStore)
forall a. HasCallStack => String -> a
error (String -> (ActorId, CStore)) -> String -> (ActorId, CStore)
forall a b. (a -> b) -> a -> b
$ "" String -> ItemId -> String
forall v. Show v => String -> v -> String
`showFailure` ItemId
iid
          (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
            SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
bestStore, Bool
False)}
          LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
          Actor
b2 <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
newAid
          Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
          let (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
          if | ActorId
newAid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
leader -> Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FailError ItemDialogMode
 -> m (Either FailError ItemDialogMode))
-> Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ItemDialogMode -> Either FailError ItemDialogMode
forall a b. b -> Either a b
Right ItemDialogMode
c2
             | Actor -> LevelId
blid Actor
b2 LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
arena Bool -> Bool -> Bool
&& Bool
autoDun ->
               ReqFailure -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
NoChangeDunLeader
             | Bool
otherwise -> do
               -- We switch leader only here, not in lore screens, because
               -- lore is only about inspecting items, no activation submenu.
               m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
True ActorId
newAid
               Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FailError ItemDialogMode
 -> m (Either FailError ItemDialogMode))
-> Either FailError ItemDialogMode
-> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ItemDialogMode -> Either FailError ItemDialogMode
forall a b. b -> Either a b
Right ItemDialogMode
c2
        MSkills -> String -> m (Either FailError ItemDialogMode)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ItemDialogMode))
-> String -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ "" String
-> (Either
      Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
    (ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` (Either
   Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
ggi
        MLore slore :: SLore
slore -> do
          let ix0 :: X
ix0 = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error (String -> X) -> String -> X
forall a b. (a -> b) -> a -> b
$ ItemId -> String
forall a. Show a => a -> String
show ItemId
iid)
                    (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ (ItemId -> Bool) -> [ItemId] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
findIndex (ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== ItemId
iid) ([ItemId] -> Maybe X) -> [ItemId] -> Maybe X
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
lSlots
              promptFun :: ItemId -> ItemFull -> X -> Text
promptFun _ _ _ =
                [Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg (ActorUI -> Part
partActor ActorUI
bUI) "remember"
                             , Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (SLore -> Text
headingSLore SLore
slore) ]
          Bool
go <- EnumMap ItemId (X, ItemTimer)
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> m Bool
forall (m :: * -> *).
MonadClientUI m =>
EnumMap ItemId (X, ItemTimer)
-> X
-> (ItemId -> ItemFull -> X -> Text)
-> X
-> SingleItemSlots
-> m Bool
displayItemLore EnumMap ItemId (X, ItemTimer)
itemBag X
meleeSkill ItemId -> ItemFull -> X -> Text
promptFun X
ix0 SingleItemSlots
lSlots
          if Bool
go then ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode ItemDialogMode
c2 else Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
        MPlaces -> String -> m (Either FailError ItemDialogMode)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ItemDialogMode))
-> String -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ "" String
-> (Either
      Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
    (ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` (Either
   Text (ItemId, EnumMap ItemId (X, ItemTimer), SingleItemSlots),
 (ItemDialogMode, Either KM SlotChar))
ggi
    (Left err :: Text
err, (MSkills, ekm :: Either KM SlotChar
ekm)) -> case Either KM SlotChar
ekm of
      Right slot0 :: SlotChar
slot0 -> Bool
-> m (Either FailError ItemDialogMode)
-> m (Either FailError ItemDialogMode)
forall a. HasCallStack => Bool -> a -> a
assert (Text
err Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "skills") (m (Either FailError ItemDialogMode)
 -> m (Either FailError ItemDialogMode))
-> m (Either FailError ItemDialogMode)
-> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ do
        let slotListBound :: X
slotListBound = [Skill] -> X
forall a. [a] -> X
length [Skill]
skillSlots X -> X -> X
forall a. Num a => a -> a -> a
- 1
            displayOneSlot :: X -> m (Either FailError ItemDialogMode)
displayOneSlot slotIndex :: X
slotIndex = do
              Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
              let slot :: SlotChar
slot = [SlotChar]
allSlots [SlotChar] -> X -> SlotChar
forall a. [a] -> X -> a
!! X
slotIndex
                  skill :: Skill
skill = [Skill]
skillSlots [Skill] -> X -> Skill
forall a. [a] -> X -> a
!! X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error (String -> X) -> String -> X
forall a b. (a -> b) -> a -> b
$ SlotChar -> String
forall a. Show a => a -> String
show SlotChar
slot)
                                                  (SlotChar -> [SlotChar] -> Maybe X
forall a. Eq a => a -> [a] -> Maybe X
elemIndex SlotChar
slot [SlotChar]
allSlots)
                  valueText :: Text
valueText =
                    Skill -> Actor -> X -> Text
skillToDecorator Skill
skill Actor
b (X -> Text) -> X -> Text
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> X
Ability.getSk Skill
skill Skills
actorMaxSk
                  prompt2 :: Text
prompt2 = [Part] -> Text
makeSentence
                    [ Part -> Part -> Part
MU.WownW (ActorUI -> Part
partActor ActorUI
bUI) (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Skill -> Text
skillName Skill
skill)
                    , "is", Text -> Part
MU.Text Text
valueText ]
                  ov0 :: [AttrLine]
ov0 = X -> AttrLine -> [AttrLine]
indentSplitAttrLine X
rwidth (AttrLine -> [AttrLine]) -> AttrLine -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Text -> AttrLine
textToAL
                        (Text -> AttrLine) -> Text -> AttrLine
forall a b. (a -> b) -> a -> b
$ Skill -> Text
skillDesc Skill
skill
                  keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM]
                         [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | X
slotIndex X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= 0]
                         [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | X
slotIndex X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= X
slotListBound]
              Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
prompt2
              Slideshow
slides <- X -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
X -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2) [KM]
keys ([AttrLine]
ov0, [])
              KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
              case KM -> Key
K.key KM
km of
                K.Space -> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode ItemDialogMode
MSkills
                K.Up -> X -> m (Either FailError ItemDialogMode)
displayOneSlot (X -> m (Either FailError ItemDialogMode))
-> X -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ X
slotIndex X -> X -> X
forall a. Num a => a -> a -> a
- 1
                K.Down -> X -> m (Either FailError ItemDialogMode)
displayOneSlot (X -> m (Either FailError ItemDialogMode))
-> X -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ X
slotIndex X -> X -> X
forall a. Num a => a -> a -> a
+ 1
                K.Esc -> Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
                _ -> String -> m (Either FailError ItemDialogMode)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ItemDialogMode))
-> String -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
            slotIndex0 :: X
slotIndex0 = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error "displayOneSlot: illegal slot")
                         (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ SlotChar -> [SlotChar] -> Maybe X
forall a. Eq a => a -> [a] -> Maybe X
elemIndex SlotChar
slot0 [SlotChar]
allSlots
        X -> m (Either FailError ItemDialogMode)
displayOneSlot X
slotIndex0
      Left _ -> Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
    (Left err :: Text
err, (MPlaces, ekm :: Either KM SlotChar
ekm)) -> case Either KM SlotChar
ekm of
      Right slot0 :: SlotChar
slot0 -> Bool
-> m (Either FailError ItemDialogMode)
-> m (Either FailError ItemDialogMode)
forall a. HasCallStack => Bool -> a -> a
assert (Text
err Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "places") (m (Either FailError ItemDialogMode)
 -> m (Either FailError ItemDialogMode))
-> m (Either FailError ItemDialogMode)
-> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ do
        COps{ContentData PlaceKind
coplace :: COps -> ContentData PlaceKind
coplace :: ContentData PlaceKind
coplace} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
        ClientOptions
soptions <- (StateClient -> ClientOptions) -> m ClientOptions
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> ClientOptions
soptions
        [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
places <- (State -> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))])
 -> m [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))])
-> (State -> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))])
-> m [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId PlaceKind) (EnumSet LevelId, X, X, X)
-> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (EnumMap (ContentId PlaceKind) (EnumSet LevelId, X, X, X)
 -> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))])
-> (State
    -> EnumMap (ContentId PlaceKind) (EnumSet LevelId, X, X, X))
-> State
-> [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentData PlaceKind
-> ClientOptions
-> State
-> EnumMap (ContentId PlaceKind) (EnumSet LevelId, X, X, X)
placesFromState ContentData PlaceKind
coplace ClientOptions
soptions
        let slotListBound :: X
slotListBound = [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))] -> X
forall a. [a] -> X
length [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
places X -> X -> X
forall a. Num a => a -> a -> a
- 1
            displayOneSlot :: X -> m (Either FailError ItemDialogMode)
displayOneSlot slotIndex :: X
slotIndex = do
              let slot :: SlotChar
slot = [SlotChar]
allSlots [SlotChar] -> X -> SlotChar
forall a. [a] -> X -> a
!! X
slotIndex
                  (pk :: ContentId PlaceKind
pk, figures :: (EnumSet LevelId, X, X, X)
figures@(es :: EnumSet LevelId
es, _, _, _)) =
                    [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
places [(ContentId PlaceKind, (EnumSet LevelId, X, X, X))]
-> X -> (ContentId PlaceKind, (EnumSet LevelId, X, X, X))
forall a. [a] -> X -> a
!! X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error (String -> X) -> String -> X
forall a b. (a -> b) -> a -> b
$ SlotChar -> String
forall a. Show a => a -> String
show SlotChar
slot)
                                        (SlotChar -> [SlotChar] -> Maybe X
forall a. Eq a => a -> [a] -> Maybe X
elemIndex SlotChar
slot [SlotChar]
allSlots)
                  pkind :: PlaceKind
pkind = ContentData PlaceKind -> ContentId PlaceKind -> PlaceKind
forall a. ContentData a -> ContentId a -> a
okind ContentData PlaceKind
coplace ContentId PlaceKind
pk
                  partsPhrase :: Text
partsPhrase = [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ (EnumSet LevelId, X, X, X) -> [Part]
placeParts (EnumSet LevelId, X, X, X)
figures
                  prompt2 :: Text
prompt2 = [Part] -> Text
makeSentence
                    [ Part -> Part -> Part
MU.SubjectVerbSg (ActorUI -> Part
partActor ActorUI
bUI) "remember"
                    , Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ PlaceKind -> Text
PK.pname PlaceKind
pkind ]
                  freqsText :: Text
freqsText = "Frequencies:" Text -> Text -> Text
<+> Text -> [Text] -> Text
T.intercalate " "
                    (((GroupName PlaceKind, X) -> Text)
-> [(GroupName PlaceKind, X)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(grp :: GroupName PlaceKind
grp, n :: X
n) -> "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GroupName PlaceKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName PlaceKind
grp
                                       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> X -> Text
forall a. Show a => a -> Text
tshow X
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")")
                     ([(GroupName PlaceKind, X)] -> [Text])
-> [(GroupName PlaceKind, X)] -> [Text]
forall a b. (a -> b) -> a -> b
$ PlaceKind -> [(GroupName PlaceKind, X)]
PK.pfreq PlaceKind
pkind)
                  onLevels :: [Text]
onLevels | EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
es = []
                           | Bool
otherwise =
                    [[Part] -> Text
makeSentence
                       [ "Appears on"
                       , X -> Part -> Part
MU.CarWs (EnumSet LevelId -> X
forall k. EnumSet k -> X
ES.size EnumSet LevelId
es) "level" Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> ":"
                       , [Part] -> Part
MU.WWandW ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ (X -> Part) -> [X] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map X -> Part
MU.Car ([X] -> [Part]) -> [X] -> [Part]
forall a b. (a -> b) -> a -> b
$ [X] -> [X]
forall a. Ord a => [a] -> [a]
sort
                                   ([X] -> [X]) -> [X] -> [X]
forall a b. (a -> b) -> a -> b
$ (LevelId -> X) -> [LevelId] -> [X]
forall a b. (a -> b) -> [a] -> [b]
map (X -> X
forall a. Num a => a -> a
abs (X -> X) -> (LevelId -> X) -> LevelId -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LevelId -> X
forall a. Enum a => a -> X
fromEnum) ([LevelId] -> [X]) -> [LevelId] -> [X]
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
es ]]
                  ov0 :: [AttrLine]
ov0 = X -> AttrLine -> [AttrLine]
indentSplitAttrLine X
rwidth (AttrLine -> [AttrLine]) -> AttrLine -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Text -> AttrLine
textToAL (Text -> AttrLine) -> Text -> AttrLine
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                          (if ClientOptions -> Bool
sexposePlaces ClientOptions
soptions
                           then [ "", Text
partsPhrase
                                , "", Text
freqsText
                                , "" ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ PlaceKind -> [Text]
PK.ptopLeft PlaceKind
pkind
                           else [])
                          [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [""] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
onLevels
                  keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM]
                         [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | X
slotIndex X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= 0]
                         [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | X
slotIndex X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= X
slotListBound]
              Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
prompt2
              Slideshow
slides <- X -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
X -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2) [KM]
keys ([AttrLine]
ov0, [])
              KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
              case KM -> Key
K.key KM
km of
                K.Space -> ItemDialogMode -> m (Either FailError ItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m (Either FailError ItemDialogMode)
chooseItemDialogMode ItemDialogMode
MPlaces
                K.Up -> X -> m (Either FailError ItemDialogMode)
displayOneSlot (X -> m (Either FailError ItemDialogMode))
-> X -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ X
slotIndex X -> X -> X
forall a. Num a => a -> a -> a
- 1
                K.Down -> X -> m (Either FailError ItemDialogMode)
displayOneSlot (X -> m (Either FailError ItemDialogMode))
-> X -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ X
slotIndex X -> X -> X
forall a. Num a => a -> a -> a
+ 1
                K.Esc -> Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
                _ -> String -> m (Either FailError ItemDialogMode)
forall a. HasCallStack => String -> a
error (String -> m (Either FailError ItemDialogMode))
-> String -> m (Either FailError ItemDialogMode)
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
            slotIndex0 :: X
slotIndex0 = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (String -> X
forall a. HasCallStack => String -> a
error "displayOneSlot: illegal slot")
                         (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ SlotChar -> [SlotChar] -> Maybe X
forall a. Eq a => a -> [a] -> Maybe X
elemIndex SlotChar
slot0 [SlotChar]
allSlots
        X -> m (Either FailError ItemDialogMode)
displayOneSlot X
slotIndex0
      Left _ -> Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
    (Left err :: Text
err, _) -> Text -> m (Either FailError ItemDialogMode)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err

-- * ChooseItemProject

chooseItemProjectHuman :: forall m. (MonadClient m, MonadClientUI m)
                       => [TriggerItem] -> m MError
chooseItemProjectHuman :: [TriggerItem] -> m MError
chooseItemProjectHuman ts :: [TriggerItem]
ts = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
      cLegalRaw :: [CStore]
cLegalRaw = [CStore
CGround, CStore
CInv, CStore
CSha, CStore
CEqp]
      cLegal :: [CStore]
cLegal | Bool
calmE = [CStore]
cLegalRaw
             | Bool
otherwise = CStore -> [CStore] -> [CStore]
forall a. Eq a => a -> [a] -> [a]
delete CStore
CSha [CStore]
cLegalRaw
      (verb1 :: Part
verb1, object1 :: Part
object1) = case [TriggerItem]
ts of
        [] -> ("aim", "item")
        tr :: TriggerItem
tr : _ -> (TriggerItem -> Part
tiverb TriggerItem
tr, TriggerItem -> Part
tiobject TriggerItem
tr)
      triggerSyms :: String
triggerSyms = [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
  Either Text (ItemFull -> Either ReqFailure (Point, Bool))
mpsuitReq <- m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq
  case Either Text (ItemFull -> Either ReqFailure (Point, Bool))
mpsuitReq of
    -- If xhair aim invalid, no item is considered a (suitable) missile.
    Left err :: Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err
    Right psuitReqFun :: ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun -> do
      Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
      case Maybe (ItemId, CStore, Bool)
itemSel of
        Just (_, _, True) -> MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
        Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, False) -> do
          -- We don't validate vs @ts@ here, because player has selected
          -- this item, so he knows what he's doing (unless really absurd).
          ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
          EnumMap ItemId (X, ItemTimer)
bag <- (State -> EnumMap ItemId (X, ItemTimer))
-> m (EnumMap ItemId (X, ItemTimer))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId (X, ItemTimer))
 -> m (EnumMap ItemId (X, ItemTimer)))
-> (State -> EnumMap ItemId (X, ItemTimer))
-> m (EnumMap ItemId (X, ItemTimer))
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId (X, ItemTimer)
getBodyStoreBag Actor
b CStore
fromCStore
          case ItemId
iid ItemId -> EnumMap ItemId (X, ItemTimer) -> Maybe (X, ItemTimer)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ItemId (X, ItemTimer)
bag of
            Just _ | (ReqFailure -> Bool)
-> ((Point, Bool) -> Bool)
-> Either ReqFailure (Point, Bool)
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) (Point, Bool) -> Bool
forall a b. (a, b) -> b
snd (ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ItemFull
itemFull) ->
              MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
            _ -> do
              (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing}
              [TriggerItem] -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[TriggerItem] -> m MError
chooseItemProjectHuman [TriggerItem]
ts
        Nothing -> do
          let psuit :: m Suitability
psuit =
                Suitability -> m Suitability
forall (m :: * -> *) a. Monad m => a -> m a
return (Suitability -> m Suitability) -> Suitability -> m Suitability
forall a b. (a -> b) -> a -> b
$ (ItemFull -> (X, ItemTimer) -> Bool) -> Suitability
SuitsSomething ((ItemFull -> (X, ItemTimer) -> Bool) -> Suitability)
-> (ItemFull -> (X, ItemTimer) -> Bool) -> Suitability
forall a b. (a -> b) -> a -> b
$ \itemFull :: ItemFull
itemFull _kit :: (X, ItemTimer)
_kit ->
                  (ReqFailure -> Bool)
-> ((Point, Bool) -> Bool)
-> Either ReqFailure (Point, Bool)
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) (Point, Bool) -> Bool
forall a b. (a, b) -> b
snd (ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ItemFull
itemFull)
                  Bool -> Bool -> Bool
&& (String -> Bool
forall a. [a] -> Bool
null String
triggerSyms
                      Bool -> Bool -> Bool
|| ItemKind -> Char
IK.isymbol (ItemFull -> ItemKind
itemKind ItemFull
itemFull) Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
triggerSyms)
              prompt :: Text
prompt = [Part] -> Text
makePhrase ["What", Part
object1, "to", Part
verb1]
              promptGeneric :: Text
promptGeneric = "What to fling"
          Either
  Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi <- m Suitability
-> Text
-> Text
-> [CStore]
-> [CStore]
-> m (Either
        Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> Text
-> Text
-> [CStore]
-> [CStore]
-> m (Either
        Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
getGroupItem m Suitability
psuit Text
prompt Text
promptGeneric [CStore]
cLegalRaw [CStore]
cLegal
          case Either
  Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi of
            Right ((iid :: ItemId
iid, _itemFull :: ItemFull
_itemFull), (MStore fromCStore :: CStore
fromCStore, _)) -> do
              (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
                SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
fromCStore, Bool
False)}
              MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
            Left err :: Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err
            _ -> String -> m MError
forall a. HasCallStack => String -> a
error (String -> m MError) -> String -> m MError
forall a b. (a -> b) -> a -> b
$ "" String
-> Either
     Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` Either
  Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi

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

projectCheck :: MonadClientUI m => Point -> m (Maybe ReqFailure)
projectCheck :: Point -> m (Maybe ReqFailure)
projectCheck tpos :: Point
tpos = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: RuleContent -> X
rXmax :: X
rXmax, X
rYmax :: RuleContent -> X
rYmax :: X
rYmax}, TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  X
eps <- (StateClient -> X) -> m X
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> X
seps
  Actor
sb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  let lid :: LevelId
lid = Actor -> LevelId
blid Actor
sb
      spos :: Point
spos = Actor -> Point
bpos Actor
sb
  -- Not @ScreenContent@, because not drawing here.
  case X -> X -> X -> Point -> Point -> Maybe [Point]
bla X
rXmax X
rYmax X
eps Point
spos Point
tpos of
    Nothing -> Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectAimOnself
    Just [] -> String -> m (Maybe ReqFailure)
forall a. HasCallStack => String -> a
error (String -> m (Maybe ReqFailure)) -> String -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ "project from the edge of level"
                       String -> (Point, Point, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (Point
spos, Point
tpos, Actor
sb)
    Just (pos :: Point
pos : _) -> do
      Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
      let t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
pos
      if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t
        then Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectBlockTerrain
        else if Point -> Level -> Bool
occupiedBigLvl Point
pos Level
lvl
             then Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ReqFailure -> m (Maybe ReqFailure))
-> Maybe ReqFailure -> m (Maybe ReqFailure)
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Maybe ReqFailure
forall a. a -> Maybe a
Just ReqFailure
ProjectBlockActor
             else Maybe ReqFailure -> m (Maybe ReqFailure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ReqFailure
forall a. Maybe a
Nothing

-- | Check whether one is permitted to aim (for projecting) at a target.
-- The check is stricter for actor targets, assuming the player simply wants
-- to hit a single actor. In order to fine tune trick-shots, e.g., piercing
-- many actors, other aiming modes should be used.
-- Returns a different @seps@ if needed to reach the target.
--
-- Note: Simple Perception check is not enough for the check,
-- e.g., because the target actor can be obscured by a glass wall.
xhairLegalEps :: MonadClientUI m => m (Either Text Int)
xhairLegalEps :: m (Either Text X)
xhairLegalEps = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b) ()
      findNewEps :: Bool -> Point -> m (Either Text X)
findNewEps onlyFirst :: Bool
onlyFirst pos :: Point
pos = do
        X
oldEps <- (StateClient -> X) -> m X
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> X
seps
        Maybe X
mnewEps <- Bool -> Actor -> Point -> X -> m (Maybe X)
forall (m :: * -> *).
MonadStateRead m =>
Bool -> Actor -> Point -> X -> m (Maybe X)
makeLine Bool
onlyFirst Actor
b Point
pos X
oldEps
        Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$! case Maybe X
mnewEps of
          Just newEps :: X
newEps -> X -> Either Text X
forall a b. b -> Either a b
Right X
newEps
          Nothing -> Text -> Either Text X
forall a b. a -> Either a b
Left (Text -> Either Text X) -> Text -> Either Text X
forall a b. (a -> b) -> a -> b
$ if Bool
onlyFirst
                            then "aiming blocked at the first step"
                            else "aiming line blocked somewhere"
  Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
  case Maybe Target
xhair of
    Nothing -> Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "no aim designated"
    Just (TEnemy a :: ActorId
a) -> do
      Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
a
      let pos :: Point
pos = Actor -> Point
bpos Actor
body
      if Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV
      then Bool -> Point -> m (Either Text X)
findNewEps Bool
False Point
pos
      else Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "can't fling at an enemy on remote level"
    Just (TNonEnemy a :: ActorId
a) -> do
      Actor
body <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
a
      let pos :: Point
pos = Actor -> Point
bpos Actor
body
      if Actor -> LevelId
blid Actor
body LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV
      then Bool -> Point -> m (Either Text X)
findNewEps Bool
False Point
pos
      else Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "can't fling at a non-enemy on remote level"
    Just (TPoint TEnemyPos{} _ _) ->
      Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "selected opponent not visible"
    Just (TPoint _ lid :: LevelId
lid pos :: Point
pos) ->
      if LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV
      then Bool -> Point -> m (Either Text X)
findNewEps Bool
True Point
pos  -- @True@ to help pierce many foes, etc.
      else Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "can't fling at a target on remote level"
    Just (TVector v :: Vector
v) -> do
      -- Not @ScreenContent@, because not drawing here.
      COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: X
rXmax :: RuleContent -> X
rXmax, X
rYmax :: X
rYmax :: RuleContent -> X
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
      let shifted :: Point
shifted = X -> X -> Point -> Vector -> Point
shiftBounded X
rXmax X
rYmax (Actor -> Point
bpos Actor
b) Vector
v
      if Point
shifted Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b Bool -> Bool -> Bool
&& Vector
v Vector -> Vector -> Bool
forall a. Eq a => a -> a -> Bool
/= X -> X -> Vector
Vector 0 0
      then Either Text X -> m (Either Text X)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text X -> m (Either Text X))
-> Either Text X -> m (Either Text X)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text X
forall a b. a -> Either a b
Left "selected translation is void"
      else Bool -> Point -> m (Either Text X)
findNewEps Bool
True Point
shifted  -- @True@, because the goal is vague anyway

posFromXhair :: (MonadClient m, MonadClientUI m) => m (Either Text Point)
posFromXhair :: m (Either Text Point)
posFromXhair = do
  Either Text X
canAim <- m (Either Text X)
forall (m :: * -> *). MonadClientUI m => m (Either Text X)
xhairLegalEps
  case Either Text X
canAim of
    Right newEps :: X
newEps -> do
      -- Modify @seps@, permanently.
      (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli -> StateClient
cli {seps :: X
seps = X
newEps}
      Maybe Point
mpos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
      case Maybe Point
mpos of
        Nothing -> String -> m (Either Text Point)
forall a. HasCallStack => String -> a
error (String -> m (Either Text Point))
-> String -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ "" String -> Maybe Point -> String
forall v. Show v => String -> v -> String
`showFailure` Maybe Point
mpos
        Just pos :: Point
pos -> do
          Maybe ReqFailure
munit <- Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadClientUI m =>
Point -> m (Maybe ReqFailure)
projectCheck Point
pos
          case Maybe ReqFailure
munit of
            Nothing -> Either Text Point -> m (Either Text Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Point -> m (Either Text Point))
-> Either Text Point -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ Point -> Either Text Point
forall a b. b -> Either a b
Right Point
pos
            Just reqFail :: ReqFailure
reqFail -> Either Text Point -> m (Either Text Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Point -> m (Either Text Point))
-> Either Text Point -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Point
forall a b. a -> Either a b
Left (Text -> Either Text Point) -> Text -> Either Text Point
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
reqFail
    Left cause :: Text
cause -> Either Text Point -> m (Either Text Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Point -> m (Either Text Point))
-> Either Text Point -> m (Either Text Point)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Point
forall a b. a -> Either a b
Left Text
cause

-- | On top of @permittedProjectClient@, it also checks legality
-- of aiming at the target and projection range. It also modifies @eps@.
psuitReq :: (MonadClient m, MonadClientUI m)
         => m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq :: m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  if LevelId
lidV LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
b
  then Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (ItemFull -> Either ReqFailure (Point, Bool))
 -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool))))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
forall a b. a -> Either a b
Left "can't fling on remote level"
  else do
    Either Text Point
mpos <- m (Either Text Point)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Either Text Point)
posFromXhair
    ItemFull -> Either ReqFailure Bool
p <- m (ItemFull -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
m (ItemFull -> Either ReqFailure Bool)
permittedProjectClient
    case Either Text Point
mpos of
      Left err :: Text
err -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (ItemFull -> Either ReqFailure (Point, Bool))
 -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool))))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
forall a b. a -> Either a b
Left Text
err
      Right pos :: Point
pos -> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (ItemFull -> Either ReqFailure (Point, Bool))
 -> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool))))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall a b. (a -> b) -> a -> b
$ (ItemFull -> Either ReqFailure (Point, Bool))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
forall a b. b -> Either a b
Right ((ItemFull -> Either ReqFailure (Point, Bool))
 -> Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
-> (ItemFull -> Either ReqFailure (Point, Bool))
-> Either Text (ItemFull -> Either ReqFailure (Point, Bool))
forall a b. (a -> b) -> a -> b
$ \itemFull :: ItemFull
itemFull ->
        case ItemFull -> Either ReqFailure Bool
p ItemFull
itemFull of
          Left err :: ReqFailure
err -> ReqFailure -> Either ReqFailure (Point, Bool)
forall a b. a -> Either a b
Left ReqFailure
err
          Right False -> (Point, Bool) -> Either ReqFailure (Point, Bool)
forall a b. b -> Either a b
Right (Point
pos, Bool
False)
          Right True ->
            let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            in (Point, Bool) -> Either ReqFailure (Point, Bool)
forall a b. b -> Either a b
Right (Point
pos, AspectRecord -> ItemKind -> X
IA.totalRange AspectRecord
arItem (ItemFull -> ItemKind
itemKind ItemFull
itemFull)
                           X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= Point -> Point -> X
chessDist (Actor -> Point
bpos Actor
b) Point
pos)

triggerSymbols :: [TriggerItem] -> [Char]
triggerSymbols :: [TriggerItem] -> String
triggerSymbols [] = []
triggerSymbols (TriggerItem{String
tisymbols :: TriggerItem -> String
tisymbols :: String
tisymbols} : ts :: [TriggerItem]
ts) = String
tisymbols String -> String -> String
forall a. [a] -> [a] -> [a]
++ [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts

-- * ChooseItemApply

chooseItemApplyHuman :: forall m. MonadClientUI m => [TriggerItem] -> m MError
chooseItemApplyHuman :: [TriggerItem] -> m MError
chooseItemApplyHuman ts :: [TriggerItem]
ts = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
      cLegalRaw :: [CStore]
cLegalRaw = [CStore
CGround, CStore
CInv, CStore
CSha, CStore
CEqp]
      cLegal :: [CStore]
cLegal | Bool
calmE = [CStore]
cLegalRaw
             | Bool
otherwise = CStore -> [CStore] -> [CStore]
forall a. Eq a => a -> [a] -> [a]
delete CStore
CSha [CStore]
cLegalRaw
      (verb1 :: Part
verb1, object1 :: Part
object1) = case [TriggerItem]
ts of
        [] -> ("apply", "item")
        tr :: TriggerItem
tr : _ -> (TriggerItem -> Part
tiverb TriggerItem
tr, TriggerItem -> Part
tiobject TriggerItem
tr)
      triggerSyms :: String
triggerSyms = [TriggerItem] -> String
triggerSymbols [TriggerItem]
ts
      prompt :: Text
prompt = [Part] -> Text
makePhrase ["What", Part
object1, "to", Part
verb1]
      promptGeneric :: Text
promptGeneric = "What to apply"
  Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
  case Maybe (ItemId, CStore, Bool)
itemSel of
    Just (_, _, True) -> MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
    Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, False) -> do
      -- We don't validate vs @ts@ here, because player has selected
      -- this item, so he knows what he's doing (unless really absurd).
      ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
      EnumMap ItemId (X, ItemTimer)
bag <- (State -> EnumMap ItemId (X, ItemTimer))
-> m (EnumMap ItemId (X, ItemTimer))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> EnumMap ItemId (X, ItemTimer))
 -> m (EnumMap ItemId (X, ItemTimer)))
-> (State -> EnumMap ItemId (X, ItemTimer))
-> m (EnumMap ItemId (X, ItemTimer))
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> EnumMap ItemId (X, ItemTimer)
getBodyStoreBag Actor
b CStore
fromCStore
      ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool
mp <- m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
permittedApplyClient
      case ItemId
iid ItemId -> EnumMap ItemId (X, ItemTimer) -> Maybe (X, ItemTimer)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` EnumMap ItemId (X, ItemTimer)
bag of
        Just kit :: (X, ItemTimer)
kit | (ReqFailure -> Bool)
-> (Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) Bool -> Bool
forall a. a -> a
id (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool
mp ItemFull
itemFull (X, ItemTimer)
kit) ->
          MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
        _ -> do
          (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing}
          [TriggerItem] -> m MError
forall (m :: * -> *). MonadClientUI m => [TriggerItem] -> m MError
chooseItemApplyHuman [TriggerItem]
ts
    Nothing -> do
      let psuit :: m Suitability
          psuit :: m Suitability
psuit = do
            ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool
mp <- m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
forall (m :: * -> *).
MonadClientUI m =>
m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
permittedApplyClient
            Suitability -> m Suitability
forall (m :: * -> *) a. Monad m => a -> m a
return (Suitability -> m Suitability) -> Suitability -> m Suitability
forall a b. (a -> b) -> a -> b
$ (ItemFull -> (X, ItemTimer) -> Bool) -> Suitability
SuitsSomething ((ItemFull -> (X, ItemTimer) -> Bool) -> Suitability)
-> (ItemFull -> (X, ItemTimer) -> Bool) -> Suitability
forall a b. (a -> b) -> a -> b
$ \itemFull :: ItemFull
itemFull kit :: (X, ItemTimer)
kit ->
              (ReqFailure -> Bool)
-> (Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) Bool -> Bool
forall a. a -> a
id (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool
mp ItemFull
itemFull (X, ItemTimer)
kit)
              Bool -> Bool -> Bool
&& (String -> Bool
forall a. [a] -> Bool
null String
triggerSyms
                  Bool -> Bool -> Bool
|| ItemKind -> Char
IK.isymbol (ItemFull -> ItemKind
itemKind ItemFull
itemFull) Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
triggerSyms)
      Either
  Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi <- m Suitability
-> Text
-> Text
-> [CStore]
-> [CStore]
-> m (Either
        Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> Text
-> Text
-> [CStore]
-> [CStore]
-> m (Either
        Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
getGroupItem m Suitability
psuit Text
prompt Text
promptGeneric [CStore]
cLegalRaw [CStore]
cLegal
      case Either
  Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi of
        Right ((iid :: ItemId
iid, _itemFull :: ItemFull
_itemFull), (MStore fromCStore :: CStore
fromCStore, _)) -> do
          (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
            SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
fromCStore, Bool
False)}
          MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
        Left err :: Text
err -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
err
        _ -> String -> m MError
forall a. HasCallStack => String -> a
error (String -> m MError) -> String -> m MError
forall a b. (a -> b) -> a -> b
$ "" String
-> Either
     Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` Either
  Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
ggi

permittedApplyClient :: MonadClientUI m
                     => m (ItemFull -> ItemQuant -> Either ReqFailure Bool)
permittedApplyClient :: m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
permittedApplyClient = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  let skill :: X
skill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkApply Skills
actorSk
      calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
  (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
-> m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
 -> m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool))
-> (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
-> m (ItemFull -> (X, ItemTimer) -> Either ReqFailure Bool)
forall a b. (a -> b) -> a -> b
$ Time
-> X
-> Bool
-> ItemFull
-> (X, ItemTimer)
-> Either ReqFailure Bool
permittedApply Time
localTime X
skill Bool
calmE

-- * PickLeader

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

-- * PickLeaderWithPointer

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

-- * MemberCycle

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

-- * MemberBack

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

-- * SelectActor

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

selectAid :: MonadClientUI m => ActorId -> m ()
selectAid :: ActorId -> m ()
selectAid leader :: ActorId
leader = do
  ActorUI
bodyUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
  Bool
wasMemeber <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> Bool) -> m Bool) -> (SessionUI -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
leader (EnumSet ActorId -> Bool)
-> (SessionUI -> EnumSet ActorId) -> SessionUI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumSet ActorId
sselected
  let upd :: EnumSet ActorId -> EnumSet ActorId
upd = if Bool
wasMemeber
            then ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete ActorId
leader  -- already selected, deselect instead
            else ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ActorId
leader
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sselected :: EnumSet ActorId
sselected = EnumSet ActorId -> EnumSet ActorId
upd (EnumSet ActorId -> EnumSet ActorId)
-> EnumSet ActorId -> EnumSet ActorId
forall a b. (a -> b) -> a -> b
$ SessionUI -> EnumSet ActorId
sselected SessionUI
sess}
  let subject :: Part
subject = ActorUI -> Part
partActor ActorUI
bodyUI
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, if Bool
wasMemeber
                                     then "deselected"
                                     else "selected"]

-- * SelectNone

selectNoneHuman :: MonadClientUI m => m ()
selectNoneHuman :: m ()
selectNoneHuman = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  [ActorId]
oursIds <- (State -> [ActorId]) -> m [ActorId]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [ActorId]) -> m [ActorId])
-> (State -> [ActorId]) -> m [ActorId]
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> State -> [ActorId]
fidActorRegularIds FactionId
side LevelId
lidV
  let ours :: EnumSet ActorId
ours = [ActorId] -> EnumSet ActorId
forall k. Enum k => [k] -> EnumSet k
ES.fromDistinctAscList [ActorId]
oursIds
  EnumSet ActorId
oldSel <- (SessionUI -> EnumSet ActorId) -> m (EnumSet ActorId)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumSet ActorId
sselected
  let wasNone :: Bool
wasNone = EnumSet ActorId -> Bool
forall k. EnumSet k -> Bool
ES.null (EnumSet ActorId -> Bool) -> EnumSet ActorId -> Bool
forall a b. (a -> b) -> a -> b
$ EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.intersection EnumSet ActorId
ours EnumSet ActorId
oldSel
      upd :: EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
upd = if Bool
wasNone
            then EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.union  -- already all deselected; select all instead
            else EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. EnumSet k -> EnumSet k -> EnumSet k
ES.difference
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sselected :: EnumSet ActorId
sselected = EnumSet ActorId -> EnumSet ActorId -> EnumSet ActorId
upd (SessionUI -> EnumSet ActorId
sselected SessionUI
sess) EnumSet ActorId
ours}
  let subject :: Part
subject = "all party members on the level"
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makeSentence [Part
subject, if Bool
wasNone
                                     then "selected"
                                     else "deselected"]

-- * SelectWithPointer

selectWithPointerHuman :: MonadClientUI m => m MError
selectWithPointerHuman :: m MError
selectWithPointerHuman = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{X
rYmax :: X
rYmax :: RuleContent -> X
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  -- Not @ScreenContent@, because not drawing here.
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  [(ActorId, Actor)]
ours <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> [(ActorId, Actor)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ActorId, Actor) -> Bool) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Bool
bproj (Actor -> Bool)
-> ((ActorId, Actor) -> Actor) -> (ActorId, Actor) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd)
                      ([(ActorId, Actor)] -> [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> State -> [(ActorId, Actor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) LevelId
lidV
  ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
  let oursUI :: [(ActorId, Actor, ActorUI)]
oursUI = ((ActorId, Actor) -> (ActorId, Actor, ActorUI))
-> [(ActorId, Actor)] -> [(ActorId, Actor, ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(aid :: ActorId
aid, b :: Actor
b) -> (ActorId
aid, Actor
b, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, Actor)]
ours
      viewed :: [(ActorId, Actor, ActorUI)]
viewed = ((ActorId, Actor, ActorUI)
 -> (Bool, Bool, Bool, Char, Color, ActorId))
-> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ActorId, Actor, ActorUI)
-> (Bool, Bool, Bool, Char, Color, ActorId)
keySelected [(ActorId, Actor, ActorUI)]
oursUI
  Point{..} <- (SessionUI -> Point) -> m Point
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Point
spointer
  -- Select even if no space in status line for the actor's symbol.
  if | X
py X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
rYmax X -> X -> X
forall a. Num a => a -> a -> a
+ 2 Bool -> Bool -> Bool
&& X
px X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> m ()
forall (m :: * -> *). MonadClientUI m => m ()
selectNoneHuman m () -> m MError -> m MError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
     | X
py X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== X
rYmax X -> X -> X
forall a. Num a => a -> a -> a
+ 2 ->
         case X -> [(ActorId, Actor, ActorUI)] -> [(ActorId, Actor, ActorUI)]
forall a. X -> [a] -> [a]
drop (X
px X -> X -> X
forall a. Num a => a -> a -> a
- 1) [(ActorId, Actor, ActorUI)]
viewed of
           [] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "not pointing at an actor"
           (aid :: ActorId
aid, _, _) : _ -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
selectAid ActorId
aid m () -> m MError -> m MError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing
     | Bool
otherwise ->
         case ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> Maybe (ActorId, Actor)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(_, b :: Actor
b) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== X -> X -> Point
Point X
px (X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY)) [(ActorId, Actor)]
ours of
           Nothing -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "not pointing at an actor"
           Just (aid :: ActorId
aid, _) -> ActorId -> m ()
forall (m :: * -> *). MonadClientUI m => ActorId -> m ()
selectAid ActorId
aid m () -> m MError -> m MError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- * Repeat

-- Note that walk followed by repeat should not be equivalent to run,
-- because the player can really use a command that does not stop
-- at terrain change or when walking over items.
repeatHuman :: MonadClientUI m => Int -> m ()
repeatHuman :: X -> m ()
repeatHuman n :: X
n = do
  LastRecord _ seqPrevious :: [KM]
seqPrevious k :: X
k <- (SessionUI -> LastRecord) -> m LastRecord
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> LastRecord
slastRecord
  let macro :: [KM]
macro = [[KM]] -> [KM]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KM]] -> [KM]) -> [[KM]] -> [KM]
forall a b. (a -> b) -> a -> b
$ X -> [KM] -> [[KM]]
forall a. X -> a -> [a]
replicate X
n ([KM] -> [[KM]]) -> [KM] -> [[KM]]
forall a b. (a -> b) -> a -> b
$ [KM] -> [KM]
forall a. [a] -> [a]
reverse [KM]
seqPrevious
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {slastPlay :: [KM]
slastPlay = [KM]
macro [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ SessionUI -> [KM]
slastPlay SessionUI
sess}
  let slastRecord :: LastRecord
slastRecord = [KM] -> [KM] -> X -> LastRecord
LastRecord [] [] (if X
k X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 0 else X
maxK)
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {LastRecord
slastRecord :: LastRecord
slastRecord :: LastRecord
slastRecord}

maxK :: Int
maxK :: X
maxK = 100

-- * Record

recordHuman :: MonadClientUI m => m ()
recordHuman :: m ()
recordHuman = do
  [KM]
lastPlayOld <- (SessionUI -> [KM]) -> m [KM]
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> [KM]
slastPlay
  LastRecord _seqCurrent :: [KM]
_seqCurrent seqPrevious :: [KM]
seqPrevious k :: X
k <- (SessionUI -> LastRecord) -> m LastRecord
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> LastRecord
slastRecord
  case X
k of
    0 -> do
      let slastRecord :: LastRecord
slastRecord = [KM] -> [KM] -> X -> LastRecord
LastRecord [] [] X
maxK
      (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {LastRecord
slastRecord :: LastRecord
slastRecord :: LastRecord
slastRecord}
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([KM] -> Bool
forall a. [a] -> Bool
null [KM]
lastPlayOld) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        -- Don't spam if recording is a part of playing back a macro.
        Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Macro will be recorded for up to"
                     Text -> Text -> Text
<+> X -> Text
forall a. Show a => a -> Text
tshow X
maxK
                     Text -> Text -> Text
<+> "actions. Stop recording with the same key."
    _ -> do
      let slastRecord :: LastRecord
slastRecord = [KM] -> [KM] -> X -> LastRecord
LastRecord [KM]
seqPrevious [] 0
      (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {LastRecord
slastRecord :: LastRecord
slastRecord :: LastRecord
slastRecord}
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([KM] -> Bool
forall a. [a] -> Bool
null [KM]
lastPlayOld) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        -- Don't spam if recording is a part of playing back a macro.
        Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Macro recording stopped after"
                     Text -> Text -> Text
<+> X -> Text
forall a. Show a => a -> Text
tshow (X
maxK X -> X -> X
forall a. Num a => a -> a -> a
- X
k X -> X -> X
forall a. Num a => a -> a -> a
- 1) Text -> Text -> Text
<+> "actions."

-- * AllHistory

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

eitherHistory :: forall m. MonadClientUI m => Bool -> m ()
eitherHistory :: Bool -> m ()
eitherHistory showAll :: Bool
showAll = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: X
rwidth :: ScreenContent -> X
rwidth, X
rheight :: X
rheight :: ScreenContent -> X
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  History
history <- (SessionUI -> History) -> m History
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> History
shistory
  LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
arena
  Time
global <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
  let rh :: [AttrLine]
rh = History -> [AttrLine]
renderHistory History
history
      turnsGlobal :: X
turnsGlobal = Time
global Time -> Time -> X
`timeFitUp` Time
timeTurn
      turnsLocal :: X
turnsLocal = Time
localTime Time -> Time -> X
`timeFitUp` Time
timeTurn
      msg :: Text
msg = [Part] -> Text
makeSentence
        [ "You survived for"
        , X -> Part -> Part
MU.CarWs X
turnsGlobal "half-second turn"
        , "(this level:"
        , X -> Part
MU.Car X
turnsLocal Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> ")" ]
      kxs :: [(Either [KM] SlotChar, (X, X, X))]
kxs = [ (SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right SlotChar
sn, (SlotChar -> X
slotPrefix SlotChar
sn, 0, X
rwidth))
            | SlotChar
sn <- X -> [SlotChar] -> [SlotChar]
forall a. X -> [a] -> [a]
take ([AttrLine] -> X
forall a. [a] -> X
length [AttrLine]
rh) [SlotChar]
intSlots ]
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
msg
  Slideshow
okxs <- X -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
X -> [KM] -> OKX -> m Slideshow
overlayToSlideshow X
rheight [KM
K.escKM] ([AttrLine]
rh, [(Either [KM] SlotChar, (X, X, X))]
kxs)
  let displayAllHistory :: m ()
displayAllHistory = do
        Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
MonadClientUI m =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "history" ColorMode
ColorFull Bool
True Slideshow
okxs
                                   [KM
K.spaceKM, KM
K.escKM]
        case Either KM SlotChar
ekm of
          Left km :: KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.escKM ->
            Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 "Try to survive a few seconds more, if you can."
          Left km :: KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.spaceKM ->  -- click in any unused space
            Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 "Steady on."
          Right SlotChar{..} | Char
slotChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'a' ->
            X -> m ()
displayOneReport X
slotPrefix
          _ -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "" String -> Either KM SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` Either KM SlotChar
ekm
      histBound :: X
histBound = History -> X
lengthHistory History
history X -> X -> X
forall a. Num a => a -> a -> a
- 1
      displayOneReport :: Int -> m ()
      displayOneReport :: X -> m ()
displayOneReport histSlot :: X
histSlot = do
        let timeReport :: AttrLine
timeReport = case X -> [AttrLine] -> [AttrLine]
forall a. X -> [a] -> [a]
drop X
histSlot [AttrLine]
rh of
              [] -> String -> AttrLine
forall a. HasCallStack => String -> a
error (String -> AttrLine) -> String -> AttrLine
forall a b. (a -> b) -> a -> b
$ "" String -> X -> String
forall v. Show v => String -> v -> String
`showFailure` X
histSlot
              tR :: AttrLine
tR : _ -> AttrLine
tR
            ov0 :: [AttrLine]
ov0 = X -> AttrLine -> [AttrLine]
indentSplitAttrLine X
rwidth AttrLine
timeReport
            prompt :: Text
prompt = [Part] -> Text
makeSentence
              [ "the", X -> Part
MU.Ordinal (X -> Part) -> X -> Part
forall a b. (a -> b) -> a -> b
$ X
histSlot X -> X -> X
forall a. Num a => a -> a -> a
+ 1
              , "record of all history follows" ]
            keys :: [KM]
keys = [KM
K.spaceKM, KM
K.escKM] [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.upKM | X
histSlot X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= 0]
                                        [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM
K.downKM | X
histSlot X -> X -> Bool
forall a. Eq a => a -> a -> Bool
/= X
histBound]
        Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
prompt
        Slideshow
slides <- X -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
X -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2) [KM]
keys ([AttrLine]
ov0, [])
        KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
        case KM -> Key
K.key KM
km of
          K.Space -> m ()
displayAllHistory
          K.Up -> X -> m ()
displayOneReport (X -> m ()) -> X -> m ()
forall a b. (a -> b) -> a -> b
$ X
histSlot X -> X -> X
forall a. Num a => a -> a -> a
- 1
          K.Down -> X -> m ()
displayOneReport (X -> m ()) -> X -> m ()
forall a b. (a -> b) -> a -> b
$ X
histSlot X -> X -> X
forall a. Num a => a -> a -> a
+ 1
          K.Esc -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 "Try to learn from your previous mistakes."
          _ -> String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
  if Bool
showAll then m ()
displayAllHistory else X -> m ()
displayOneReport ([AttrLine] -> X
forall a. [a] -> X
length [AttrLine]
rh X -> X -> X
forall a. Num a => a -> a -> a
- 1)

-- * LastHistory

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

-- * MarkVision

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

-- * MarkSmell

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

-- * MarkSuspect

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

-- * PrintScreen
printScreenHuman :: MonadClientUI m => m ()
printScreenHuman :: m ()
printScreenHuman = do
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd "Screenshot printed."
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
printScreen

-- * Cancel

-- | End aiming mode, rejecting the current position.
cancelHuman :: MonadClientUI m => m ()
cancelHuman :: m ()
cancelHuman = do
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode) m ()
forall (m :: * -> *). MonadClientUI m => m ()
clearAimMode

-- * Accept

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

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

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

-- * ClearTargetIfItemClear

clearTargetIfItemClearHuman :: (MonadClient m, MonadClientUI m) => m ()
clearTargetIfItemClearHuman :: m ()
clearTargetIfItemClearHuman = do
  Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (ItemId, CStore, Bool) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (ItemId, CStore, Bool)
itemSel) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sxhair :: Maybe Target
sxhair = Maybe Target
forall a. Maybe a
Nothing}
    ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
    (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
updateTarget ActorId
leader (Maybe Target -> Maybe Target -> Maybe Target
forall a b. a -> b -> a
const Maybe Target
forall a. Maybe a
Nothing)
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook

-- | Perform look around in the current position of the xhair.
-- Does nothing outside aiming mode.
doLook :: MonadClientUI m => m ()
doLook :: m ()
doLook = do
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  case Maybe AimMode
saimMode of
    Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just aimMode :: AimMode
aimMode -> do
      ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
      let lidV :: LevelId
lidV = AimMode -> LevelId
aimLevelId AimMode
aimMode
      Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
      Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
      let xhairPos :: Point
xhairPos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe (Actor -> Point
bpos Actor
b) Maybe Point
mxhairPos
      Text
blurb <- LevelId -> Point -> m Text
forall (m :: * -> *). MonadClientUI m => LevelId -> Point -> m Text
lookAtPosition LevelId
lidV Point
xhairPos
      Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
blurb

-- * ItemClear

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

-- * MoveXhair

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

-- * AimTgt

-- | Start aiming.
aimTgtHuman :: MonadClientUI m => m MError
aimTgtHuman :: m MError
aimTgtHuman = do
  -- (Re)start aiming at the current level.
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV}
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
  Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "aiming started"

-- * AimFloor

-- | Cycle aiming mode. Do not change position of the xhair,
-- switch among things at that position.
aimFloorHuman :: MonadClientUI m => m ()
aimFloorHuman :: m ()
aimFloorHuman = do
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Point
lpos <- (State -> Point) -> m Point
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Point) -> m Point) -> (State -> Point) -> m Point
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
  Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
  Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  [(ActorId, Actor)]
bsAll <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (Bool -> FactionId -> Bool
forall a b. a -> b -> a
const Bool
True) LevelId
lidV
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  let xhairPos :: Point
xhairPos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
lpos Maybe Point
mxhairPos
      sxhair :: Maybe Target
sxhair = case Maybe Target
xhair of
        _ | Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
saimMode ->  -- first key press: keep target
          Maybe Target
xhair
        Just TEnemy{} -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidV Point
xhairPos
        Just TNonEnemy{} -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidV Point
xhairPos
        Just TPoint{} | Point
xhairPos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
lpos ->
          Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ Vector -> Target
TVector (Vector -> Target) -> Vector -> Target
forall a b. (a -> b) -> a -> b
$ Point
xhairPos Point -> Point -> Vector
`vectorToFrom` Point
lpos
        Just TVector{} ->
          -- If many actors, we pick here the first that would be picked
          -- by '*', so that all other projectiles on the tile come next,
          -- when pressing "*", without any intervening actors from other tiles.
          -- This is why we use @actorAssocs@ above instead of @posToAidAssocs@.
          case ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> Maybe (ActorId, Actor)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(_, b :: Actor
b) -> Point -> Maybe Point
forall a. a -> Maybe a
Just (Actor -> Point
bpos Actor
b) Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Point
mxhairPos) [(ActorId, Actor)]
bsAll of
            Just (aid :: ActorId
aid, b :: Actor
b) -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ if FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b)
                                    then ActorId -> Target
TEnemy ActorId
aid
                                    else ActorId -> Target
TNonEnemy ActorId
aid
            Nothing -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown LevelId
lidV Point
xhairPos
        _ -> Maybe Target
xhair
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess { saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV
                                , Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair }
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook

-- * AimEnemy

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

-- * AimItem

aimItemHuman :: MonadClientUI m => m ()
aimItemHuman :: m ()
aimItemHuman = do
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Point
lpos <- (State -> Point) -> m Point
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Point) -> m Point) -> (State -> Point) -> m Point
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
  Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
  Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  [Point]
bsAll <- (State -> [Point]) -> m [Point]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [Point]) -> m [Point])
-> (State -> [Point]) -> m [Point]
forall a b. (a -> b) -> a -> b
$ EnumMap Point (EnumMap ItemId (X, ItemTimer)) -> [Point]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (EnumMap Point (EnumMap ItemId (X, ItemTimer)) -> [Point])
-> (State -> EnumMap Point (EnumMap ItemId (X, ItemTimer)))
-> State
-> [Point]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Level -> EnumMap Point (EnumMap ItemId (X, ItemTimer))
lfloor (Level -> EnumMap Point (EnumMap ItemId (X, ItemTimer)))
-> (State -> Level)
-> State
-> EnumMap Point (EnumMap ItemId (X, ItemTimer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap LevelId Level -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lidV) (EnumMap LevelId Level -> Level)
-> (State -> EnumMap LevelId Level) -> State -> Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap LevelId Level
sdungeon
  let ordPos :: Point -> (X, Point)
ordPos p :: Point
p = (Point -> Point -> X
chessDist Point
lpos Point
p, Point
p)
      dbs :: [Point]
dbs = (Point -> (X, Point)) -> [Point] -> [Point]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Point -> (X, Point)
ordPos [Point]
bsAll
      pickUnderXhair :: ([Point], [Point])
pickUnderXhair =  -- switch to the item under xhair, if any
        let i :: X
i = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (-1)
                (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
findIndex ((Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Point
mxhairPos) (Maybe Point -> Bool) -> (Point -> Maybe Point) -> Point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Maybe Point
forall a. a -> Maybe a
Just) [Point]
dbs
        in X -> [Point] -> ([Point], [Point])
forall a. X -> [a] -> ([a], [a])
splitAt X
i [Point]
dbs
      (lt :: [Point]
lt, gt :: [Point]
gt) = case Maybe Target
xhair of
        Just (TPoint _ lid :: LevelId
lid pos :: Point
pos)
          | Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
saimMode Bool -> Bool -> Bool
&& LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV ->  -- pick next item
            let i :: X
i = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (-1) (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
findIndex (Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pos) [Point]
dbs
            in X -> [Point] -> ([Point], [Point])
forall a. X -> [a] -> ([a], [a])
splitAt (X
i X -> X -> X
forall a. Num a => a -> a -> a
+ 1) [Point]
dbs
        Just (TPoint _ lid :: LevelId
lid pos :: Point
pos)
          | LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lidV ->  -- first key press, retarget old item
            let i :: X
i = X -> Maybe X -> X
forall a. a -> Maybe a -> a
fromMaybe (-1) (Maybe X -> X) -> Maybe X -> X
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> Maybe X
forall a. (a -> Bool) -> [a] -> Maybe X
findIndex (Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
pos) [Point]
dbs
            in X -> [Point] -> ([Point], [Point])
forall a. X -> [a] -> ([a], [a])
splitAt X
i [Point]
dbs
        _ -> ([Point], [Point])
pickUnderXhair
      gtlt :: [Point]
gtlt = [Point]
gt [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ [Point]
lt
      sxhair :: Maybe Target
sxhair = case [Point]
gtlt of
        p :: Point
p : _ -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidV Point
p  -- don't force AI to collect it
        [] -> Maybe Target
xhair  -- no items remembered, stick to last target
  -- Register the chosen enemy, to pick another on next invocation.
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess { saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV
                                , Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair }
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook

-- * 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 :: X -> m MError
aimAscendHuman k :: X
k = do
  EnumMap LevelId Level
dungeon <- (State -> EnumMap LevelId Level) -> m (EnumMap LevelId Level)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap LevelId Level
sdungeon
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  let up :: Bool
up = X
k X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0
  case EnumMap LevelId Level -> Bool -> LevelId -> [LevelId]
ascendInBranch EnumMap LevelId Level
dungeon Bool
up LevelId
lidV of
    [] -> Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "no more levels in this direction"
    _ : _ -> do
      let ascendOne :: LevelId -> LevelId
ascendOne lid :: LevelId
lid = case EnumMap LevelId Level -> Bool -> LevelId -> [LevelId]
ascendInBranch EnumMap LevelId Level
dungeon Bool
up LevelId
lid of
            [] -> LevelId
lid
            nlid :: LevelId
nlid : _ -> LevelId
nlid
          lidK :: LevelId
lidK = (LevelId -> LevelId) -> LevelId -> [LevelId]
forall a. (a -> a) -> a -> [a]
iterate LevelId -> LevelId
ascendOne LevelId
lidV [LevelId] -> X -> LevelId
forall a. [a] -> X -> a
!! X -> X
forall a. Num a => a -> a
abs X
k
      ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
      Point
lpos <- (State -> Point) -> m Point
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Point) -> m Point) -> (State -> Point) -> m Point
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos (Actor -> Point) -> (State -> Actor) -> State -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
leader
      Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
      let xhairPos :: Point
xhairPos = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe Point
lpos Maybe Point
mxhairPos
          sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TKnown LevelId
lidK Point
xhairPos
      (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess { saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (LevelId -> AimMode
AimMode LevelId
lidK)
                                    , Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair }
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
      MError -> m MError
forall (m :: * -> *) a. Monad m => a -> m a
return MError
forall a. Maybe a
Nothing

-- * EpsIncr

-- | Tweak the @eps@ parameter of the aiming digital line.
epsIncrHuman :: (MonadClient m, MonadClientUI m) => Bool -> m ()
epsIncrHuman :: Bool -> m ()
epsIncrHuman b :: Bool
b = do
  Maybe AimMode
saimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV}
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli -> StateClient
cli {seps :: X
seps = StateClient -> X
seps StateClient
cli X -> X -> X
forall a. Num a => a -> a -> a
+ if Bool
b then 1 else -1}
  m ()
forall (m :: * -> *). MonadClient m => m ()
invalidateBfsPathAll
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
flashAiming
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {Maybe AimMode
saimMode :: Maybe AimMode
saimMode :: Maybe AimMode
saimMode}

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

-- * XhairUnknown

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

-- * XhairItem

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

-- * XhairStair

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

-- * XhairPointerFloor

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

-- * XhairPointerEnemy

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

-- * AimPointerFloor

aimPointerFloorHuman :: MonadClientUI m => m ()
aimPointerFloorHuman :: m ()
aimPointerFloorHuman = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: X
rXmax :: RuleContent -> X
rXmax, X
rYmax :: X
rYmax :: RuleContent -> X
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  -- Not @ScreenContent@, because not drawing here.
  Point{..} <- (SessionUI -> Point) -> m Point
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Point
spointer
  if X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
     Bool -> Bool -> Bool
&& X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rXmax Bool -> Bool -> Bool
&& X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rYmax
  then do
    Maybe Target
oldXhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
    let sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown LevelId
lidV (Point -> Target) -> Point -> Target
forall a b. (a -> b) -> a -> b
$ X -> X -> Point
Point X
px (X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY)
        sxhairMoused :: Bool
sxhairMoused = Maybe Target
sxhair Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
oldXhair
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
      SessionUI
sess { saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV
           , Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair
           , Bool
sxhairMoused :: Bool
sxhairMoused :: Bool
sxhairMoused }
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
  else m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack

-- * AimPointerEnemy

aimPointerEnemyHuman :: MonadClientUI m => m ()
aimPointerEnemyHuman :: m ()
aimPointerEnemyHuman = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: X
rXmax :: RuleContent -> X
rXmax, X
rYmax :: X
rYmax :: RuleContent -> X
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  -- Not @ScreenContent@, because not drawing here.
  Point{..} <- (SessionUI -> Point) -> m Point
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Point
spointer
  if X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
     Bool -> Bool -> Bool
&& X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rXmax Bool -> Bool -> Bool
&& X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rYmax
  then do
    [(ActorId, Actor)]
bsAll <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (Bool -> FactionId -> Bool
forall a b. a -> b -> a
const Bool
True) LevelId
lidV
    Maybe Target
oldXhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
    FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
    let newPos :: Point
newPos = X -> X -> Point
Point X
px (X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY)
        sxhair :: Maybe Target
sxhair =
          -- If many actors, we pick here the first that would be picked
          -- by '*', so that all other projectiles on the tile come next,
          -- when pressing "*", without any intervening actors from other tiles.
          -- This is why we use @actorAssocs@ above instead of @posToAidAssocs@.
          case ((ActorId, Actor) -> Bool)
-> [(ActorId, Actor)] -> Maybe (ActorId, Actor)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(_, b :: Actor
b) -> Actor -> Point
bpos Actor
b Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
newPos) [(ActorId, Actor)]
bsAll of
            Just (aid :: ActorId
aid, b :: Actor
b) -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ if FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b)
                                    then ActorId -> Target
TEnemy ActorId
aid
                                    else ActorId -> Target
TNonEnemy ActorId
aid
            Nothing -> Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown LevelId
lidV Point
newPos
        sxhairMoused :: Bool
sxhairMoused = Maybe Target
sxhair Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
oldXhair
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
      SessionUI
sess { saimMode :: Maybe AimMode
saimMode = AimMode -> Maybe AimMode
forall a. a -> Maybe a
Just (AimMode -> Maybe AimMode) -> AimMode -> Maybe AimMode
forall a b. (a -> b) -> a -> b
$ LevelId -> AimMode
AimMode LevelId
lidV
           , Bool
sxhairMoused :: Bool
sxhairMoused :: Bool
sxhairMoused
           , Maybe Target
sxhair :: Maybe Target
sxhair :: Maybe Target
sxhair }
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
doLook
  else m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack