-- | Monadic operations on slideshows and related data.
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

-- | Add current report to the overlay, split the result and produce,
-- possibly, many slides.
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  -- report will be shown soon, remove it to history
  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

-- | Split current report into a slideshow.
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, [])

-- | Split current report into a slideshow. Keep report unchanged.
-- Assume the game either halts waiting for a key after this is shown,
-- or many slides are produced, all but the last are displayed
-- with player promts between and the last is either shown
-- in full or ignored if inside macro (can be recovered from history,
-- if important). Unless the prompts interrupt the macro, which is as well.
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
  -- Don't do @recordHistory@; the message is important, but related
  -- to the messages that come after, so should be shown together.
  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, [])

-- | Display a message. Return value indicates if the player wants to continue.
-- Feature: if many pages, only the last SPACE exits (but first ESC).
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
  -- Two frames drawn total (unless @prompt@ very long).
  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

-- | Display a message. Ignore keypresses.
-- Feature: if many pages, only the last SPACE exits (but first ESC).
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

-- | Print a yes/no question and return the player's answer. Use black
-- and white colours to turn player's attention to the choice.
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

-- | Display a, potentially, multi-screen menu and return the chosen
-- key or item slot label (and the index in the whole menu so that the cursor
-- can again be placed at that spot next time menu is displayed).
--
-- This function is the only source of menus and so, effectively, UI modes.
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"]  -- a hack
      legalKeys :: [KM]
legalKeys = [KM]
keys [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM]
navigationKeys
      -- The arguments go from first menu line and menu page to the last,
      -- in order. Their indexing is from 0. We select the nearest item
      -- with the index equal or less to the pointer.
      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
          [] ->  -- not enough menu items on this page
            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 ->  -- no more menu items in later pages
                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  -- can't be @length allOKX@ or a multi-page item menu
                -- mangles saved index of other item munus
      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}}
              -- This also highlights dull white item symbols, but who cares.
              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
                    -- Silent, because any prompt would be shown too late.
                    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" ->  -- a hack
                    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] ->
                    -- This doesn't scroll by screenful when header very long
                    -- and menu non-empty, but that scenario is rare, so OK,
                    -- arrow keys may be used instead.
                    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
  -- Beware, values in @menuIxMap@ may be negative (meaning: a key, not slot).
  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)
                 -- this may be negative, from different context
  (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
                          -- the saved index could be from different context
  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