module Game.LambdaHack.Client.UI.SlideshowM
( overlayToSlideshow, reportToSlideshow, reportToSlideshowKeepHalt
, displaySpaceEsc, displayMore, displayMoreKeep, displayYesNo, getConfirms
, displayChoiceScreen
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Either
import qualified Data.EnumMap.Strict as EM
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Game.LambdaHack.Client.MonadClient
import Game.LambdaHack.Client.UI.Content.Screen
import Game.LambdaHack.Client.UI.ContentClientUI
import Game.LambdaHack.Client.UI.Frame
import Game.LambdaHack.Client.UI.FrameM
import Game.LambdaHack.Client.UI.ItemSlot
import qualified Game.LambdaHack.Client.UI.Key as K
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.Msg
import Game.LambdaHack.Client.UI.MsgM
import Game.LambdaHack.Client.UI.Overlay
import Game.LambdaHack.Client.UI.PointUI
import Game.LambdaHack.Client.UI.SessionUI
import Game.LambdaHack.Client.UI.Slideshow
import Game.LambdaHack.Client.UI.UIOptions
import qualified Game.LambdaHack.Definition.Color as Color
overlayToSlideshow :: MonadClientUI m
=> Int -> [K.KM] -> OKX -> m Slideshow
overlayToSlideshow :: Int -> [KM] -> OKX -> m Slideshow
overlayToSlideshow y :: Int
y keys :: [KM]
keys okx :: OKX
okx = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth, Int
rwrap :: ScreenContent -> Int
rwrap :: Int
rwrap}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
UIOptions{Bool
uScreen1PerLine :: UIOptions -> Bool
uScreen1PerLine :: Bool
uScreen1PerLine} <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
Report
report <- Bool -> m Report
forall (m :: * -> *). MonadClientUI m => Bool -> m Report
getReportUI Bool
True
m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory
FontSetup
fontSetup <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
Slideshow -> m Slideshow
forall (m :: * -> *) a. Monad m => a -> m a
return (Slideshow -> m Slideshow) -> Slideshow -> m Slideshow
forall a b. (a -> b) -> a -> b
$! FontSetup
-> Bool -> Int -> Int -> Int -> Report -> [KM] -> OKX -> Slideshow
splitOverlay FontSetup
fontSetup Bool
uScreen1PerLine Int
rwidth Int
y Int
rwrap
Report
report [KM]
keys OKX
okx
reportToSlideshow :: MonadClientUI m => [K.KM] -> m Slideshow
reportToSlideshow :: [KM] -> m Slideshow
reportToSlideshow keys :: [KM]
keys = do
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
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 (EnumMap DisplayFont Overlay
forall k a. EnumMap k a
EM.empty, [])
reportToSlideshowKeepHalt :: MonadClientUI m => Bool -> [K.KM] -> m Slideshow
reportToSlideshowKeepHalt :: Bool -> [KM] -> m Slideshow
reportToSlideshowKeepHalt insideMenu :: Bool
insideMenu keys :: [KM]
keys = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth, Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight, Int
rwrap :: Int
rwrap :: ScreenContent -> Int
rwrap}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
UIOptions{Bool
uScreen1PerLine :: Bool
uScreen1PerLine :: UIOptions -> Bool
uScreen1PerLine} <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
Report
report <- Bool -> m Report
forall (m :: * -> *). MonadClientUI m => Bool -> m Report
getReportUI Bool
insideMenu
FontSetup
fontSetup <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
Slideshow -> m Slideshow
forall (m :: * -> *) a. Monad m => a -> m a
return (Slideshow -> m Slideshow) -> Slideshow -> m Slideshow
forall a b. (a -> b) -> a -> b
$! FontSetup
-> Bool -> Int -> Int -> Int -> Report -> [KM] -> OKX -> Slideshow
splitOverlay FontSetup
fontSetup Bool
uScreen1PerLine Int
rwidth (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) Int
rwrap
Report
report [KM]
keys (EnumMap DisplayFont Overlay
forall k a. EnumMap k a
EM.empty, [])
displaySpaceEsc :: (MonadClient m, MonadClientUI m)
=> ColorMode -> Text -> m Bool
displaySpaceEsc :: ColorMode -> Text -> m Bool
displaySpaceEsc dm :: ColorMode
dm prompt :: Text
prompt = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
prompt) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShow
MsgPromptGeneric Text
prompt
Slideshow
slides <- [KM] -> m Slideshow
forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
reportToSlideshow [KM
K.spaceKM, KM
K.escKM]
KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
dm [KM
K.spaceKM, KM
K.escKM] Slideshow
slides
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
$! KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.spaceKM
displayMore :: (MonadClient m, MonadClientUI m) => ColorMode -> Text -> m ()
displayMore :: ColorMode -> Text -> m ()
displayMore dm :: ColorMode
dm prompt :: Text
prompt = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
prompt) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShow
MsgPromptGeneric Text
prompt
Slideshow
slides <- [KM] -> m Slideshow
forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
reportToSlideshow [KM
K.spaceKM]
m KM -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m KM -> m ()) -> m KM -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
dm [KM
K.spaceKM, KM
K.escKM] Slideshow
slides
displayMoreKeep :: (MonadClient m, MonadClientUI m) => ColorMode -> Text -> m ()
displayMoreKeep :: ColorMode -> Text -> m ()
displayMoreKeep dm :: ColorMode
dm prompt :: Text
prompt = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
prompt) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShow
MsgPromptGeneric Text
prompt
Slideshow
slides <- Bool -> [KM] -> m Slideshow
forall (m :: * -> *).
MonadClientUI m =>
Bool -> [KM] -> m Slideshow
reportToSlideshowKeepHalt Bool
True [KM
K.spaceKM]
m KM -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m KM -> m ()) -> m KM -> m ()
forall a b. (a -> b) -> a -> b
$ ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
dm [KM
K.spaceKM, KM
K.escKM] Slideshow
slides
displayYesNo :: (MonadClient m, MonadClientUI m) => ColorMode -> Text -> m Bool
displayYesNo :: ColorMode -> Text -> m Bool
displayYesNo dm :: ColorMode
dm prompt :: Text
prompt = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
prompt) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgLnAdd MsgClassShow
MsgPromptGeneric Text
prompt
let yn :: [KM]
yn = (Char -> KM) -> [Char] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map Char -> KM
K.mkChar ['y', 'n']
Slideshow
slides <- [KM] -> m Slideshow
forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
reportToSlideshow [KM]
yn
KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
dm (KM
K.escKM KM -> [KM] -> [KM]
forall a. a -> [a] -> [a]
: [KM]
yn) Slideshow
slides
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
$! KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> KM
K.mkChar 'y'
getConfirms :: (MonadClient m, MonadClientUI m)
=> ColorMode -> [K.KM] -> Slideshow -> m K.KM
getConfirms :: ColorMode -> [KM] -> Slideshow -> m KM
getConfirms dm :: ColorMode
dm extraKeys :: [KM]
extraKeys slides :: Slideshow
slides = do
Either KM SlotChar
ekm <- [Char]
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[Char]
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "" ColorMode
dm Bool
False Slideshow
slides [KM]
extraKeys
KM -> m KM
forall (m :: * -> *) a. Monad m => a -> m a
return (KM -> m KM) -> KM -> m KM
forall a b. (a -> b) -> a -> b
$! (KM -> KM) -> (SlotChar -> KM) -> Either KM SlotChar -> KM
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either KM -> KM
forall a. a -> a
id ([Char] -> SlotChar -> KM
forall a. HasCallStack => [Char] -> a
error ([Char] -> SlotChar -> KM) -> [Char] -> SlotChar -> KM
forall a b. (a -> b) -> a -> b
$ "" [Char] -> Either KM SlotChar -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Either KM SlotChar
ekm) Either KM SlotChar
ekm
displayChoiceScreen :: forall m . (MonadClient m, MonadClientUI m)
=> String -> ColorMode -> Bool -> Slideshow -> [K.KM]
-> m (Either K.KM SlotChar)
displayChoiceScreen :: [Char]
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen menuName :: [Char]
menuName dm :: ColorMode
dm sfBlank :: Bool
sfBlank frsX :: Slideshow
frsX extraKeys :: [KM]
extraKeys = do
let frs :: [OKX]
frs = Slideshow -> [OKX]
slideshow Slideshow
frsX
keys :: [KM]
keys = (OKX -> [KM]) -> [OKX] -> [KM]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((Either [KM] SlotChar, (PointUI, ButtonWidth)) -> [KM])
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> [KM]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([KM] -> Either [KM] SlotChar -> [KM]
forall a b. a -> Either a b -> a
fromLeft [] (Either [KM] SlotChar -> [KM])
-> ((Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar)
-> (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar
forall a b. (a, b) -> a
fst) ([(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> [KM])
-> (OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
-> OKX
-> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b. (a, b) -> b
snd) [OKX]
frs
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM]
extraKeys
!_A :: ()
_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (KM
K.escKM KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
extraKeys) ()
navigationKeys :: [KM]
navigationKeys = [ KM
K.leftButtonReleaseKM, KM
K.rightButtonReleaseKM
, KM
K.returnKM, KM
K.spaceKM
, KM
K.upKM, KM
K.leftKM, KM
K.downKM, KM
K.rightKM
, KM
K.pgupKM, KM
K.pgdnKM, KM
K.wheelNorthKM, KM
K.wheelSouthKM
, KM
K.homeKM, KM
K.endKM, KM
K.controlP ]
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [Char -> KM
K.mkChar '?' | [Char]
menuName [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "help"]
legalKeys :: [KM]
legalKeys = [KM]
keys [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM]
navigationKeys
findKYX :: Int -> [OKX] -> Maybe (OKX, KYX, Int)
findKYX :: Int
-> [OKX]
-> Maybe (OKX, (Either [KM] SlotChar, (PointUI, ButtonWidth)), Int)
findKYX _ [] = Maybe (OKX, (Either [KM] SlotChar, (PointUI, ButtonWidth)), Int)
forall a. Maybe a
Nothing
findKYX pointer :: Int
pointer (okx :: OKX
okx@(_, kyxs :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kyxs) : frs2 :: [OKX]
frs2) =
case Int
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a. Int -> [a] -> [a]
drop Int
pointer [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kyxs of
[] ->
case Int
-> [OKX]
-> Maybe (OKX, (Either [KM] SlotChar, (PointUI, ButtonWidth)), Int)
findKYX (Int
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Int
forall a. [a] -> Int
length [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kyxs) [OKX]
frs2 of
Nothing ->
case [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a. [a] -> [a]
reverse [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kyxs of
[] -> Maybe (OKX, (Either [KM] SlotChar, (PointUI, ButtonWidth)), Int)
forall a. Maybe a
Nothing
kyx :: (Either [KM] SlotChar, (PointUI, ButtonWidth))
kyx : _ -> (OKX, (Either [KM] SlotChar, (PointUI, ButtonWidth)), Int)
-> Maybe (OKX, (Either [KM] SlotChar, (PointUI, ButtonWidth)), Int)
forall a. a -> Maybe a
Just (OKX
okx, (Either [KM] SlotChar, (PointUI, ButtonWidth))
kyx, [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Int
forall a. [a] -> Int
length [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kyxs Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
res :: Maybe (OKX, (Either [KM] SlotChar, (PointUI, ButtonWidth)), Int)
res -> Maybe (OKX, (Either [KM] SlotChar, (PointUI, ButtonWidth)), Int)
res
kyx :: (Either [KM] SlotChar, (PointUI, ButtonWidth))
kyx : _ -> (OKX, (Either [KM] SlotChar, (PointUI, ButtonWidth)), Int)
-> Maybe (OKX, (Either [KM] SlotChar, (PointUI, ButtonWidth)), Int)
forall a. a -> Maybe a
Just (OKX
okx, (Either [KM] SlotChar, (PointUI, ButtonWidth))
kyx, Int
pointer)
maxIx :: Int
maxIx = [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Int
forall a. [a] -> Int
length ((OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
-> [OKX] -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b. (a, b) -> b
snd [OKX]
frs) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
allOKX :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
allOKX = (OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
-> [OKX] -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OKX -> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b. (a, b) -> b
snd [OKX]
frs
initIx :: Int
initIx = case ((Either [KM] SlotChar, (PointUI, ButtonWidth)) -> Bool)
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Either [KM] SlotChar -> Bool
forall a b. Either a b -> Bool
isRight (Either [KM] SlotChar -> Bool)
-> ((Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar)
-> (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar
forall a b. (a, b) -> a
fst) [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
allOKX of
Just p :: Int
p -> Int
p
_ -> 0
clearIx :: Int
clearIx = if Int
initIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxIx then 0 else Int
initIx
page :: Int -> m (Either K.KM SlotChar, Int)
page :: Int -> m (Either KM SlotChar, Int)
page pointer :: Int
pointer = Bool -> m (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall a. HasCallStack => Bool -> a -> a
assert (Int
pointer Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0) (m (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int))
-> m (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall a b. (a -> b) -> a -> b
$ case Int
-> [OKX]
-> Maybe (OKX, (Either [KM] SlotChar, (PointUI, ButtonWidth)), Int)
findKYX Int
pointer [OKX]
frs of
Nothing -> [Char] -> m (Either KM SlotChar, Int)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Either KM SlotChar, Int))
-> [Char] -> m (Either KM SlotChar, Int)
forall a b. (a -> b) -> a -> b
$ "no menu keys" [Char] -> [OKX] -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` [OKX]
frs
Just ( (ovs :: EnumMap DisplayFont Overlay
ovs, kyxs :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kyxs)
, (ekm :: Either [KM] SlotChar
ekm, (PointUI x1 :: Int
x1 y :: Int
y, ButtonWidth fontX1 :: DisplayFont
fontX1 len :: Int
len))
, ixOnPage :: Int
ixOnPage ) -> do
let highableAttrs :: [Attr]
highableAttrs =
[Attr
Color.defAttr, Attr
Color.defAttr {fg :: Color
Color.fg = Color
Color.BrBlack}]
highAttr :: AttrChar -> AttrChar
highAttr x :: AttrChar
x | AttrChar -> Attr
Color.acAttr AttrChar
x Attr -> [Attr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Attr]
highableAttrs
Bool -> Bool -> Bool
|| AttrChar -> Char
Color.acChar AttrChar
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' = AttrChar
x
highAttr x :: AttrChar
x = AttrChar
x {acAttr :: Attr
Color.acAttr =
(AttrChar -> Attr
Color.acAttr AttrChar
x) {fg :: Color
Color.fg = Color
Color.BrWhite}}
cursorAttr :: AttrChar -> AttrChar
cursorAttr x :: AttrChar
x = AttrChar
x {acAttr :: Attr
Color.acAttr =
(AttrChar -> Attr
Color.acAttr AttrChar
x)
{bg :: Highlight
Color.bg = Highlight
Color.HighlightNoneCursor}}
lenUI :: Int
lenUI = if DisplayFont -> Bool
isSquareFont DisplayFont
fontX1 then Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2 else Int
len
drawHighlight :: Int -> [AttrCharW32] -> [AttrCharW32]
drawHighlight xstart :: Int
xstart xs :: [AttrCharW32]
xs | Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lenUI Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
xstart = [AttrCharW32]
xs
| Bool
otherwise =
let x1MinusXStartChars :: Int
x1MinusXStartChars = if DisplayFont -> Bool
isSquareFont DisplayFont
fontX1
then (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xstart) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2
else Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xstart
(xs1 :: [AttrCharW32]
xs1, xsRest :: [AttrCharW32]
xsRest) = Int -> [AttrCharW32] -> ([AttrCharW32], [AttrCharW32])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
x1MinusXStartChars [AttrCharW32]
xs
(xs2 :: [AttrCharW32]
xs2, xs3 :: [AttrCharW32]
xs3) = Int -> [AttrCharW32] -> ([AttrCharW32], [AttrCharW32])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
len [AttrCharW32]
xsRest
highW32 :: AttrCharW32 -> AttrCharW32
highW32 = AttrChar -> AttrCharW32
Color.attrCharToW32
(AttrChar -> AttrCharW32)
-> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrCharW32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrChar -> AttrChar
highAttr
(AttrChar -> AttrChar)
-> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> AttrChar
Color.attrCharFromW32
cursorW32 :: AttrCharW32 -> AttrCharW32
cursorW32 = AttrChar -> AttrCharW32
Color.attrCharToW32
(AttrChar -> AttrCharW32)
-> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrCharW32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrChar -> AttrChar
cursorAttr
(AttrChar -> AttrChar)
-> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> AttrChar
Color.attrCharFromW32
xs2High :: [AttrCharW32]
xs2High = case (AttrCharW32 -> AttrCharW32) -> [AttrCharW32] -> [AttrCharW32]
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> AttrCharW32
highW32 [AttrCharW32]
xs2 of
[] -> []
xh :: AttrCharW32
xh : xhrest :: [AttrCharW32]
xhrest -> AttrCharW32 -> AttrCharW32
cursorW32 AttrCharW32
xh AttrCharW32 -> [AttrCharW32] -> [AttrCharW32]
forall a. a -> [a] -> [a]
: [AttrCharW32]
xhrest
in [AttrCharW32]
xs1 [AttrCharW32] -> [AttrCharW32] -> [AttrCharW32]
forall a. [a] -> [a] -> [a]
++ [AttrCharW32]
xs2High [AttrCharW32] -> [AttrCharW32] -> [AttrCharW32]
forall a. [a] -> [a] -> [a]
++ [AttrCharW32]
xs3
ovs1 :: EnumMap DisplayFont Overlay
ovs1 = (Overlay -> Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Int
-> (Int -> [AttrCharW32] -> [AttrCharW32]) -> Overlay -> Overlay
updateLine Int
y Int -> [AttrCharW32] -> [AttrCharW32]
drawHighlight) EnumMap DisplayFont Overlay
ovs
ignoreKey :: m (Either KM SlotChar, Int)
ignoreKey = Int -> m (Either KM SlotChar, Int)
page Int
pointer
pageLen :: Int
pageLen = [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Int
forall a. [a] -> Int
length [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kyxs
xix :: KYX -> Bool
xix :: (Either [KM] SlotChar, (PointUI, ButtonWidth)) -> Bool
xix (_, (PointUI x1' :: Int
x1' _, _)) = Int
x1' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Bool -> Bool -> Bool
&& Int
x1' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2
firstRowOfNextPage :: Int
firstRowOfNextPage = Int
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pageLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ixOnPage
restOKX :: [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
restOKX = Int
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a. Int -> [a] -> [a]
drop Int
firstRowOfNextPage [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
allOKX
firstItemOfNextPage :: Int
firstItemOfNextPage = case ((Either [KM] SlotChar, (PointUI, ButtonWidth)) -> Bool)
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Either [KM] SlotChar -> Bool
forall a b. Either a b -> Bool
isRight (Either [KM] SlotChar -> Bool)
-> ((Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar)
-> (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either [KM] SlotChar, (PointUI, ButtonWidth))
-> Either [KM] SlotChar
forall a b. (a, b) -> a
fst) [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
restOKX of
Just p :: Int
p -> Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
firstRowOfNextPage
_ -> Int
firstRowOfNextPage
interpretKey :: K.KM -> m (Either K.KM SlotChar, Int)
interpretKey :: KM -> m (Either KM SlotChar, Int)
interpretKey ikm :: KM
ikm =
case KM -> Key
K.key KM
ikm of
_ | KM
ikm KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.controlP -> do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
printScreen
m (Either KM SlotChar, Int)
ignoreKey
K.Return -> case Either [KM] SlotChar
ekm of
Left (km :: KM
km : _) ->
if KM -> Key
K.key KM
km Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
K.Return Bool -> Bool -> Bool
&& KM
km KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys
then (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (KM -> Either KM SlotChar
forall a b. a -> Either a b
Left KM
km, Int
pointer)
else KM -> m (Either KM SlotChar, Int)
interpretKey KM
km
Left [] -> [Char] -> m (Either KM SlotChar, Int)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Either KM SlotChar, Int))
-> [Char] -> m (Either KM SlotChar, Int)
forall a b. (a -> b) -> a -> b
$ "" [Char] -> KM -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` KM
ikm
Right c :: SlotChar
c -> (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (SlotChar -> Either KM SlotChar
forall a b. b -> Either a b
Right SlotChar
c, Int
pointer)
K.LeftButtonRelease -> do
PointUI mx :: Int
mx my :: Int
my <- (SessionUI -> PointUI) -> m PointUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
let onChoice :: (Either [KM] SlotChar, (PointUI, ButtonWidth)) -> Bool
onChoice (_, (PointUI cx :: Int
cx cy :: Int
cy, ButtonWidth font :: DisplayFont
font clen :: Int
clen)) =
let blen :: Int
blen | DisplayFont -> Bool
isSquareFont DisplayFont
font = 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
clen
| Bool
otherwise = Int
clen
in Int
my Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cy Bool -> Bool -> Bool
&& Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
cx Bool -> Bool -> Bool
&& Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blen
case ((Either [KM] SlotChar, (PointUI, ButtonWidth)) -> Bool)
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> Maybe (Either [KM] SlotChar, (PointUI, ButtonWidth))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Either [KM] SlotChar, (PointUI, ButtonWidth)) -> Bool
onChoice [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kyxs of
Nothing | KM
ikm KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys -> (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (KM -> Either KM SlotChar
forall a b. a -> Either a b
Left KM
ikm, Int
pointer)
Nothing -> if KM
K.spaceKM KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys
then (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (KM -> Either KM SlotChar
forall a b. a -> Either a b
Left KM
K.spaceKM, Int
pointer)
else m (Either KM SlotChar, Int)
ignoreKey
Just (ckm :: Either [KM] SlotChar
ckm, _) -> case Either [KM] SlotChar
ckm of
Left (km :: KM
km : _) ->
if KM -> Key
K.key KM
km Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
K.Return Bool -> Bool -> Bool
&& KM
km KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys
then (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (KM -> Either KM SlotChar
forall a b. a -> Either a b
Left KM
km, Int
pointer)
else KM -> m (Either KM SlotChar, Int)
interpretKey KM
km
Left [] -> [Char] -> m (Either KM SlotChar, Int)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Either KM SlotChar, Int))
-> [Char] -> m (Either KM SlotChar, Int)
forall a b. (a -> b) -> a -> b
$ "" [Char] -> KM -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` KM
ikm
Right c :: SlotChar
c -> (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (SlotChar -> Either KM SlotChar
forall a b. b -> Either a b
Right SlotChar
c, Int
pointer)
K.RightButtonRelease ->
if | KM
ikm KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys -> (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (KM -> Either KM SlotChar
forall a b. a -> Either a b
Left KM
ikm, Int
pointer)
| KM
K.escKM KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys -> (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (KM -> Either KM SlotChar
forall a b. a -> Either a b
Left KM
K.escKM, Int
pointer)
| Bool
otherwise -> m (Either KM SlotChar, Int)
ignoreKey
K.Space | Int
firstItemOfNextPage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxIx ->
Int -> m (Either KM SlotChar, Int)
page Int
firstItemOfNextPage
K.Char '?' | Int
firstItemOfNextPage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxIx
Bool -> Bool -> Bool
&& [Char]
menuName [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "help" ->
Int -> m (Either KM SlotChar, Int)
page Int
firstItemOfNextPage
K.Unknown "SAFE_SPACE" ->
if Int
firstItemOfNextPage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxIx
then Int -> m (Either KM SlotChar, Int)
page Int
firstItemOfNextPage
else Int -> m (Either KM SlotChar, Int)
page Int
clearIx
_ | KM
ikm KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys ->
(Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (KM -> Either KM SlotChar
forall a b. a -> Either a b
Left KM
ikm, Int
pointer)
K.Up -> case ((Either [KM] SlotChar, (PointUI, ButtonWidth)) -> Bool)
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Either [KM] SlotChar, (PointUI, ButtonWidth)) -> Bool
xix ([(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Maybe Int)
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a. [a] -> [a]
reverse ([(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))])
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a b. (a -> b) -> a -> b
$ Int
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a. Int -> [a] -> [a]
take Int
ixOnPage [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kyxs of
Nothing -> KM -> m (Either KM SlotChar, Int)
interpretKey KM
ikm{key :: Key
K.key=Key
K.Left}
Just ix :: Int
ix -> Int -> m (Either KM SlotChar, Int)
page (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1))
K.Left -> if Int
pointer Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Int -> m (Either KM SlotChar, Int)
page Int
maxIx
else Int -> m (Either KM SlotChar, Int)
page (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1))
K.Down -> case ((Either [KM] SlotChar, (PointUI, ButtonWidth)) -> Bool)
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Either [KM] SlotChar, (PointUI, ButtonWidth)) -> Bool
xix ([(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Maybe Int)
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
-> [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
forall a. Int -> [a] -> [a]
drop (Int
ixOnPage Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) [(Either [KM] SlotChar, (PointUI, ButtonWidth))]
kyxs of
Nothing -> KM -> m (Either KM SlotChar, Int)
interpretKey KM
ikm{key :: Key
K.key=Key
K.Right}
Just ix :: Int
ix -> Int -> m (Either KM SlotChar, Int)
page (Int
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
K.Right -> if Int
pointer Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxIx then Int -> m (Either KM SlotChar, Int)
page 0
else Int -> m (Either KM SlotChar, Int)
page (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxIx (Int
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))
K.Home -> Int -> m (Either KM SlotChar, Int)
page Int
clearIx
K.End -> Int -> m (Either KM SlotChar, Int)
page Int
maxIx
_ | KM -> Key
K.key KM
ikm Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
K.PgUp, Key
K.WheelNorth] ->
Int -> m (Either KM SlotChar, Int)
page (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ixOnPage Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1))
_ | KM -> Key
K.key KM
ikm Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
K.PgDn, Key
K.WheelSouth] ->
Int -> m (Either KM SlotChar, Int)
page (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxIx Int
firstItemOfNextPage)
K.Space -> if Int
pointer Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxIx
then Int -> m (Either KM SlotChar, Int)
page Int
clearIx
else Int -> m (Either KM SlotChar, Int)
page Int
maxIx
_ -> [Char] -> m (Either KM SlotChar, Int)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Either KM SlotChar, Int))
-> [Char] -> m (Either KM SlotChar, Int)
forall a b. (a -> b) -> a -> b
$ "unknown key" [Char] -> KM -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` KM
ikm
KM
pkm <- ColorMode -> EnumMap DisplayFont Overlay -> Bool -> [KM] -> m KM
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> EnumMap DisplayFont Overlay -> Bool -> [KM] -> m KM
promptGetKey ColorMode
dm EnumMap DisplayFont Overlay
ovs1 Bool
sfBlank [KM]
legalKeys
KM -> m (Either KM SlotChar, Int)
interpretKey KM
pkm
Map [Char] Int
menuIxMap <- (SessionUI -> Map [Char] Int) -> m (Map [Char] Int)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Map [Char] Int
smenuIxMap
let menuIx :: Int
menuIx | [Char]
menuName [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "" = Int
clearIx
| Bool
otherwise =
Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
clearIx (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
initIx) ([Char] -> Map [Char] Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup [Char]
menuName Map [Char] Int
menuIxMap)
(km :: Either KM SlotChar
km, pointer :: Int
pointer) <- if [OKX] -> Bool
forall a. [a] -> Bool
null [OKX]
frs
then (Either KM SlotChar, Int) -> m (Either KM SlotChar, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (KM -> Either KM SlotChar
forall a b. a -> Either a b
Left KM
K.escKM, Int
menuIx)
else Int -> m (Either KM SlotChar, Int)
page (Int -> m (Either KM SlotChar, Int))
-> Int -> m (Either KM SlotChar, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
clearIx (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxIx Int
menuIx
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char]
menuName [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
SessionUI
sess {smenuIxMap :: Map [Char] Int
smenuIxMap = [Char] -> Int -> Map [Char] Int -> Map [Char] Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert [Char]
menuName (Int
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
initIx) Map [Char] Int
menuIxMap}
Bool -> m (Either KM SlotChar) -> m (Either KM SlotChar)
forall a. HasCallStack => Bool -> a -> a
assert ((KM -> Bool) -> (SlotChar -> Bool) -> Either KM SlotChar -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys) (Bool -> SlotChar -> Bool
forall a b. a -> b -> a
const Bool
True) Either KM SlotChar
km) (m (Either KM SlotChar) -> m (Either KM SlotChar))
-> m (Either KM SlotChar) -> m (Either KM SlotChar)
forall a b. (a -> b) -> a -> b
$ Either KM SlotChar -> m (Either KM SlotChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Either KM SlotChar
km