module Game.LambdaHack.Client.UI.InventoryM
( Suitability(..)
, getFull, getGroupItem, getStoreItem
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.Char as Char
import Data.Either
import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T
import Data.Tuple (swap)
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.State
import Game.LambdaHack.Client.UI.ActorUI
import Game.LambdaHack.Client.UI.Content.Screen
import Game.LambdaHack.Client.UI.ContentClientUI
import Game.LambdaHack.Client.UI.HandleHelperM
import Game.LambdaHack.Client.UI.HumanCmd
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.MsgM
import Game.LambdaHack.Client.UI.Overlay
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Client.UI.Slideshow
import Game.LambdaHack.Client.UI.SlideshowM
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.ReqFailure
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
data ItemDialogState = ISuitable | IAll
deriving (Int -> ItemDialogState -> ShowS
[ItemDialogState] -> ShowS
ItemDialogState -> String
(Int -> ItemDialogState -> ShowS)
-> (ItemDialogState -> String)
-> ([ItemDialogState] -> ShowS)
-> Show ItemDialogState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemDialogState] -> ShowS
$cshowList :: [ItemDialogState] -> ShowS
show :: ItemDialogState -> String
$cshow :: ItemDialogState -> String
showsPrec :: Int -> ItemDialogState -> ShowS
$cshowsPrec :: Int -> ItemDialogState -> ShowS
Show, ItemDialogState -> ItemDialogState -> Bool
(ItemDialogState -> ItemDialogState -> Bool)
-> (ItemDialogState -> ItemDialogState -> Bool)
-> Eq ItemDialogState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemDialogState -> ItemDialogState -> Bool
$c/= :: ItemDialogState -> ItemDialogState -> Bool
== :: ItemDialogState -> ItemDialogState -> Bool
$c== :: ItemDialogState -> ItemDialogState -> Bool
Eq)
accessModeBag :: ActorId -> State -> ItemDialogMode -> ItemBag
accessModeBag :: ActorId -> State -> ItemDialogMode -> ItemBag
accessModeBag leader :: ActorId
leader s :: State
s (MStore cstore :: CStore
cstore) = let b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
leader State
s
in Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
cstore State
s
accessModeBag leader :: ActorId
leader s :: State
s MOrgans = let b :: Actor
b = ActorId -> State -> Actor
getActorBody ActorId
leader State
s
in Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
COrgan State
s
accessModeBag leader :: ActorId
leader s :: State
s MOwned = let fid :: FactionId
fid = Actor -> FactionId
bfid (Actor -> FactionId) -> Actor -> FactionId
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader State
s
in FactionId -> State -> ItemBag
combinedItems FactionId
fid State
s
accessModeBag _ _ MSkills = ItemBag
forall k a. EnumMap k a
EM.empty
accessModeBag _ s :: State
s MLore{} = (Item -> (Int, [Time])) -> EnumMap ItemId Item -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map ((Int, [Time]) -> Item -> (Int, [Time])
forall a b. a -> b -> a
const (1, [])) (EnumMap ItemId Item -> ItemBag) -> EnumMap ItemId Item -> ItemBag
forall a b. (a -> b) -> a -> b
$ State -> EnumMap ItemId Item
sitemD State
s
accessModeBag _ _ MPlaces = ItemBag
forall k a. EnumMap k a
EM.empty
getGroupItem :: MonadClientUI m
=> m Suitability
-> Text
-> Text
-> [CStore]
-> [CStore]
-> m (Either Text ( (ItemId, ItemFull)
, (ItemDialogMode, Either K.KM SlotChar) ))
getGroupItem :: m Suitability
-> Text
-> Text
-> [CStore]
-> [CStore]
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
getGroupItem psuit :: m Suitability
psuit prompt :: Text
prompt promptGeneric :: Text
promptGeneric
cLegalRaw :: [CStore]
cLegalRaw cLegalAfterCalm :: [CStore]
cLegalAfterCalm = do
Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
soc <- m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> [CStore]
-> Bool
-> Bool
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> [CStore]
-> Bool
-> Bool
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
getFull m Suitability
psuit
(\_ _ _ cCur :: ItemDialogMode
cCur _ -> Text
prompt Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur)
(\_ _ _ cCur :: ItemDialogMode
cCur _ -> Text
promptGeneric Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur)
[CStore]
cLegalRaw [CStore]
cLegalAfterCalm Bool
True Bool
False
case Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
soc of
Left err :: Text
err -> Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))))
-> Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ Text
-> Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
forall a b. a -> Either a b
Left Text
err
Right ([(iid :: ItemId
iid, (itemFull :: ItemFull
itemFull, _))], cekm :: (ItemDialogMode, Either KM SlotChar)
cekm) ->
Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))))
-> Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
-> Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))
forall a b. b -> Either a b
Right ((ItemId
iid, ItemFull
itemFull), (ItemDialogMode, Either KM SlotChar)
cekm)
Right _ -> String
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall a. HasCallStack => String -> a
error (String
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar))))
-> String
-> m (Either
Text ((ItemId, ItemFull), (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ "" String
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
soc
getStoreItem :: MonadClientUI m
=> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> ItemDialogMode
-> m ( Either Text (ItemId, ItemBag, SingleItemSlots)
, (ItemDialogMode, Either K.KM SlotChar) )
getStoreItem :: (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> m (Either Text (ItemId, ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
getStoreItem prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt cInitial :: ItemDialogMode
cInitial = do
let itemCs :: [ItemDialogMode]
itemCs = (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore
CEqp, CStore
CInv, CStore
CGround, CStore
CSha]
loreCs :: [ItemDialogMode]
loreCs = (SLore -> ItemDialogMode) -> [SLore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map SLore -> ItemDialogMode
MLore [SLore
forall a. Bounded a => a
minBound..SLore
forall a. Bounded a => a
maxBound] [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode
MPlaces]
allCs :: [ItemDialogMode]
allCs = case ItemDialogMode
cInitial of
MLore{} -> [ItemDialogMode]
loreCs
MPlaces -> [ItemDialogMode]
loreCs
_ -> [ItemDialogMode]
itemCs [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode
MOwned, ItemDialogMode
MOrgans, ItemDialogMode
MSkills]
(pre :: [ItemDialogMode]
pre, rest :: [ItemDialogMode]
rest) = (ItemDialogMode -> Bool)
-> [ItemDialogMode] -> ([ItemDialogMode], [ItemDialogMode])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
== ItemDialogMode
cInitial) [ItemDialogMode]
allCs
post :: [ItemDialogMode]
post = (ItemDialogMode -> Bool) -> [ItemDialogMode] -> [ItemDialogMode]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
== ItemDialogMode
cInitial) [ItemDialogMode]
rest
remCs :: [ItemDialogMode]
remCs = [ItemDialogMode]
post [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode]
pre
(Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
soc <- m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> [ItemDialogMode]
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> [ItemDialogMode]
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
getItem (Suitability -> m Suitability
forall (m :: * -> *) a. Monad m => a -> m a
return Suitability
SuitsEverything)
Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt ItemDialogMode
cInitial [ItemDialogMode]
remCs
Bool
True Bool
False (ItemDialogMode
cInitial ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
remCs)
case (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
soc of
(Left err :: Text
err, cekm :: (ItemDialogMode, Either KM SlotChar)
cekm) -> (Either Text (ItemId, ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text (ItemId, ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text (ItemId, ItemBag, SingleItemSlots)
forall a b. a -> Either a b
Left Text
err, (ItemDialogMode, Either KM SlotChar)
cekm)
(Right ([iid :: ItemId
iid], itemBag :: ItemBag
itemBag, lSlots :: SingleItemSlots
lSlots), cekm :: (ItemDialogMode, Either KM SlotChar)
cekm) ->
(Either Text (ItemId, ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text (ItemId, ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ItemId, ItemBag, SingleItemSlots)
-> Either Text (ItemId, ItemBag, SingleItemSlots)
forall a b. b -> Either a b
Right (ItemId
iid, ItemBag
itemBag, SingleItemSlots
lSlots), (ItemDialogMode, Either KM SlotChar)
cekm)
(Right{}, _) -> String
-> m (Either Text (ItemId, ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall a. HasCallStack => String -> a
error (String
-> m (Either Text (ItemId, ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> String
-> m (Either Text (ItemId, ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$ "" String
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
soc
getFull :: MonadClientUI m
=> m Suitability
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> [CStore]
-> [CStore]
-> Bool
-> Bool
-> m (Either Text ( [(ItemId, ItemFullKit)]
, (ItemDialogMode, Either K.KM SlotChar) ))
getFull :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> [CStore]
-> Bool
-> Bool
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
getFull psuit :: m Suitability
psuit prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt promptGeneric :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric cLegalRaw :: [CStore]
cLegalRaw cLegalAfterCalm :: [CStore]
cLegalAfterCalm
askWhenLone :: Bool
askWhenLone permitMulitple :: Bool
permitMulitple = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
let aidNotEmpty :: CStore -> ActorId -> m Bool
aidNotEmpty store :: CStore
store aid :: ActorId
aid = 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
aid
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
body CStore
store
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
bag
partyNotEmpty :: CStore -> m Bool
partyNotEmpty store :: CStore
store = do
[(ActorId, Actor)]
as <- (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
[Bool]
bs <- ((ActorId, Actor) -> m Bool) -> [(ActorId, Actor)] -> m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CStore -> ActorId -> m Bool
forall (m :: * -> *).
MonadStateRead m =>
CStore -> ActorId -> m Bool
aidNotEmpty CStore
store (ActorId -> m Bool)
-> ((ActorId, Actor) -> ActorId) -> (ActorId, Actor) -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst) [(ActorId, Actor)]
as
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
bs
Suitability
mpsuit <- m Suitability
psuit
let psuitFun :: ItemFull -> (Int, [Time]) -> Bool
psuitFun = case Suitability
mpsuit of
SuitsEverything -> \_ _ -> Bool
True
SuitsSomething f :: ItemFull -> (Int, [Time]) -> Bool
f -> ItemFull -> (Int, [Time]) -> Bool
f
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
CStore -> ItemBag
getCStoreBag <- (State -> CStore -> ItemBag) -> m (CStore -> ItemBag)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> CStore -> ItemBag) -> m (CStore -> ItemBag))
-> (State -> CStore -> ItemBag) -> m (CStore -> ItemBag)
forall a b. (a -> b) -> a -> b
$ \s :: State
s cstore :: CStore
cstore -> Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
cstore State
s
let hasThisActor :: CStore -> Bool
hasThisActor = Bool -> Bool
not (Bool -> Bool) -> (CStore -> Bool) -> CStore -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null (ItemBag -> Bool) -> (CStore -> ItemBag) -> CStore -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CStore -> ItemBag
getCStoreBag
case (CStore -> Bool) -> [CStore] -> [CStore]
forall a. (a -> Bool) -> [a] -> [a]
filter CStore -> Bool
hasThisActor [CStore]
cLegalAfterCalm of
[] ->
if Maybe CStore -> Bool
forall a. Maybe a -> Bool
isNothing ((CStore -> Bool) -> [CStore] -> Maybe CStore
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find CStore -> Bool
hasThisActor [CStore]
cLegalRaw) then do
let contLegalRaw :: [ItemDialogMode]
contLegalRaw = (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore]
cLegalRaw
tLegal :: [Part]
tLegal = (ItemDialogMode -> Part) -> [ItemDialogMode] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Part
MU.Text (Text -> Part)
-> (ItemDialogMode -> Text) -> ItemDialogMode -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemDialogMode -> Text
ppItemDialogModeIn) [ItemDialogMode]
contLegalRaw
ppLegal :: Text
ppLegal = [Part] -> Text
makePhrase [Part -> [Part] -> Part
MU.WWxW "nor" [Part]
tLegal]
Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))))
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ Text
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. a -> Either a b
Left (Text
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
-> Text
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$ "no items" Text -> Text -> Text
<+> Text
ppLegal
else Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))))
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ Text
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. a -> Either a b
Left (Text
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
-> Text
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$ ReqFailure -> Text
showReqFailure ReqFailure
ItemNotCalm
haveThis :: [CStore]
haveThis@(headThisActor :: CStore
headThisActor : _) -> do
ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
let suitsThisActor :: CStore -> Bool
suitsThisActor store :: CStore
store =
let bag :: ItemBag
bag = CStore -> ItemBag
getCStoreBag CStore
store
in ((ItemId, (Int, [Time])) -> Bool)
-> [(ItemId, (Int, [Time]))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(iid :: ItemId
iid, kit :: (Int, [Time])
kit) -> ItemFull -> (Int, [Time]) -> Bool
psuitFun (ItemId -> ItemFull
itemToF ItemId
iid) (Int, [Time])
kit) ([(ItemId, (Int, [Time]))] -> Bool)
-> [(ItemId, (Int, [Time]))] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, (Int, [Time]))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag
firstStore :: CStore
firstStore = CStore -> Maybe CStore -> CStore
forall a. a -> Maybe a -> a
fromMaybe CStore
headThisActor (Maybe CStore -> CStore) -> Maybe CStore -> CStore
forall a b. (a -> b) -> a -> b
$ (CStore -> Bool) -> [CStore] -> Maybe CStore
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find CStore -> Bool
suitsThisActor [CStore]
haveThis
[CStore]
cLegal <- (CStore -> m Bool) -> [CStore] -> m [CStore]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM CStore -> m Bool
partyNotEmpty [CStore]
cLegalRaw
let breakStores :: CStore -> (ItemDialogMode, [ItemDialogMode])
breakStores cInit :: CStore
cInit =
let (pre :: [CStore]
pre, rest :: [CStore]
rest) = (CStore -> Bool) -> [CStore] -> ([CStore], [CStore])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
cInit) [CStore]
cLegal
post :: [CStore]
post = (CStore -> Bool) -> [CStore] -> [CStore]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
cInit) [CStore]
rest
in (CStore -> ItemDialogMode
MStore CStore
cInit, (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore ([CStore] -> [ItemDialogMode]) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> a -> b
$ [CStore]
post [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore]
pre)
let (modeFirst :: ItemDialogMode
modeFirst, modeRest :: [ItemDialogMode]
modeRest) = CStore -> (ItemDialogMode, [ItemDialogMode])
breakStores CStore
firstStore
(Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
res <- m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> [ItemDialogMode]
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> [ItemDialogMode]
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
getItem m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric ItemDialogMode
modeFirst [ItemDialogMode]
modeRest
Bool
askWhenLone Bool
permitMulitple ((CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore]
cLegal)
case (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
res of
(Left t :: Text
t, _) -> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))))
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ Text
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. a -> Either a b
Left Text
t
(Right (iids :: [ItemId]
iids, itemBag :: ItemBag
itemBag, _lSlots :: SingleItemSlots
_lSlots), cekm :: (ItemDialogMode, Either KM SlotChar)
cekm) -> do
let f :: ItemId -> (ItemId, ItemFullKit)
f iid :: ItemId
iid = (ItemId
iid, (ItemId -> ItemFull
itemToF ItemId
iid, ItemBag
itemBag ItemBag -> ItemId -> (Int, [Time])
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid))
Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))))
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> m (Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar)))
forall a b. (a -> b) -> a -> b
$ ([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
-> Either
Text
([(ItemId, ItemFullKit)], (ItemDialogMode, Either KM SlotChar))
forall a b. b -> Either a b
Right ((ItemId -> (ItemId, ItemFullKit))
-> [ItemId] -> [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> [a] -> [b]
map ItemId -> (ItemId, ItemFullKit)
f [ItemId]
iids, (ItemDialogMode, Either KM SlotChar)
cekm)
getItem :: MonadClientUI m
=> m Suitability
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> [ItemDialogMode]
-> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)
, (ItemDialogMode, Either K.KM SlotChar) )
getItem :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> [ItemDialogMode]
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
getItem psuit :: m Suitability
psuit prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt promptGeneric :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric cCur :: ItemDialogMode
cCur cRest :: [ItemDialogMode]
cRest askWhenLone :: Bool
askWhenLone permitMulitple :: Bool
permitMulitple
cLegal :: [ItemDialogMode]
cLegal = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
ItemDialogMode -> ItemBag
accessCBag <- (State -> ItemDialogMode -> ItemBag)
-> m (ItemDialogMode -> ItemBag)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemDialogMode -> ItemBag)
-> m (ItemDialogMode -> ItemBag))
-> (State -> ItemDialogMode -> ItemBag)
-> m (ItemDialogMode -> ItemBag)
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> ItemDialogMode -> ItemBag
accessModeBag ActorId
leader
let storeAssocs :: ItemDialogMode -> [(ItemId, (Int, [Time]))]
storeAssocs = ItemBag -> [(ItemId, (Int, [Time]))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (ItemBag -> [(ItemId, (Int, [Time]))])
-> (ItemDialogMode -> ItemBag)
-> ItemDialogMode
-> [(ItemId, (Int, [Time]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemDialogMode -> ItemBag
accessCBag
allAssocs :: [(ItemId, (Int, [Time]))]
allAssocs = (ItemDialogMode -> [(ItemId, (Int, [Time]))])
-> [ItemDialogMode] -> [(ItemId, (Int, [Time]))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ItemDialogMode -> [(ItemId, (Int, [Time]))]
storeAssocs (ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
cRest)
case [(ItemId, (Int, [Time]))]
allAssocs of
[(iid :: ItemId
iid, k :: (Int, [Time])
k)] | [ItemDialogMode] -> Bool
forall a. [a] -> Bool
null [ItemDialogMode]
cRest Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
askWhenLone -> do
ItemSlots itemSlots :: EnumMap SLore SingleItemSlots
itemSlots <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
let lSlots :: SingleItemSlots
lSlots = EnumMap SLore SingleItemSlots
itemSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemDialogMode -> SLore
IA.loreFromMode ItemDialogMode
cCur
slotChar :: SlotChar
slotChar = SlotChar -> Maybe SlotChar -> SlotChar
forall a. a -> Maybe a -> a
fromMaybe (String -> SlotChar
forall a. HasCallStack => String -> a
error (String -> SlotChar) -> String -> SlotChar
forall a b. (a -> b) -> a -> b
$ "" String -> (ItemId, SingleItemSlots) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemId
iid, SingleItemSlots
lSlots))
(Maybe SlotChar -> SlotChar) -> Maybe SlotChar -> SlotChar
forall a b. (a -> b) -> a -> b
$ ItemId -> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ItemId
iid ([(ItemId, SlotChar)] -> Maybe SlotChar)
-> [(ItemId, SlotChar)] -> Maybe SlotChar
forall a b. (a -> b) -> a -> b
$ ((SlotChar, ItemId) -> (ItemId, SlotChar))
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> [a] -> [b]
map (SlotChar, ItemId) -> (ItemId, SlotChar)
forall a b. (a, b) -> (b, a)
swap ([(SlotChar, ItemId)] -> [(ItemId, SlotChar)])
-> [(SlotChar, ItemId)] -> [(ItemId, SlotChar)]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [(SlotChar, ItemId)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs SingleItemSlots
lSlots
(Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([ItemId], ItemBag, SingleItemSlots)
-> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. b -> Either a b
Right ([ItemId
iid], ItemId -> (Int, [Time]) -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid (Int, [Time])
k, SlotChar -> ItemId -> SingleItemSlots
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton SlotChar
slotChar ItemId
iid)
, (ItemDialogMode
cCur, SlotChar -> Either KM SlotChar
forall a b. b -> Either a b
Right SlotChar
slotChar) )
_ ->
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> [ItemDialogMode]
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> [ItemDialogMode]
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
transition m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric Bool
permitMulitple [ItemDialogMode]
cLegal
0 ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
ISuitable
data DefItemKey m = DefItemKey
{ DefItemKey m -> Either Text KM
defLabel :: Either Text K.KM
, DefItemKey m -> Bool
defCond :: Bool
, DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction :: Either K.KM SlotChar
-> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)
, (ItemDialogMode, Either K.KM SlotChar) )
}
data Suitability =
SuitsEverything
| SuitsSomething (ItemFull -> ItemQuant -> Bool)
transition :: forall m. MonadClientUI m
=> m Suitability
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> Bool
-> [ItemDialogMode]
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)
, (ItemDialogMode, Either K.KM SlotChar) )
transition :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> [ItemDialogMode]
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
transition psuit :: m Suitability
psuit prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt promptGeneric :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric permitMulitple :: Bool
permitMulitple cLegal :: [ItemDialogMode]
cLegal
numPrefix :: Int
numPrefix cCur :: ItemDialogMode
cCur cRest :: [ItemDialogMode]
cRest itemDialogState :: ItemDialogState
itemDialogState = do
let recCall :: Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
recCall = m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> [ItemDialogMode]
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> [ItemDialogMode]
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
transition m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric Bool
permitMulitple [ItemDialogMode]
cLegal
ItemSlots itemSlotsPre :: EnumMap SLore SingleItemSlots
itemSlotsPre <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
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
leader
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
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
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.! Actor -> FactionId
bfid Actor
body) (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, ActorUI)]
hs <- ActorId -> m [(ActorId, Actor, ActorUI)]
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m [(ActorId, Actor, ActorUI)]
partyAfterLeader ActorId
leader
ItemBag
bagAll <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> ActorId -> State -> ItemDialogMode -> ItemBag
accessModeBag ActorId
leader State
s ItemDialogMode
cCur
ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
KM -> HumanCmd -> KM
revCmd <- m (KM -> HumanCmd -> KM)
forall (m :: * -> *). MonadClientUI m => m (KM -> HumanCmd -> KM)
revCmdMap
Suitability
mpsuit <- m Suitability
psuit
ItemFull -> (Int, [Time]) -> Bool
psuitFun <- case Suitability
mpsuit of
SuitsEverything -> (ItemFull -> (Int, [Time]) -> Bool)
-> m (ItemFull -> (Int, [Time]) -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ItemFull -> (Int, [Time]) -> Bool)
-> m (ItemFull -> (Int, [Time]) -> Bool))
-> (ItemFull -> (Int, [Time]) -> Bool)
-> m (ItemFull -> (Int, [Time]) -> Bool)
forall a b. (a -> b) -> a -> b
$ \_ _ -> Bool
True
SuitsSomething f :: ItemFull -> (Int, [Time]) -> Bool
f -> (ItemFull -> (Int, [Time]) -> Bool)
-> m (ItemFull -> (Int, [Time]) -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ItemFull -> (Int, [Time]) -> Bool
f
SingleItemSlots
lSlots <- case ItemDialogMode
cCur of
MOrgans -> do
let newSlots :: EnumMap SLore SingleItemSlots
newSlots = (SingleItemSlots -> SingleItemSlots)
-> SLore
-> EnumMap SLore SingleItemSlots
-> EnumMap SLore SingleItemSlots
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF) SLore
SOrgan
(EnumMap SLore SingleItemSlots -> EnumMap SLore SingleItemSlots)
-> EnumMap SLore SingleItemSlots -> EnumMap SLore SingleItemSlots
forall a b. (a -> b) -> a -> b
$ (SingleItemSlots -> SingleItemSlots)
-> SLore
-> EnumMap SLore SingleItemSlots
-> EnumMap SLore SingleItemSlots
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF) SLore
STrunk
(EnumMap SLore SingleItemSlots -> EnumMap SLore SingleItemSlots)
-> EnumMap SLore SingleItemSlots -> EnumMap SLore SingleItemSlots
forall a b. (a -> b) -> a -> b
$ (SingleItemSlots -> SingleItemSlots)
-> SLore
-> EnumMap SLore SingleItemSlots
-> EnumMap SLore SingleItemSlots
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF) SLore
SCondition EnumMap SLore SingleItemSlots
itemSlotsPre
(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 {sslots :: ItemSlots
sslots = EnumMap SLore SingleItemSlots -> ItemSlots
ItemSlots EnumMap SLore SingleItemSlots
newSlots}
SingleItemSlots -> m SingleItemSlots
forall (m :: * -> *) a. Monad m => a -> m a
return (SingleItemSlots -> m SingleItemSlots)
-> SingleItemSlots -> m SingleItemSlots
forall a b. (a -> b) -> a -> b
$! (ItemId -> ItemFull) -> [SingleItemSlots] -> SingleItemSlots
mergeItemSlots ItemId -> ItemFull
itemToF [ EnumMap SLore SingleItemSlots
newSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SOrgan
, EnumMap SLore SingleItemSlots
newSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
STrunk
, EnumMap SLore SingleItemSlots
newSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
SCondition ]
MSkills -> SingleItemSlots -> m SingleItemSlots
forall (m :: * -> *) a. Monad m => a -> m a
return SingleItemSlots
forall k a. EnumMap k a
EM.empty
MPlaces -> SingleItemSlots -> m SingleItemSlots
forall (m :: * -> *) a. Monad m => a -> m a
return SingleItemSlots
forall k a. EnumMap k a
EM.empty
_ -> do
let slore :: SLore
slore = ItemDialogMode -> SLore
IA.loreFromMode ItemDialogMode
cCur
newSlots :: EnumMap SLore SingleItemSlots
newSlots = (SingleItemSlots -> SingleItemSlots)
-> SLore
-> EnumMap SLore SingleItemSlots
-> EnumMap SLore SingleItemSlots
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF) SLore
slore EnumMap SLore SingleItemSlots
itemSlotsPre
(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 {sslots :: ItemSlots
sslots = EnumMap SLore SingleItemSlots -> ItemSlots
ItemSlots EnumMap SLore SingleItemSlots
newSlots}
SingleItemSlots -> m SingleItemSlots
forall (m :: * -> *) a. Monad m => a -> m a
return (SingleItemSlots -> m SingleItemSlots)
-> SingleItemSlots -> m SingleItemSlots
forall a b. (a -> b) -> a -> b
$! EnumMap SLore SingleItemSlots
newSlots EnumMap SLore SingleItemSlots -> SLore -> SingleItemSlots
forall k a. Enum k => EnumMap k a -> k -> a
EM.! SLore
slore
let getResult :: Either K.KM SlotChar -> [ItemId]
-> ( Either Text ([ItemId], ItemBag, SingleItemSlots)
, (ItemDialogMode, Either K.KM SlotChar) )
getResult :: Either KM SlotChar
-> [ItemId]
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
getResult ekm :: Either KM SlotChar
ekm iids :: [ItemId]
iids = (([ItemId], ItemBag, SingleItemSlots)
-> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. b -> Either a b
Right ([ItemId]
iids, ItemBag
bagAll, SingleItemSlots
bagItemSlotsAll), (ItemDialogMode
cCur, Either KM SlotChar
ekm))
filterP :: ItemId -> (Int, [Time]) -> Bool
filterP iid :: ItemId
iid = ItemFull -> (Int, [Time]) -> Bool
psuitFun (ItemId -> ItemFull
itemToF ItemId
iid)
bagAllSuit :: ItemBag
bagAllSuit = (ItemId -> (Int, [Time]) -> Bool) -> ItemBag -> ItemBag
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey ItemId -> (Int, [Time]) -> Bool
filterP ItemBag
bagAll
bagItemSlotsAll :: SingleItemSlots
bagItemSlotsAll = (ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter (ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
bagAll) SingleItemSlots
lSlots
hasPrefixOpen :: SlotChar -> ItemId -> Bool
hasPrefixOpen x :: SlotChar
x _ = SlotChar -> Int
slotPrefix SlotChar
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numPrefix Bool -> Bool -> Bool
|| Int
numPrefix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
bagItemSlotsOpen :: SingleItemSlots
bagItemSlotsOpen = (SlotChar -> ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey SlotChar -> ItemId -> Bool
hasPrefixOpen SingleItemSlots
bagItemSlotsAll
hasPrefix :: SlotChar -> ItemId -> Bool
hasPrefix x :: SlotChar
x _ = SlotChar -> Int
slotPrefix SlotChar
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numPrefix
bagItemSlots :: SingleItemSlots
bagItemSlots = (SlotChar -> ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey SlotChar -> ItemId -> Bool
hasPrefix SingleItemSlots
bagItemSlotsOpen
bag :: ItemBag
bag = [(ItemId, (Int, [Time]))] -> ItemBag
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemId, (Int, [Time]))] -> ItemBag)
-> [(ItemId, (Int, [Time]))] -> ItemBag
forall a b. (a -> b) -> a -> b
$ (ItemId -> (ItemId, (Int, [Time])))
-> [ItemId] -> [(ItemId, (Int, [Time]))]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemBag
bagAll ItemBag -> ItemId -> (Int, [Time])
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid))
(SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
bagItemSlotsOpen)
suitableItemSlotsAll :: SingleItemSlots
suitableItemSlotsAll = (ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall a k. (a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filter (ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
bagAllSuit) SingleItemSlots
lSlots
suitableItemSlotsOpen :: SingleItemSlots
suitableItemSlotsOpen =
(SlotChar -> ItemId -> Bool) -> SingleItemSlots -> SingleItemSlots
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey SlotChar -> ItemId -> Bool
hasPrefixOpen SingleItemSlots
suitableItemSlotsAll
bagSuit :: ItemBag
bagSuit = [(ItemId, (Int, [Time]))] -> ItemBag
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemId, (Int, [Time]))] -> ItemBag)
-> [(ItemId, (Int, [Time]))] -> ItemBag
forall a b. (a -> b) -> a -> b
$ (ItemId -> (ItemId, (Int, [Time])))
-> [ItemId] -> [(ItemId, (Int, [Time]))]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemBag
bagAllSuit ItemBag -> ItemId -> (Int, [Time])
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid))
(SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
suitableItemSlotsOpen)
(bagFiltered :: ItemBag
bagFiltered, promptChosen :: Text
promptChosen) <- (State -> (ItemBag, Text)) -> m (ItemBag, Text)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> (ItemBag, Text)) -> m (ItemBag, Text))
-> (State -> (ItemBag, Text)) -> m (ItemBag, Text)
forall a b. (a -> b) -> a -> b
$ \s :: State
s ->
case ItemDialogState
itemDialogState of
ISuitable -> (ItemBag
bagSuit, Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor
body ActorUI
bodyUI Skills
actorMaxSk ItemDialogMode
cCur State
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":")
IAll -> (ItemBag
bag, Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric Actor
body ActorUI
bodyUI Skills
actorMaxSk ItemDialogMode
cCur State
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":")
let (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
multipleSlots :: SingleItemSlots
multipleSlots = if ItemDialogState
itemDialogState ItemDialogState -> ItemDialogState -> Bool
forall a. Eq a => a -> a -> Bool
== ItemDialogState
IAll
then SingleItemSlots
bagItemSlotsAll
else SingleItemSlots
suitableItemSlotsAll
maySwitchLeader :: ItemDialogMode -> Bool
maySwitchLeader MOwned = Bool
False
maySwitchLeader MLore{} = Bool
False
maySwitchLeader MPlaces = Bool
False
maySwitchLeader _ = Bool
True
keyDefs :: [(K.KM, DefItemKey m)]
keyDefs :: [(KM, DefItemKey m)]
keyDefs = ((KM, DefItemKey m) -> Bool)
-> [(KM, DefItemKey m)] -> [(KM, DefItemKey m)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DefItemKey m -> Bool
forall (m :: * -> *). DefItemKey m -> Bool
defCond (DefItemKey m -> Bool)
-> ((KM, DefItemKey m) -> DefItemKey m)
-> (KM, DefItemKey m)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KM, DefItemKey m) -> DefItemKey m
forall a b. (a, b) -> b
snd) ([(KM, DefItemKey m)] -> [(KM, DefItemKey m)])
-> [(KM, DefItemKey m)] -> [(KM, DefItemKey m)]
forall a b. (a -> b) -> a -> b
$
[ let km :: KM
km = Char -> KM
K.mkChar '/'
in (KM
km, Bool -> Either Text KM -> DefItemKey m
changeContainerDef Bool
True (Either Text KM -> DefItemKey m) -> Either Text KM -> DefItemKey m
forall a b. (a -> b) -> a -> b
$ KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km)
, (Char -> KM
K.mkKP '/', Bool -> Either Text KM -> DefItemKey m
changeContainerDef Bool
True (Either Text KM -> DefItemKey m) -> Either Text KM -> DefItemKey m
forall a b. (a -> b) -> a -> b
$ Text -> Either Text KM
forall a b. a -> Either a b
Left "")
, let km :: KM
km = Char -> KM
K.mkChar '?'
in (KM
km, Bool -> Either Text KM -> DefItemKey m
changeContainerDef Bool
False (Either Text KM -> DefItemKey m) -> Either Text KM -> DefItemKey m
forall a b. (a -> b) -> a -> b
$ KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km)
, (Char -> KM
K.mkKP '?', Bool -> Either Text KM -> DefItemKey m
changeContainerDef Bool
False (Either Text KM -> DefItemKey m) -> Either Text KM -> DefItemKey m
forall a b. (a -> b) -> a -> b
$ Text -> Either Text KM
forall a b. a -> Either a b
Left "")
, let km :: KM
km = Char -> KM
K.mkChar '+'
in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
{ defLabel :: Either Text KM
defLabel = KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km
, defCond :: Bool
defCond = ItemBag
bag ItemBag -> ItemBag -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemBag
bagSuit
, defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction = \_ -> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
recCall Int
numPrefix ItemDialogMode
cCur [ItemDialogMode]
cRest
(ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$ case ItemDialogState
itemDialogState of
ISuitable -> ItemDialogState
IAll
IAll -> ItemDialogState
ISuitable
})
, let km :: KM
km = Char -> KM
K.mkChar '!'
in (KM
km, Either Text KM -> DefItemKey m
useMultipleDef (Either Text KM -> DefItemKey m) -> Either Text KM -> DefItemKey m
forall a b. (a -> b) -> a -> b
$ KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km)
, (Char -> KM
K.mkKP '*', Either Text KM -> DefItemKey m
useMultipleDef (Either Text KM -> DefItemKey m) -> Either Text KM -> DefItemKey m
forall a b. (a -> b) -> a -> b
$ Text -> Either Text KM
forall a b. a -> Either a b
Left "")
, let km :: KM
km = KM -> HumanCmd -> KM
revCmd (Modifier -> Key -> KM
K.KM Modifier
K.NoModifier Key
K.Tab) HumanCmd
MemberCycle
in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
{ defLabel :: Either Text KM
defLabel = KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km
, defCond :: Bool
defCond = ItemDialogMode -> Bool
maySwitchLeader ItemDialogMode
cCur
Bool -> Bool -> Bool
&& ((ActorId, Actor, ActorUI) -> Bool)
-> [(ActorId, Actor, ActorUI)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(_, b :: Actor
b, _) -> Actor -> LevelId
blid Actor
b LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
body) [(ActorId, Actor, ActorUI)]
hs
, defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction = \_ -> do
MError
err <- Bool -> m MError
forall (m :: * -> *). MonadClientUI m => Bool -> m MError
memberCycle Bool
False
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (MError -> Bool
forall a. Maybe a -> Bool
isNothing MError
err Bool -> MError -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` MError
err) ()
(cCurUpd :: ItemDialogMode
cCurUpd, cRestUpd :: [ItemDialogMode]
cRestUpd) <- ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
legalWithUpdatedLeader ItemDialogMode
cCur [ItemDialogMode]
cRest
Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
recCall Int
numPrefix ItemDialogMode
cCurUpd [ItemDialogMode]
cRestUpd ItemDialogState
itemDialogState
})
, let km :: KM
km = KM -> HumanCmd -> KM
revCmd (Modifier -> Key -> KM
K.KM Modifier
K.NoModifier Key
K.BackTab) HumanCmd
MemberBack
in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
{ defLabel :: Either Text KM
defLabel = KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km
, defCond :: Bool
defCond = ItemDialogMode -> Bool
maySwitchLeader ItemDialogMode
cCur Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
autoDun Bool -> Bool -> Bool
|| [(ActorId, Actor, ActorUI)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor, ActorUI)]
hs)
, defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction = \_ -> do
MError
err <- Bool -> m MError
forall (m :: * -> *). MonadClientUI m => Bool -> m MError
memberBack Bool
False
let !_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (MError -> Bool
forall a. Maybe a -> Bool
isNothing MError
err Bool -> MError -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` MError
err) ()
(cCurUpd :: ItemDialogMode
cCurUpd, cRestUpd :: [ItemDialogMode]
cRestUpd) <- ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
legalWithUpdatedLeader ItemDialogMode
cCur [ItemDialogMode]
cRest
Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
recCall Int
numPrefix ItemDialogMode
cCurUpd [ItemDialogMode]
cRestUpd ItemDialogState
itemDialogState
})
, (Modifier -> Key -> KM
K.KM Modifier
K.NoModifier Key
K.LeftButtonRelease, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
{ defLabel :: Either Text KM
defLabel = Text -> Either Text KM
forall a b. a -> Either a b
Left ""
, defCond :: Bool
defCond = ItemDialogMode -> Bool
maySwitchLeader ItemDialogMode
cCur Bool -> Bool -> Bool
&& Bool -> Bool
not ([(ActorId, Actor, ActorUI)] -> Bool
forall a. [a] -> Bool
null [(ActorId, Actor, ActorUI)]
hs)
, defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction = \ekm :: Either KM SlotChar
ekm -> do
MError
merror <- m MError
forall (m :: * -> *). MonadClientUI m => m MError
pickLeaderWithPointer
case MError
merror of
Nothing -> do
(cCurUpd :: ItemDialogMode
cCurUpd, cRestUpd :: [ItemDialogMode]
cRestUpd) <- ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
legalWithUpdatedLeader ItemDialogMode
cCur [ItemDialogMode]
cRest
Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
recCall Int
numPrefix ItemDialogMode
cCurUpd [ItemDialogMode]
cRestUpd ItemDialogState
itemDialogState
Just{} -> (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. a -> Either a b
Left "not a teammate", (ItemDialogMode
cCur, Either KM SlotChar
ekm))
})
, (KM
K.escKM, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
{ defLabel :: Either Text KM
defLabel = KM -> Either Text KM
forall a b. b -> Either a b
Right KM
K.escKM
, defCond :: Bool
defCond = Bool
True
, defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction = \ekm :: Either KM SlotChar
ekm -> (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. a -> Either a b
Left "never mind", (ItemDialogMode
cCur, Either KM SlotChar
ekm))
})
]
[(KM, DefItemKey m)]
-> [(KM, DefItemKey m)] -> [(KM, DefItemKey m)]
forall a. [a] -> [a] -> [a]
++ [(KM, DefItemKey m)]
numberPrefixes
changeContainerDef :: Bool -> Either Text KM -> DefItemKey m
changeContainerDef forward :: Bool
forward defLabel :: Either Text KM
defLabel = $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
{ Either Text KM
defLabel :: Either Text KM
defLabel :: Either Text KM
defLabel
, defCond :: Bool
defCond = Bool
True
, defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction = \_ -> do
let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorMaxSk
mcCur :: [ItemDialogMode]
mcCur = (ItemDialogMode -> Bool) -> [ItemDialogMode] -> [ItemDialogMode]
forall a. (a -> Bool) -> [a] -> [a]
filter (ItemDialogMode -> [ItemDialogMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ItemDialogMode]
cLegal) [ItemDialogMode
cCur]
(cCurAfterCalm :: ItemDialogMode
cCurAfterCalm, cRestAfterCalm :: [ItemDialogMode]
cRestAfterCalm) =
if Bool
forward
then case [ItemDialogMode]
cRest [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode]
mcCur of
c1 :: ItemDialogMode
c1@(MStore CSha) : c2 :: ItemDialogMode
c2 : rest :: [ItemDialogMode]
rest | Bool -> Bool
not Bool
calmE ->
(ItemDialogMode
c2, ItemDialogMode
c1 ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
rest)
[MStore CSha] | Bool -> Bool
not Bool
calmE -> String -> (ItemDialogMode, [ItemDialogMode])
forall a. HasCallStack => String -> a
error (String -> (ItemDialogMode, [ItemDialogMode]))
-> String -> (ItemDialogMode, [ItemDialogMode])
forall a b. (a -> b) -> a -> b
$ "" String -> [ItemDialogMode] -> String
forall v. Show v => String -> v -> String
`showFailure` [ItemDialogMode]
cRest
c1 :: ItemDialogMode
c1 : rest :: [ItemDialogMode]
rest -> (ItemDialogMode
c1, [ItemDialogMode]
rest)
[] -> String -> (ItemDialogMode, [ItemDialogMode])
forall a. HasCallStack => String -> a
error (String -> (ItemDialogMode, [ItemDialogMode]))
-> String -> (ItemDialogMode, [ItemDialogMode])
forall a b. (a -> b) -> a -> b
$ "" String -> [ItemDialogMode] -> String
forall v. Show v => String -> v -> String
`showFailure` [ItemDialogMode]
cRest
else case [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a]
reverse ([ItemDialogMode] -> [ItemDialogMode])
-> [ItemDialogMode] -> [ItemDialogMode]
forall a b. (a -> b) -> a -> b
$ [ItemDialogMode]
mcCur [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode]
cRest of
c1 :: ItemDialogMode
c1@(MStore CSha) : c2 :: ItemDialogMode
c2 : rest :: [ItemDialogMode]
rest | Bool -> Bool
not Bool
calmE ->
(ItemDialogMode
c2, [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a]
reverse ([ItemDialogMode] -> [ItemDialogMode])
-> [ItemDialogMode] -> [ItemDialogMode]
forall a b. (a -> b) -> a -> b
$ ItemDialogMode
c1 ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
rest)
[MStore CSha] | Bool -> Bool
not Bool
calmE -> String -> (ItemDialogMode, [ItemDialogMode])
forall a. HasCallStack => String -> a
error (String -> (ItemDialogMode, [ItemDialogMode]))
-> String -> (ItemDialogMode, [ItemDialogMode])
forall a b. (a -> b) -> a -> b
$ "" String -> [ItemDialogMode] -> String
forall v. Show v => String -> v -> String
`showFailure` [ItemDialogMode]
cRest
c1 :: ItemDialogMode
c1 : rest :: [ItemDialogMode]
rest -> (ItemDialogMode
c1, [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a]
reverse [ItemDialogMode]
rest)
[] -> String -> (ItemDialogMode, [ItemDialogMode])
forall a. HasCallStack => String -> a
error (String -> (ItemDialogMode, [ItemDialogMode]))
-> String -> (ItemDialogMode, [ItemDialogMode])
forall a b. (a -> b) -> a -> b
$ "" String -> [ItemDialogMode] -> String
forall v. Show v => String -> v -> String
`showFailure` [ItemDialogMode]
cRest
Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
recCall Int
numPrefix ItemDialogMode
cCurAfterCalm [ItemDialogMode]
cRestAfterCalm ItemDialogState
itemDialogState
}
useMultipleDef :: Either Text KM -> DefItemKey m
useMultipleDef defLabel :: Either Text KM
defLabel = $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
{ Either Text KM
defLabel :: Either Text KM
defLabel :: Either Text KM
defLabel
, defCond :: Bool
defCond = Bool
permitMulitple Bool -> Bool -> Bool
&& Bool -> Bool
not (SingleItemSlots -> Bool
forall k a. EnumMap k a -> Bool
EM.null SingleItemSlots
multipleSlots)
, defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction = \ekm :: Either KM SlotChar
ekm ->
let eslots :: [ItemId]
eslots = SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
multipleSlots
in (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$ Either KM SlotChar
-> [ItemId]
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
getResult Either KM SlotChar
ekm [ItemId]
eslots
}
prefixCmdDef :: Int -> (KM, DefItemKey m)
prefixCmdDef d :: Int
d =
(Char -> KM
K.mkChar (Char -> KM) -> Char -> KM
forall a b. (a -> b) -> a -> b
$ Int -> Char
Char.intToDigit Int
d, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
{ defLabel :: Either Text KM
defLabel = Text -> Either Text KM
forall a b. a -> Either a b
Left ""
, defCond :: Bool
defCond = Bool
True
, defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction = \_ ->
Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
recCall (10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numPrefix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState
})
numberPrefixes :: [(KM, DefItemKey m)]
numberPrefixes = (Int -> (KM, DefItemKey m)) -> [Int] -> [(KM, DefItemKey m)]
forall a b. (a -> b) -> [a] -> [b]
map Int -> (KM, DefItemKey m)
prefixCmdDef [0..9]
lettersDef :: DefItemKey m
lettersDef :: DefItemKey m
lettersDef = $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
{ defLabel :: Either Text KM
defLabel = Text -> Either Text KM
forall a b. a -> Either a b
Left ""
, defCond :: Bool
defCond = Bool
True
, defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction = \ekm :: Either KM SlotChar
ekm ->
let slot :: SlotChar
slot = case Either KM SlotChar
ekm of
Left K.KM{key :: KM -> Key
key=K.Char l :: Char
l} -> Int -> Char -> SlotChar
SlotChar Int
numPrefix Char
l
Left km :: KM
km ->
String -> SlotChar
forall a. HasCallStack => String -> a
error (String -> SlotChar) -> String -> SlotChar
forall a b. (a -> b) -> a -> b
$ "unexpected key:" String -> ShowS
forall v. Show v => String -> v -> String
`showFailure` KM -> String
K.showKM KM
km
Right sl :: SlotChar
sl -> SlotChar
sl
in case SlotChar -> SingleItemSlots -> Maybe ItemId
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup SlotChar
slot SingleItemSlots
bagItemSlotsAll of
Nothing -> String
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall a. HasCallStack => String -> a
error (String
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> String
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$ "unexpected slot"
String -> (SlotChar, SingleItemSlots) -> String
forall v. Show v => String -> v -> String
`showFailure` (SlotChar
slot, SingleItemSlots
bagItemSlots)
Just iid :: ItemId
iid -> (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall a b. (a -> b) -> a -> b
$! Either KM SlotChar
-> [ItemId]
-> (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
getResult (SlotChar -> Either KM SlotChar
forall a b. b -> Either a b
Right SlotChar
slot) [ItemId
iid]
}
case ItemDialogMode
cCur of
MSkills -> do
OKX
io <- ActorId -> m OKX
forall (m :: * -> *). MonadClientRead m => ActorId -> m OKX
skillsOverlay ActorId
leader
let slotLabels :: [Either [KM] SlotChar]
slotLabels = ((Either [KM] SlotChar, (Int, Int, Int)) -> Either [KM] SlotChar)
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> [a] -> [b]
map (Either [KM] SlotChar, (Int, Int, Int)) -> Either [KM] SlotChar
forall a b. (a, b) -> a
fst ([(Either [KM] SlotChar, (Int, Int, Int))]
-> [Either [KM] SlotChar])
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> a -> b
$ OKX -> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a b. (a, b) -> b
snd OKX
io
slotKeys :: [KM]
slotKeys = (Either [KM] SlotChar -> Maybe KM)
-> [Either [KM] SlotChar] -> [KM]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> Either [KM] SlotChar -> Maybe KM
keyOfEKM Int
numPrefix) [Either [KM] SlotChar]
slotLabels
skillsDef :: DefItemKey m
skillsDef :: DefItemKey m
skillsDef = $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
{ defLabel :: Either Text KM
defLabel = Text -> Either Text KM
forall a b. a -> Either a b
Left ""
, defCond :: Bool
defCond = Bool
True
, defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction = \ekm :: Either KM SlotChar
ekm ->
let slot :: SlotChar
slot = case Either KM SlotChar
ekm of
Left K.KM{Key
key :: Key
key :: KM -> Key
key} -> case Key
key of
K.Char l :: Char
l -> Int -> Char -> SlotChar
SlotChar Int
numPrefix Char
l
_ -> String -> SlotChar
forall a. HasCallStack => String -> a
error (String -> SlotChar) -> String -> SlotChar
forall a b. (a -> b) -> a -> b
$ "unexpected key:"
String -> ShowS
forall v. Show v => String -> v -> String
`showFailure` Key -> String
K.showKey Key
key
Right sl :: SlotChar
sl -> SlotChar
sl
in (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. a -> Either a b
Left "skills", (ItemDialogMode
MSkills, SlotChar -> Either KM SlotChar
forall a b. b -> Either a b
Right SlotChar
slot))
}
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
runDefItemKey [(KM, DefItemKey m)]
keyDefs DefItemKey m
skillsDef OKX
io [KM]
slotKeys Text
promptChosen ItemDialogMode
cCur
MPlaces -> do
OKX
io <- m OKX
forall (m :: * -> *). MonadClientRead m => m OKX
placesOverlay
let slotLabels :: [Either [KM] SlotChar]
slotLabels = ((Either [KM] SlotChar, (Int, Int, Int)) -> Either [KM] SlotChar)
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> [a] -> [b]
map (Either [KM] SlotChar, (Int, Int, Int)) -> Either [KM] SlotChar
forall a b. (a, b) -> a
fst ([(Either [KM] SlotChar, (Int, Int, Int))]
-> [Either [KM] SlotChar])
-> [(Either [KM] SlotChar, (Int, Int, Int))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> a -> b
$ OKX -> [(Either [KM] SlotChar, (Int, Int, Int))]
forall a b. (a, b) -> b
snd OKX
io
slotKeys :: [KM]
slotKeys = (Either [KM] SlotChar -> Maybe KM)
-> [Either [KM] SlotChar] -> [KM]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> Either [KM] SlotChar -> Maybe KM
keyOfEKM Int
numPrefix) [Either [KM] SlotChar]
slotLabels
placesDef :: DefItemKey m
placesDef :: DefItemKey m
placesDef = $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar)))
-> DefItemKey m
DefItemKey
{ defLabel :: Either Text KM
defLabel = Text -> Either Text KM
forall a b. a -> Either a b
Left ""
, defCond :: Bool
defCond = Bool
True
, defAction :: Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction = \ekm :: Either KM SlotChar
ekm ->
let slot :: SlotChar
slot = case Either KM SlotChar
ekm of
Left K.KM{Key
key :: Key
key :: KM -> Key
key} -> case Key
key of
K.Char l :: Char
l -> Int -> Char -> SlotChar
SlotChar Int
numPrefix Char
l
_ -> String -> SlotChar
forall a. HasCallStack => String -> a
error (String -> SlotChar) -> String -> SlotChar
forall a b. (a -> b) -> a -> b
$ "unexpected key:"
String -> ShowS
forall v. Show v => String -> v -> String
`showFailure` Key -> String
K.showKey Key
key
Right sl :: SlotChar
sl -> SlotChar
sl
in (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ([ItemId], ItemBag, SingleItemSlots)
forall a b. a -> Either a b
Left "places", (ItemDialogMode
MPlaces, SlotChar -> Either KM SlotChar
forall a b. b -> Either a b
Right SlotChar
slot))
}
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
runDefItemKey [(KM, DefItemKey m)]
keyDefs DefItemKey m
placesDef OKX
io [KM]
slotKeys Text
promptChosen ItemDialogMode
cCur
_ -> do
OKX
io <- SingleItemSlots -> LevelId -> ItemBag -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
SingleItemSlots -> LevelId -> ItemBag -> m OKX
itemOverlay SingleItemSlots
lSlots (Actor -> LevelId
blid Actor
body) ItemBag
bagFiltered
let slotKeys :: [KM]
slotKeys = (SlotChar -> Maybe KM) -> [SlotChar] -> [KM]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> Either [KM] SlotChar -> Maybe KM
keyOfEKM Int
numPrefix (Either [KM] SlotChar -> Maybe KM)
-> (SlotChar -> Either [KM] SlotChar) -> SlotChar -> Maybe KM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right)
([SlotChar] -> [KM]) -> [SlotChar] -> [KM]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [SlotChar]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys SingleItemSlots
bagItemSlots
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
MonadClientUI m =>
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
runDefItemKey [(KM, DefItemKey m)]
keyDefs DefItemKey m
lettersDef OKX
io [KM]
slotKeys Text
promptChosen ItemDialogMode
cCur
keyOfEKM :: Int -> Either [K.KM] SlotChar -> Maybe K.KM
keyOfEKM :: Int -> Either [KM] SlotChar -> Maybe KM
keyOfEKM _ (Left kms :: [KM]
kms) = String -> Maybe KM
forall a. HasCallStack => String -> a
error (String -> Maybe KM) -> String -> Maybe KM
forall a b. (a -> b) -> a -> b
$ "" String -> [KM] -> String
forall v. Show v => String -> v -> String
`showFailure` [KM]
kms
keyOfEKM numPrefix :: Int
numPrefix (Right SlotChar{..}) | Int
slotPrefix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numPrefix =
KM -> Maybe KM
forall a. a -> Maybe a
Just (KM -> Maybe KM) -> KM -> Maybe KM
forall a b. (a -> b) -> a -> b
$ Char -> KM
K.mkChar Char
slotChar
keyOfEKM _ _ = Maybe KM
forall a. Maybe a
Nothing
legalWithUpdatedLeader :: MonadClientUI m
=> ItemDialogMode
-> [ItemDialogMode]
-> m (ItemDialogMode, [ItemDialogMode])
legalWithUpdatedLeader :: ItemDialogMode
-> [ItemDialogMode] -> m (ItemDialogMode, [ItemDialogMode])
legalWithUpdatedLeader cCur :: ItemDialogMode
cCur cRest :: [ItemDialogMode]
cRest = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
let newLegal :: [ItemDialogMode]
newLegal = ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
cRest
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
legalAfterCalm :: (ItemDialogMode, [ItemDialogMode])
legalAfterCalm = case [ItemDialogMode]
newLegal of
c1 :: ItemDialogMode
c1@(MStore CSha) : c2 :: ItemDialogMode
c2 : rest :: [ItemDialogMode]
rest | Bool -> Bool
not Bool
calmE -> (ItemDialogMode
c2, ItemDialogMode
c1 ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
rest)
[MStore CSha] | Bool -> Bool
not Bool
calmE -> (CStore -> ItemDialogMode
MStore CStore
CGround, [ItemDialogMode]
newLegal)
c1 :: ItemDialogMode
c1 : rest :: [ItemDialogMode]
rest -> (ItemDialogMode
c1, [ItemDialogMode]
rest)
[] -> String -> (ItemDialogMode, [ItemDialogMode])
forall a. HasCallStack => String -> a
error (String -> (ItemDialogMode, [ItemDialogMode]))
-> String -> (ItemDialogMode, [ItemDialogMode])
forall a b. (a -> b) -> a -> b
$ "" String -> (ItemDialogMode, [ItemDialogMode]) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemDialogMode
cCur, [ItemDialogMode]
cRest)
(ItemDialogMode, [ItemDialogMode])
-> m (ItemDialogMode, [ItemDialogMode])
forall (m :: * -> *) a. Monad m => a -> m a
return (ItemDialogMode, [ItemDialogMode])
legalAfterCalm
runDefItemKey :: MonadClientUI m
=> [(K.KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [K.KM]
-> Text
-> ItemDialogMode
-> m ( Either Text ([ItemId], ItemBag, SingleItemSlots)
, (ItemDialogMode, Either K.KM SlotChar) )
runDefItemKey :: [(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
runDefItemKey keyDefs :: [(KM, DefItemKey m)]
keyDefs lettersDef :: DefItemKey m
lettersDef okx :: OKX
okx slotKeys :: [KM]
slotKeys prompt :: Text
prompt cCur :: ItemDialogMode
cCur = do
let itemKeys :: [KM]
itemKeys = [KM]
slotKeys [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ ((KM, DefItemKey m) -> KM) -> [(KM, DefItemKey m)] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (KM, DefItemKey m) -> KM
forall a b. (a, b) -> a
fst [(KM, DefItemKey m)]
keyDefs
wrapB :: a -> a
wrapB s :: a
s = "[" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> "]"
(keyLabelsRaw :: [Text]
keyLabelsRaw, keys :: [KM]
keys) = [Either Text KM] -> ([Text], [KM])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either Text KM] -> ([Text], [KM]))
-> [Either Text KM] -> ([Text], [KM])
forall a b. (a -> b) -> a -> b
$ ((KM, DefItemKey m) -> Either Text KM)
-> [(KM, DefItemKey m)] -> [Either Text KM]
forall a b. (a -> b) -> [a] -> [b]
map (DefItemKey m -> Either Text KM
forall (m :: * -> *). DefItemKey m -> Either Text KM
defLabel (DefItemKey m -> Either Text KM)
-> ((KM, DefItemKey m) -> DefItemKey m)
-> (KM, DefItemKey m)
-> Either Text KM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KM, DefItemKey m) -> DefItemKey m
forall a b. (a, b) -> b
snd) [(KM, DefItemKey m)]
keyDefs
keyLabels :: [Text]
keyLabels = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
keyLabelsRaw
choice :: Text
choice = Text -> [Text] -> Text
T.intercalate " " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapB ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
keyLabels
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
prompt Text -> Text -> Text
<+> Text
choice
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
Either KM SlotChar
ekm <- do
Slideshow
okxs <- Int -> [KM] -> OKX -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) [KM]
keys OKX
okx
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
MonadClientUI m =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen (ItemDialogMode -> String
forall a. Show a => a -> String
show ItemDialogMode
cCur) ColorMode
ColorFull Bool
False Slideshow
okxs [KM]
itemKeys
case Either KM SlotChar
ekm of
Left km :: KM
km -> case KM
km KM -> [(KM, DefItemKey m)] -> Maybe (DefItemKey m)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(KM, DefItemKey m)]
keyDefs of
Just keyDef :: DefItemKey m
keyDef -> DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction DefItemKey m
keyDef Either KM SlotChar
ekm
Nothing -> DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction DefItemKey m
lettersDef Either KM SlotChar
ekm
Right _slot :: SlotChar
_slot -> DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar
-> m (Either Text ([ItemId], ItemBag, SingleItemSlots),
(ItemDialogMode, Either KM SlotChar))
defAction DefItemKey m
lettersDef Either KM SlotChar
ekm