module Game.LambdaHack.Client.UI.InventoryM
( Suitability(..), ResultItemDialogMode(..)
, slotsOfItemDialogMode, getFull, getGroupItem, getStoreItem
#ifdef EXPOSE_INTERNAL
, ItemDialogState(..), accessModeBag, storeItemPrompt, getItem
, DefItemKey(..), transition, keyOfEKM, runDefItemKey
#endif
) 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 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.Frame
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.Msg
import Game.LambdaHack.Client.UI.MsgM
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.Kind
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.ItemKind as IK
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)
data ResultItemDialogMode =
RStore CStore [ItemId]
| ROrgans ItemId ItemBag SingleItemSlots
| ROwned ItemId
| RSkills Int
| RLore SLore ItemId ItemBag SingleItemSlots
| RPlaces Int
| RModes Int
deriving Int -> ResultItemDialogMode -> ShowS
[ResultItemDialogMode] -> ShowS
ResultItemDialogMode -> String
(Int -> ResultItemDialogMode -> ShowS)
-> (ResultItemDialogMode -> String)
-> ([ResultItemDialogMode] -> ShowS)
-> Show ResultItemDialogMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultItemDialogMode] -> ShowS
$cshowList :: [ResultItemDialogMode] -> ShowS
show :: ResultItemDialogMode -> String
$cshow :: ResultItemDialogMode -> String
showsPrec :: Int -> ResultItemDialogMode -> ShowS
$cshowsPrec :: Int -> ResultItemDialogMode -> ShowS
Show
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 -> ItemQuant) -> EnumMap ItemId Item -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (ItemQuant -> Item -> ItemQuant
forall a b. a -> b -> a
const ItemQuant
quantSingle) (EnumMap ItemId Item -> 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
accessModeBag _ _ MModes = ItemBag
forall k a. EnumMap k a
EM.empty
slotsOfItemDialogMode :: MonadClientUI m => ItemDialogMode -> m SingleItemSlots
slotsOfItemDialogMode :: ItemDialogMode -> m SingleItemSlots
slotsOfItemDialogMode cCur :: ItemDialogMode
cCur = 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
ItemSlots itemSlotsPre :: EnumMap SLore SingleItemSlots
itemSlotsPre <- (SessionUI -> ItemSlots) -> m ItemSlots
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ItemSlots
sslots
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
MModes -> 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
getGroupItem :: (MonadClient m, MonadClientUI m)
=> m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
getGroupItem :: m Suitability
-> Text
-> Text
-> Text
-> Text
-> [CStore]
-> m (Either Text (CStore, ItemId))
getGroupItem psuit :: m Suitability
psuit prompt :: Text
prompt promptGeneric :: Text
promptGeneric verb :: Text
verb verbGeneric :: Text
verbGeneric stores :: [CStore]
stores = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side
let ppItemDialogBody :: Text -> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody v :: Text
v body :: Actor
body actorSk :: Skills
actorSk cCur :: ItemDialogMode
cCur = case ItemDialogMode
cCur of
MStore CEqp | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorSk ->
"distractedly attempt to" Text -> Text -> Text
<+> Text
v Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeIn ItemDialogMode
cCur
MStore CGround | Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
body, Actor -> Point
bpos Actor
body) ->
"greedily attempt to" Text -> Text -> Text
<+> Text
v Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeIn ItemDialogMode
cCur
_ -> Text
v Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
Either Text (CStore, [(ItemId, ItemQuant)])
soc <- m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> Bool
-> Bool
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> Bool
-> Bool
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
getFull m Suitability
psuit
(\body :: Actor
body _ actorSk :: Skills
actorSk cCur :: ItemDialogMode
cCur _ ->
Text
prompt Text -> Text -> Text
<+> Text -> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody Text
verb Actor
body Skills
actorSk ItemDialogMode
cCur)
(\body :: Actor
body _ actorSk :: Skills
actorSk cCur :: ItemDialogMode
cCur _ ->
Text
promptGeneric
Text -> Text -> Text
<+> Text -> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody Text
verbGeneric Actor
body Skills
actorSk ItemDialogMode
cCur)
[CStore]
stores Bool
True Bool
False
case Either Text (CStore, [(ItemId, ItemQuant)])
soc of
Left err :: Text
err -> Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId)))
-> Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (CStore, ItemId)
forall a b. a -> Either a b
Left Text
err
Right (rstore :: CStore
rstore, [(iid :: ItemId
iid, _)]) -> Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId)))
-> Either Text (CStore, ItemId) -> m (Either Text (CStore, ItemId))
forall a b. (a -> b) -> a -> b
$ (CStore, ItemId) -> Either Text (CStore, ItemId)
forall a b. b -> Either a b
Right (CStore
rstore, ItemId
iid)
Right _ -> String -> m (Either Text (CStore, ItemId))
forall a. HasCallStack => String -> a
error (String -> m (Either Text (CStore, ItemId)))
-> String -> m (Either Text (CStore, ItemId))
forall a b. (a -> b) -> a -> b
$ "" String -> Either Text (CStore, [(ItemId, ItemQuant)]) -> String
forall v. Show v => String -> v -> String
`showFailure` Either Text (CStore, [(ItemId, ItemQuant)])
soc
getStoreItem :: (MonadClient m, MonadClientUI m)
=> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
getStoreItem :: ItemDialogMode -> m (Either Text ResultItemDialogMode)
getStoreItem cInitial :: ItemDialogMode
cInitial = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
let itemCs :: [ItemDialogMode]
itemCs = (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore
CStash, CStore
CEqp, CStore
CGround]
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, ItemDialogMode
MModes]
allCs :: [ItemDialogMode]
allCs = case ItemDialogMode
cInitial of
MLore{} -> [ItemDialogMode]
loreCs
MPlaces -> [ItemDialogMode]
loreCs
MModes -> [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
prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt = FactionId
-> Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
storeItemPrompt FactionId
side
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
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
storeItemPrompt :: FactionId
-> Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text
storeItemPrompt :: FactionId
-> Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
storeItemPrompt side :: FactionId
side body :: Actor
body bodyUI :: ActorUI
bodyUI actorCurAndMaxSk :: Skills
actorCurAndMaxSk c2 :: ItemDialogMode
c2 s :: State
s =
let COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} = State -> COps
scops State
s
fact :: Faction
fact = State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side
(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 -> Int
countItems store :: CStore
store = (ItemQuant -> Int -> Int) -> Int -> ItemBag -> Int
forall a b k. (a -> b -> b) -> b -> EnumMap k a -> b
EM.foldr' ItemQuant -> Int -> Int
forall a b. Num a => (a, b) -> a -> a
f 0 (ItemBag -> Int) -> ItemBag -> Int
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
body CStore
store State
s
in case ItemDialogMode
c2 of
MStore CGround ->
let n :: Int
n = CStore -> Int
countItems CStore
CGround
nItems :: Part
nItems = Int -> Part -> Part
MU.CarAWs Int
n "item"
verbGround :: Part
verbGround = if Faction -> Maybe (LevelId, Point)
gstash Faction
fact Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
body, Actor -> Point
bpos Actor
body)
then "fondle greedily"
else "notice"
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 Part
verbGround
, 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 CEqp ->
let n :: Int
n = CStore -> Int
countItems CStore
CEqp
(verbEqp :: Part
verbEqp, nItems :: Part
nItems) =
if | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> ("find nothing", "")
| Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorCurAndMaxSk ->
("find", Int -> Part -> Part
MU.CarAWs Int
n "item")
| Bool
otherwise -> ("paw distractedly at", Int -> Part -> Part
MU.CarAWs Int
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 Part
verbEqp
, 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 ]
MStore cstore :: CStore
cstore ->
let n :: Int
n = CStore -> Int
countItems CStore
cstore
nItems :: Part
nItems = Int -> Part -> Part
MU.CarAWs Int
n "item"
(verb :: Part
verb, onLevel :: [Part]
onLevel) = case CStore
cstore of
COrgan -> ("feel", [])
CStash ->
( "notice"
, case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
Just (lid :: LevelId
lid, _) ->
(Text -> Part) -> [Text] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Part
MU.Text ["on level", Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ LevelId -> Int
forall a. Enum a => a -> Int
fromEnum LevelId
lid]
Nothing -> [] )
_ -> ("see", [])
ownObject :: [Part]
ownObject = case CStore
cstore of
CStash -> ["our", Text -> Part
MU.Text Text
t]
_ -> [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]
in [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verb
, Part
nItems, Text -> Part
MU.Text Text
tIn ] [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
ownObject [Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ [Part]
onLevel
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 ->
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 GroupName ItemKind
IK.S_CURRENCY
dungeonTotal :: Int
dungeonTotal = State -> Int
sgold State
s
(_, total :: Int
total) = FactionId -> State -> (ItemBag, Int)
calculateTotal FactionId
side State
s
n :: Int
n = CStore -> Int
countItems CStore
CStash
verbOwned :: Part
verbOwned = if | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> "find nothing among"
| Bool
otherwise -> "review"
in [Part] -> Text
makePhrase
[ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int -> Text
spoilsBlurb Text
currencyName Int
total Int
dungeonTotal
, Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Part -> Part -> Part
MU.SubjectVerbSg Part
subject Part
verbOwned
, 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 slore :: SLore
slore ->
[Part] -> Text
makePhrase
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$
if SLore
slore SLore -> SLore -> Bool
forall a. Eq a => a -> a -> Bool
== SLore
SEmbed
then "terrain (including crafting recipes)"
else Text
t ]
MPlaces ->
[Part] -> Text
makePhrase
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
MModes ->
[Part] -> Text
makePhrase
[ Part -> Part
MU.Capitalize (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text Text
t ]
getFull :: (MonadClient m, MonadClientUI m)
=> m Suitability
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> [CStore]
-> Bool
-> Bool
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
getFull :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> Bool
-> Bool
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
getFull psuit :: m Suitability
psuit prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt promptGeneric :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric stores :: [CStore]
stores askWhenLone :: Bool
askWhenLone permitMulitple :: Bool
permitMulitple = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Suitability
mpsuit <- m Suitability
psuit
let psuitFun :: Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun = case Suitability
mpsuit of
SuitsEverything -> \_ _ _ -> Bool
True
SuitsSomething f :: Maybe CStore -> ItemFull -> ItemQuant -> Bool
f -> Maybe CStore -> ItemFull -> ItemQuant -> 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]
stores of
[] -> do
let dialogModes :: [ItemDialogMode]
dialogModes = (CStore -> ItemDialogMode) -> [CStore] -> [ItemDialogMode]
forall a b. (a -> b) -> [a] -> [b]
map CStore -> ItemDialogMode
MStore [CStore]
stores
ts :: [Part]
ts = (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]
dialogModes
Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)])))
-> Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (CStore, [(ItemId, ItemQuant)])
forall a b. a -> Either a b
Left (Text -> Either Text (CStore, [(ItemId, ItemQuant)]))
-> Text -> Either Text (CStore, [(ItemId, ItemQuant)])
forall a b. (a -> b) -> a -> b
$ "no items" Text -> Text -> Text
<+> [Part] -> Text
makePhrase [Part -> [Part] -> Part
MU.WWxW "nor" [Part]
ts]
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, ItemQuant) -> Bool) -> [(ItemId, ItemQuant)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(iid :: ItemId
iid, kit :: ItemQuant
kit) -> Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun (CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
store) (ItemId -> ItemFull
itemToF ItemId
iid) ItemQuant
kit)
(ItemBag -> [(ItemId, ItemQuant)]
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
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]
stores
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)
(modeFirst :: ItemDialogMode
modeFirst, modeRest :: [ItemDialogMode]
modeRest) = CStore -> (ItemDialogMode, [ItemDialogMode])
breakStores CStore
firstStore
Either Text ResultItemDialogMode
res <- m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
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
case Either Text ResultItemDialogMode
res of
Left t :: Text
t -> Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)])))
-> Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (CStore, [(ItemId, ItemQuant)])
forall a b. a -> Either a b
Left Text
t
Right (RStore fromCStore :: CStore
fromCStore iids :: [ItemId]
iids) -> do
let bagAll :: ItemBag
bagAll = CStore -> ItemBag
getCStoreBag CStore
fromCStore
f :: ItemId -> (ItemId, ItemQuant)
f iid :: ItemId
iid = (ItemId
iid, ItemBag
bagAll ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid)
Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)])))
-> Either Text (CStore, [(ItemId, ItemQuant)])
-> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall a b. (a -> b) -> a -> b
$ (CStore, [(ItemId, ItemQuant)])
-> Either Text (CStore, [(ItemId, ItemQuant)])
forall a b. b -> Either a b
Right (CStore
fromCStore, (ItemId -> (ItemId, ItemQuant))
-> [ItemId] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> [a] -> [b]
map ItemId -> (ItemId, ItemQuant)
f [ItemId]
iids)
Right _ -> String -> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall a. HasCallStack => String -> a
error (String -> m (Either Text (CStore, [(ItemId, ItemQuant)])))
-> String -> m (Either Text (CStore, [(ItemId, ItemQuant)]))
forall a b. (a -> b) -> a -> b
$ "" String -> Either Text ResultItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` Either Text ResultItemDialogMode
res
getItem :: (MonadClient m, MonadClientUI m)
=> m Suitability
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
getItem :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> ItemDialogMode
-> [ItemDialogMode]
-> Bool
-> Bool
-> m (Either Text ResultItemDialogMode)
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 = 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, ItemQuant)]
storeAssocs = ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (ItemBag -> [(ItemId, ItemQuant)])
-> (ItemDialogMode -> ItemBag)
-> ItemDialogMode
-> [(ItemId, ItemQuant)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemDialogMode -> ItemBag
accessCBag
allAssocs :: [(ItemId, ItemQuant)]
allAssocs = (ItemDialogMode -> [(ItemId, ItemQuant)])
-> [ItemDialogMode] -> [(ItemId, ItemQuant)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ItemDialogMode -> [(ItemId, ItemQuant)]
storeAssocs (ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
cRest)
case ([(ItemId, ItemQuant)]
allAssocs, ItemDialogMode
cCur) of
([(iid :: ItemId
iid, _)], MStore rstore :: CStore
rstore) | [ItemDialogMode] -> Bool
forall a. [a] -> Bool
null [ItemDialogMode]
cRest Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
askWhenLone ->
Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode))
-> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right (ResultItemDialogMode -> Either Text ResultItemDialogMode)
-> ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ CStore -> [ItemId] -> ResultItemDialogMode
RStore CStore
rstore [ItemId
iid]
_ -> m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
transition m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric Bool
permitMulitple
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 ResultItemDialogMode)
defAction :: Either K.KM SlotChar -> m (Either Text ResultItemDialogMode)
}
data Suitability =
SuitsEverything
| SuitsSomething (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
transition :: forall m. (MonadClient m, MonadClientUI m)
=> m Suitability
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> (Actor -> ActorUI -> Ability.Skills -> ItemDialogMode -> State
-> Text)
-> Bool
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
transition :: m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
transition psuit :: m Suitability
psuit prompt :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt promptGeneric :: Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric permitMulitple :: Bool
permitMulitple
numPrefix :: Int
numPrefix cCur :: ItemDialogMode
cCur cRest :: [ItemDialogMode]
cRest itemDialogState :: ItemDialogState
itemDialogState = do
let recCall :: Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall = m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> Bool
-> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
transition m Suitability
psuit Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
prompt Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text
promptGeneric Bool
permitMulitple
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
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
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
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
body) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
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
HumanCmd -> KM
revCmd <- m (HumanCmd -> KM)
forall (m :: * -> *). MonadClientUI m => m (HumanCmd -> KM)
revCmdMap
Suitability
mpsuit <- m Suitability
psuit
Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun <- case Suitability
mpsuit of
SuitsEverything -> (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
-> m (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe CStore -> ItemFull -> ItemQuant -> Bool)
-> m (Maybe CStore -> ItemFull -> ItemQuant -> Bool))
-> (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
-> m (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
forall a b. (a -> b) -> a -> b
$ \_ _ _ -> Bool
True
SuitsSomething f :: Maybe CStore -> ItemFull -> ItemQuant -> Bool
f -> (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
-> m (Maybe CStore -> ItemFull -> ItemQuant -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CStore -> ItemFull -> ItemQuant -> Bool
f
SingleItemSlots
lSlots <- ItemDialogMode -> m SingleItemSlots
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m SingleItemSlots
slotsOfItemDialogMode ItemDialogMode
cCur
let getResult :: [ItemId] -> Either Text ResultItemDialogMode
getResult :: [ItemId] -> Either Text ResultItemDialogMode
getResult iids :: [ItemId]
iids = ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right (ResultItemDialogMode -> Either Text ResultItemDialogMode)
-> ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ case ItemDialogMode
cCur of
MStore rstore :: CStore
rstore -> CStore -> [ItemId] -> ResultItemDialogMode
RStore CStore
rstore [ItemId]
iids
MOrgans -> case [ItemId]
iids of
[iid :: ItemId
iid] -> ItemId -> ItemBag -> SingleItemSlots -> ResultItemDialogMode
ROrgans ItemId
iid ItemBag
bagAll SingleItemSlots
bagItemSlotsAll
_ -> String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> (ItemDialogMode, [ItemId]) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemDialogMode
cCur, [ItemId]
iids)
MOwned -> case [ItemId]
iids of
[iid :: ItemId
iid] -> ItemId -> ResultItemDialogMode
ROwned ItemId
iid
_ -> String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> (ItemDialogMode, [ItemId]) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemDialogMode
cCur, [ItemId]
iids)
MSkills -> String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> ItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ItemDialogMode
cCur
MLore rlore :: SLore
rlore -> case [ItemId]
iids of
[iid :: ItemId
iid] -> SLore
-> ItemId -> ItemBag -> SingleItemSlots -> ResultItemDialogMode
RLore SLore
rlore ItemId
iid ItemBag
bagAll SingleItemSlots
bagItemSlotsAll
_ -> String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> (ItemDialogMode, [ItemId]) -> String
forall v. Show v => String -> v -> String
`showFailure` (ItemDialogMode
cCur, [ItemId]
iids)
MPlaces -> String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> ItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ItemDialogMode
cCur
MModes -> String -> ResultItemDialogMode
forall a. HasCallStack => String -> a
error (String -> ResultItemDialogMode) -> String -> ResultItemDialogMode
forall a b. (a -> b) -> a -> b
$ "" String -> ItemDialogMode -> String
forall v. Show v => String -> v -> String
`showFailure` ItemDialogMode
cCur
mstore :: Maybe CStore
mstore = case ItemDialogMode
cCur of
MStore store :: CStore
store -> CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
store
_ -> Maybe CStore
forall a. Maybe a
Nothing
filterP :: ItemId -> ItemQuant -> Bool
filterP iid :: ItemId
iid = Maybe CStore -> ItemFull -> ItemQuant -> Bool
psuitFun Maybe CStore
mstore (ItemId -> ItemFull
itemToF ItemId
iid)
bagAllSuit :: ItemBag
bagAllSuit = (ItemId -> ItemQuant -> Bool) -> ItemBag -> ItemBag
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey ItemId -> ItemQuant -> 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, ItemQuant)] -> ItemBag
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemId, ItemQuant)] -> ItemBag)
-> [(ItemId, ItemQuant)] -> ItemBag
forall a b. (a -> b) -> a -> b
$ (ItemId -> (ItemId, ItemQuant))
-> [ItemId] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemBag
bagAll ItemBag -> ItemId -> ItemQuant
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, ItemQuant)] -> ItemBag
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemId, ItemQuant)] -> ItemBag)
-> [(ItemId, ItemQuant)] -> ItemBag
forall a b. (a -> b) -> a -> b
$ (ItemId -> (ItemId, ItemQuant))
-> [ItemId] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemBag
bagAllSuit ItemBag -> ItemId -> ItemQuant
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)
nextContainers :: Direction -> (ItemDialogMode, [ItemDialogMode])
nextContainers direction :: Direction
direction = case Direction
direction of
Forward -> case [ItemDialogMode]
cRest [ItemDialogMode] -> [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a] -> [a]
++ [ItemDialogMode
cCur] of
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
Backward -> case [ItemDialogMode] -> [ItemDialogMode]
forall a. [a] -> [a]
reverse ([ItemDialogMode] -> [ItemDialogMode])
-> [ItemDialogMode] -> [ItemDialogMode]
forall a b. (a -> b) -> a -> b
$ ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> [ItemDialogMode]
forall a. a -> [a] -> [a]
: [ItemDialogMode]
cRest of
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
(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
actorCurAndMaxSk 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
actorCurAndMaxSk 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 MModes = Bool
False
maySwitchLeader _ = Bool
True
cycleKeyDef :: Direction -> (KM, DefItemKey m)
cycleKeyDef direction :: Direction
direction =
let km :: KM
km = HumanCmd -> KM
revCmd (HumanCmd -> KM) -> HumanCmd -> KM
forall a b. (a -> b) -> a -> b
$ Direction -> HumanCmd
MemberCycle Direction
direction
in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
{ defLabel :: Either Text KM
defLabel = if Direction
direction Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Forward then KM -> Either Text KM
forall a b. b -> Either a b
Right KM
km else 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 (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 ResultItemDialogMode)
defAction = \_ -> do
MError
err <- Bool -> Direction -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Direction -> m MError
memberCycle Bool
False Direction
direction
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) ()
Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall Int
numPrefix ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState
})
cycleLevelKeyDef :: Direction -> (KM, DefItemKey m)
cycleLevelKeyDef direction :: Direction
direction =
let km :: KM
km = HumanCmd -> KM
revCmd (HumanCmd -> KM) -> HumanCmd -> KM
forall a b. (a -> b) -> a -> b
$ Direction -> HumanCmd
MemberCycleLevel Direction
direction
in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> 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
&& ((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 ResultItemDialogMode)
defAction = \_ -> do
MError
err <- Bool -> Direction -> m MError
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Direction -> m MError
memberCycleLevel Bool
False Direction
direction
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) ()
Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall Int
numPrefix ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState
})
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, Direction -> Either Text KM -> DefItemKey m
changeContainerDef Direction
Backward (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)
, let km :: KM
km = Char -> KM
K.mkChar '>'
in (KM
km, Direction -> Either Text KM -> DefItemKey m
changeContainerDef Direction
Forward (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)
, let km :: KM
km = Char -> KM
K.mkChar '+'
in (KM
km, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> 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 ResultItemDialogMode)
defAction = \_ -> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall Int
numPrefix ItemDialogMode
cCur [ItemDialogMode]
cRest
(ItemDialogState -> m (Either Text ResultItemDialogMode))
-> ItemDialogState -> m (Either Text ResultItemDialogMode)
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)
, 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
$ Text -> Either Text KM
forall a b. a -> Either a b
Left "")
, Direction -> (KM, DefItemKey m)
cycleKeyDef Direction
Forward
, Direction -> (KM, DefItemKey m)
cycleKeyDef Direction
Backward
, Direction -> (KM, DefItemKey m)
cycleLevelKeyDef Direction
Forward
, Direction -> (KM, DefItemKey m)
cycleLevelKeyDef Direction
Backward
, (Modifier -> Key -> KM
K.KM Modifier
K.NoModifier Key
K.LeftButtonRelease, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> 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 ResultItemDialogMode)
defAction = \_ -> do
MError
merror <- m MError
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m MError
pickLeaderWithPointer
case MError
merror of
Nothing -> Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
recCall Int
numPrefix ItemDialogMode
cCur [ItemDialogMode]
cRest ItemDialogState
itemDialogState
Just{} -> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode))
-> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ResultItemDialogMode
forall a b. a -> Either a b
Left "not a menu item nor teammate position"
})
, (KM
K.escKM, $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> 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 ResultItemDialogMode)
defAction = \_ -> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode))
-> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ResultItemDialogMode
forall a b. a -> Either a b
Left "never mind"
})
]
[(KM, DefItemKey m)]
-> [(KM, DefItemKey m)] -> [(KM, DefItemKey m)]
forall a. [a] -> [a] -> [a]
++ [(KM, DefItemKey m)]
numberPrefixes
changeContainerDef :: Direction -> Either Text KM -> DefItemKey m
changeContainerDef direction :: Direction
direction defLabel :: Either Text KM
defLabel =
let (cCurAfterCalm :: ItemDialogMode
cCurAfterCalm, cRestAfterCalm :: [ItemDialogMode]
cRestAfterCalm) = Direction -> (ItemDialogMode, [ItemDialogMode])
nextContainers Direction
direction
in $WDefItemKey :: forall (m :: * -> *).
Either Text KM
-> Bool
-> (Either KM SlotChar -> m (Either Text ResultItemDialogMode))
-> DefItemKey m
DefItemKey
{ Either Text KM
defLabel :: Either Text KM
defLabel :: Either Text KM
defLabel
, defCond :: Bool
defCond = ItemDialogMode
cCurAfterCalm ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemDialogMode
cCur
, defAction :: Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction = \_ ->
Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
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 ResultItemDialogMode))
-> 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 ResultItemDialogMode)
defAction = \_ ->
let eslots :: [ItemId]
eslots = SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
multipleSlots
in Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode))
-> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$! [ItemId] -> Either Text ResultItemDialogMode
getResult [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 ResultItemDialogMode))
-> 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 ResultItemDialogMode)
defAction = \_ ->
Int
-> ItemDialogMode
-> [ItemDialogMode]
-> ItemDialogState
-> m (Either Text ResultItemDialogMode)
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 ResultItemDialogMode))
-> 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 ResultItemDialogMode)
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 ResultItemDialogMode)
forall a. HasCallStack => String -> a
error (String -> m (Either Text ResultItemDialogMode))
-> String -> m (Either Text ResultItemDialogMode)
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 ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode))
-> Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall a b. (a -> b) -> a -> b
$! [ItemId] -> Either Text ResultItemDialogMode
getResult [ItemId
iid]
}
processSpecialOverlay :: OKX -> (Int -> ResultItemDialogMode)
-> m (Either Text ResultItemDialogMode)
processSpecialOverlay :: OKX
-> (Int -> ResultItemDialogMode)
-> m (Either Text ResultItemDialogMode)
processSpecialOverlay io :: OKX
io resultConstructor :: Int -> ResultItemDialogMode
resultConstructor = do
let slotLabels :: [Either [KM] SlotChar]
slotLabels = ((Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar)
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> [a] -> [b]
map (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar
forall a b. (a, b) -> a
fst ([(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [Either [KM] SlotChar])
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [Either [KM] SlotChar]
forall a b. (a -> b) -> a -> b
$ OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
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 ResultItemDialogMode))
-> 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 ResultItemDialogMode)
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
slotIndex :: Int
slotIndex = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (String -> Int
forall a. HasCallStack => String -> a
error "illegal slot")
(Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ SlotChar -> [SlotChar] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex SlotChar
slot [SlotChar]
allSlots
in Either Text ResultItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultItemDialogMode -> Either Text ResultItemDialogMode
forall a b. b -> Either a b
Right (Int -> ResultItemDialogMode
resultConstructor Int
slotIndex))
}
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
runDefItemKey [(KM, DefItemKey m)]
keyDefs DefItemKey m
skillsDef OKX
io [KM]
slotKeys Text
promptChosen ItemDialogMode
cCur
case ItemDialogMode
cCur of
MSkills -> do
OKX
io <- ActorId -> m OKX
forall (m :: * -> *). MonadClientUI m => ActorId -> m OKX
skillsOverlay ActorId
leader
OKX
-> (Int -> ResultItemDialogMode)
-> m (Either Text ResultItemDialogMode)
processSpecialOverlay OKX
io Int -> ResultItemDialogMode
RSkills
MPlaces -> do
OKX
io <- m OKX
forall (m :: * -> *). MonadClientUI m => m OKX
placesOverlay
OKX
-> (Int -> ResultItemDialogMode)
-> m (Either Text ResultItemDialogMode)
processSpecialOverlay OKX
io Int -> ResultItemDialogMode
RPlaces
MModes -> do
OKX
io <- m OKX
forall (m :: * -> *). MonadClientUI m => m OKX
modesOverlay
OKX
-> (Int -> ResultItemDialogMode)
-> m (Either Text ResultItemDialogMode)
processSpecialOverlay OKX
io Int -> ResultItemDialogMode
RModes
_ -> do
let displayRanged :: Bool
displayRanged =
ItemDialogMode
cCur ItemDialogMode -> [ItemDialogMode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CStore -> ItemDialogMode
MStore CStore
COrgan, ItemDialogMode
MOrgans, SLore -> ItemDialogMode
MLore SLore
SOrgan, SLore -> ItemDialogMode
MLore SLore
STrunk]
OKX
io <- SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
forall (m :: * -> *).
MonadClientUI m =>
SingleItemSlots -> LevelId -> ItemBag -> Bool -> m OKX
itemOverlay SingleItemSlots
lSlots (Actor -> LevelId
blid Actor
body) ItemBag
bagFiltered Bool
displayRanged
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 ResultItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
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
runDefItemKey :: (MonadClient m, MonadClientUI m)
=> [(K.KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [K.KM]
-> Text
-> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
runDefItemKey :: [(KM, DefItemKey m)]
-> DefItemKey m
-> OKX
-> [KM]
-> Text
-> ItemDialogMode
-> m (Either Text ResultItemDialogMode)
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
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ 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 :: * -> *).
(MonadClient 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 ResultItemDialogMode)
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction DefItemKey m
keyDef Either KM SlotChar
ekm
Nothing -> DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction DefItemKey m
lettersDef Either KM SlotChar
ekm
Right _slot :: SlotChar
_slot -> DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
forall (m :: * -> *).
DefItemKey m
-> Either KM SlotChar -> m (Either Text ResultItemDialogMode)
defAction DefItemKey m
lettersDef Either KM SlotChar
ekm