module Game.LambdaHack.Client.UI.SlideshowM
( overlayToSlideshow, reportToSlideshow, reportToSlideshowKeepHalt
, displaySpaceEsc, displayMore, displayMoreKeep, displayYesNo, getConfirms
, displayChoiceScreen, displayChoiceScreenWithRightPane
#ifdef EXPOSE_INTERNAL
, getMenuIx, saveMenuIx, stepChoiceScreen, navigationKeys, findKYX
, drawHighlight
#endif
) 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.UI.Content.Screen
import Game.LambdaHack.Client.UI.ContentClientUI
import Game.LambdaHack.Client.UI.Frame
import Game.LambdaHack.Client.UI.FrameM
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 Int
y [KM]
keys OKX
okx = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
UIOptions{Int
uMsgWrapColumn :: UIOptions -> Int
uMsgWrapColumn :: Int
uMsgWrapColumn} <- (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
-> Int -> Int -> Int -> Report -> [KM] -> OKX -> Slideshow
splitOverlay FontSetup
fontSetup Int
rwidth Int
y Int
uMsgWrapColumn Report
report [KM]
keys OKX
okx
reportToSlideshow :: MonadClientUI m => [K.KM] -> m Slideshow
reportToSlideshow :: [KM] -> m Slideshow
reportToSlideshow [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
- Int
2) [KM]
keys OKX
emptyOKX
reportToSlideshowKeepHalt :: MonadClientUI m => Bool -> [K.KM] -> m Slideshow
reportToSlideshowKeepHalt :: Bool -> [KM] -> m Slideshow
reportToSlideshowKeepHalt Bool
insideMenu [KM]
keys = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth, Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
UIOptions{Int
uMsgWrapColumn :: Int
uMsgWrapColumn :: UIOptions -> Int
uMsgWrapColumn} <- (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
-> Int -> Int -> Int -> Report -> [KM] -> OKX -> Slideshow
splitOverlay FontSetup
fontSetup Int
rwidth (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
uMsgWrapColumn
Report
report [KM]
keys OKX
emptyOKX
displaySpaceEsc :: MonadClientUI m => ColorMode -> Text -> m Bool
displaySpaceEsc :: ColorMode -> Text -> m Bool
displaySpaceEsc ColorMode
dm 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.
(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 :: * -> *).
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 :: MonadClientUI m => ColorMode -> Text -> m ()
displayMore :: ColorMode -> Text -> m ()
displayMore ColorMode
dm 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.
(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 :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
dm [KM
K.spaceKM, KM
K.escKM] Slideshow
slides
displayMoreKeep :: MonadClientUI m => ColorMode -> Text -> m ()
displayMoreKeep :: ColorMode -> Text -> m ()
displayMoreKeep ColorMode
dm 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.
(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 :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
dm [KM
K.spaceKM, KM
K.escKM] Slideshow
slides
displayYesNo :: MonadClientUI m => ColorMode -> Text -> m Bool
displayYesNo :: ColorMode -> Text -> m Bool
displayYesNo ColorMode
dm 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.
(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 [Char
'y', Char
'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 :: * -> *).
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 Char
'y'
getConfirms :: MonadClientUI m
=> ColorMode -> [K.KM] -> Slideshow -> m K.KM
getConfirms :: ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
dm [KM]
extraKeys Slideshow
slides = do
KeyOrSlot
ekm <- [Char] -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
[Char] -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreen [Char]
"" 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) -> KeyOrSlot -> 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]
"" [Char] -> KeyOrSlot -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` KeyOrSlot
ekm) KeyOrSlot
ekm
displayChoiceScreen :: forall m . MonadClientUI m
=> String -> ColorMode -> Bool -> Slideshow -> [K.KM]
-> m KeyOrSlot
displayChoiceScreen :: [Char] -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreen =
(KeyOrSlot -> m OKX)
-> [Char] -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
(KeyOrSlot -> m OKX)
-> [Char] -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreenWithRightPane ((KeyOrSlot -> m OKX)
-> [Char] -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot)
-> (KeyOrSlot -> m OKX)
-> [Char]
-> ColorMode
-> Bool
-> Slideshow
-> [KM]
-> m KeyOrSlot
forall a b. (a -> b) -> a -> b
$ m OKX -> KeyOrSlot -> m OKX
forall a b. a -> b -> a
const (m OKX -> KeyOrSlot -> m OKX) -> m OKX -> KeyOrSlot -> m OKX
forall a b. (a -> b) -> a -> b
$ OKX -> m OKX
forall (m :: * -> *) a. Monad m => a -> m a
return OKX
emptyOKX
displayChoiceScreenWithRightPane
:: forall m . MonadClientUI m
=> (KeyOrSlot -> m OKX)
-> String -> ColorMode -> Bool -> Slideshow -> [K.KM]
-> m KeyOrSlot
displayChoiceScreenWithRightPane :: (KeyOrSlot -> m OKX)
-> [Char] -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreenWithRightPane KeyOrSlot -> m OKX
displayInRightPane
[Char]
menuName ColorMode
dm Bool
sfBlank Slideshow
frsX [KM]
extraKeys = do
(Int
maxIx, Int
initIx, Int
clearIx, Int -> OKX -> m (Bool, KeyOrSlot, Int)
m) <-
[Char]
-> ColorMode
-> Bool
-> Slideshow
-> [KM]
-> m (Int, Int, Int, Int -> OKX -> m (Bool, KeyOrSlot, Int))
forall (m :: * -> *).
MonadClientUI m =>
[Char]
-> ColorMode
-> Bool
-> Slideshow
-> [KM]
-> m (Int, Int, Int, Int -> OKX -> m (Bool, KeyOrSlot, Int))
stepChoiceScreen [Char]
menuName ColorMode
dm Bool
sfBlank Slideshow
frsX [KM]
extraKeys
let loop :: Int -> KeyOrSlot -> m (KeyOrSlot, Int)
loop :: Int -> KeyOrSlot -> m (KeyOrSlot, Int)
loop Int
pointer KeyOrSlot
km = do
OKX
okxRight <- KeyOrSlot -> m OKX
displayInRightPane KeyOrSlot
km
(Bool
final, KeyOrSlot
km1, Int
pointer1) <- Int -> OKX -> m (Bool, KeyOrSlot, Int)
m Int
pointer OKX
okxRight
if Bool
final
then (KeyOrSlot, Int) -> m (KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyOrSlot
km1, Int
pointer1)
else Int -> KeyOrSlot -> m (KeyOrSlot, Int)
loop Int
pointer1 KeyOrSlot
km1
Int
pointer0 <- [Char] -> Int -> Int -> Int -> m Int
forall (m :: * -> *).
MonadClientUI m =>
[Char] -> Int -> Int -> Int -> m Int
getMenuIx [Char]
menuName Int
maxIx Int
initIx Int
clearIx
let km0 :: KeyOrSlot
km0 = case Int -> [OKX] -> Maybe (OKX, KYX, Int)
findKYX Int
pointer0 ([OKX] -> Maybe (OKX, KYX, Int)) -> [OKX] -> Maybe (OKX, KYX, Int)
forall a b. (a -> b) -> a -> b
$ Slideshow -> [OKX]
slideshow Slideshow
frsX of
Maybe (OKX, KYX, Int)
Nothing -> [Char] -> KeyOrSlot
forall a. HasCallStack => [Char] -> a
error ([Char] -> KeyOrSlot) -> [Char] -> KeyOrSlot
forall a b. (a -> b) -> a -> b
$ [Char]
"no menu keys" [Char] -> Slideshow -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Slideshow
frsX
Just (OKX
_, (KeyOrSlot
ekm, (PointUI, ButtonWidth)
_), Int
_) -> KeyOrSlot
ekm
(KeyOrSlot
km, Int
pointer) <- Int -> KeyOrSlot -> m (KeyOrSlot, Int)
loop Int
pointer0 KeyOrSlot
km0
[Char] -> Int -> Int -> m ()
forall (m :: * -> *).
MonadClientUI m =>
[Char] -> Int -> Int -> m ()
saveMenuIx [Char]
menuName Int
initIx Int
pointer
KeyOrSlot -> m KeyOrSlot
forall (m :: * -> *) a. Monad m => a -> m a
return KeyOrSlot
km
getMenuIx :: MonadClientUI m => String -> Int -> Int -> Int -> m Int
[Char]
menuName Int
maxIx Int
initIx Int
clearIx = do
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 = if [Char]
menuName [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
""
then Int
clearIx
else 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)
Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m 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
saveMenuIx :: MonadClientUI m => String -> Int -> Int -> m ()
[Char]
menuName Int
initIx Int
pointer =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Char]
menuName [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"") (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
$ \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 -> Map [Char] Int)
-> Map [Char] Int -> Map [Char] Int
forall a b. (a -> b) -> a -> b
$ SessionUI -> Map [Char] Int
smenuIxMap SessionUI
sess}
stepChoiceScreen :: forall m . MonadClientUI m
=> String -> ColorMode -> Bool -> Slideshow -> [K.KM]
-> m ( Int, Int, Int
, Int -> OKX -> m (Bool, KeyOrSlot, Int) )
stepChoiceScreen :: [Char]
-> ColorMode
-> Bool
-> Slideshow
-> [KM]
-> m (Int, Int, Int, Int -> OKX -> m (Bool, KeyOrSlot, Int))
stepChoiceScreen [Char]
menuName ColorMode
dm Bool
sfBlank Slideshow
frsX [KM]
extraKeys = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth, Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FontSetup{DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let !_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) ()
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 ([KeyOrSlot] -> [KM]
forall a b. [Either a b] -> [a]
lefts ([KeyOrSlot] -> [KM]) -> (OKX -> [KeyOrSlot]) -> OKX -> [KM]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KYX -> KeyOrSlot) -> [KYX] -> [KeyOrSlot]
forall a b. (a -> b) -> [a] -> [b]
map KYX -> KeyOrSlot
forall a b. (a, b) -> a
fst ([KYX] -> [KeyOrSlot]) -> (OKX -> [KYX]) -> OKX -> [KeyOrSlot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OKX -> [KYX]
forall a b. (a, b) -> b
snd) [OKX]
frs [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM]
extraKeys
legalKeys :: [KM]
legalKeys = [KM]
keys
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM]
navigationKeys
[KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ (if [Char]
menuName [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"help"
then [Char -> KM
K.mkChar Char
'?', [Char] -> KM
K.mkKM [Char]
"F1"]
else [])
allOKX :: [KYX]
allOKX = (OKX -> [KYX]) -> [OKX] -> [KYX]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OKX -> [KYX]
forall a b. (a, b) -> b
snd [OKX]
frs
maxIx :: Int
maxIx = [KYX] -> Int
forall a. [a] -> Int
length [KYX]
allOKX Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
initIx :: Int
initIx = case (KYX -> Bool) -> [KYX] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (KeyOrSlot -> Bool
forall a b. Either a b -> Bool
isRight (KeyOrSlot -> Bool) -> (KYX -> KeyOrSlot) -> KYX -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KYX -> KeyOrSlot
forall a b. (a, b) -> a
fst) [KYX]
allOKX of
Just Int
p -> Int
p
Maybe Int
_ -> Int
0
clearIx :: Int
clearIx = if Int
initIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxIx then Int
0 else Int
initIx
canvasLength :: Int
canvasLength = if Bool
sfBlank then Int
rheight else Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
trimmedY :: Int
trimmedY = Int
canvasLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
trimmedAlert :: (PointUI, AttrLine)
trimmedAlert = ( Int -> Int -> PointUI
PointUI Int
0 Int
trimmedY
, [Char] -> AttrLine
stringToAL [Char]
"--a portion of the text trimmed--" )
page :: Int -> OKX -> m (Bool, KeyOrSlot, Int)
page :: Int -> OKX -> m (Bool, KeyOrSlot, Int)
page Int
pointer (FontOverlayMap
ovsRight0, [KYX]
kyxsRight) = Bool -> m (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall a. HasCallStack => Bool -> a -> a
assert (Int
pointer Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
(m (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int))
-> m (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall a b. (a -> b) -> a -> b
$ case Int -> [OKX] -> Maybe (OKX, KYX, Int)
findKYX Int
pointer [OKX]
frs of
Maybe (OKX, KYX, Int)
Nothing -> [Char] -> m (Bool, KeyOrSlot, Int)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Bool, KeyOrSlot, Int))
-> [Char] -> m (Bool, KeyOrSlot, Int)
forall a b. (a -> b) -> a -> b
$ [Char]
"no menu keys" [Char] -> [OKX] -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` [OKX]
frs
Just ( (FontOverlayMap
ovs0, [KYX]
kyxs1)
, (KeyOrSlot
ekm, (PointUI Int
x1 Int
y, ButtonWidth
buttonWidth))
, Int
ixOnPage ) -> do
let ovs1 :: FontOverlayMap
ovs1 = (Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Int -> (Int -> AttrString -> AttrString) -> Overlay -> Overlay
updateLine Int
y ((Int -> AttrString -> AttrString) -> Overlay -> Overlay)
-> (Int -> AttrString -> AttrString) -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> ButtonWidth -> Int -> AttrString -> AttrString
drawHighlight Int
x1 ButtonWidth
buttonWidth) FontOverlayMap
ovs0
ymax :: Int
ymax = FontOverlayMap -> Int
maxYofFontOverlayMap FontOverlayMap
ovsRight0
spaceRectangle :: Overlay
spaceRectangle | DisplayFont -> Bool
isSquareFont DisplayFont
propFont = []
| Bool
otherwise =
Int -> Int -> Overlay
rectangleOfSpaces (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
(Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
canvasLength (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
ymax Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)
trim :: Overlay -> Overlay
trim = ((PointUI, AttrLine) -> Bool) -> Overlay -> Overlay
forall a. (a -> Bool) -> [a] -> [a]
filter (\(PointUI Int
_ Int
yRight, AttrLine
_) -> Int
yRight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
trimmedY)
ovsRight1 :: FontOverlayMap
ovsRight1 = if Int
ymax Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
trimmedY
then FontOverlayMap
ovsRight0
else (Overlay -> Overlay -> Overlay)
-> FontOverlayMap -> FontOverlayMap -> FontOverlayMap
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++)
((Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map Overlay -> Overlay
trim FontOverlayMap
ovsRight0)
(DisplayFont -> Overlay -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont [(PointUI, AttrLine)
trimmedAlert])
ovsRight :: FontOverlayMap
ovsRight = (Overlay -> Overlay -> Overlay)
-> FontOverlayMap -> FontOverlayMap -> FontOverlayMap
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++)
(DisplayFont -> Overlay -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont Overlay
spaceRectangle)
((Overlay -> Overlay) -> FontOverlayMap -> FontOverlayMap
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Int -> Int -> Overlay -> Overlay
xytranslateOverlay Int
2 Int
2) FontOverlayMap
ovsRight1)
(FontOverlayMap
ovs, [KYX]
kyxs) =
if FontOverlayMap -> Bool
forall k a. EnumMap k a -> Bool
EM.null FontOverlayMap
ovsRight0
then (FontOverlayMap
ovs1, [KYX]
kyxs1)
else Int -> Int -> OKX -> OKX -> OKX
sideBySideOKX Int
rwidth Int
0 (FontOverlayMap
ovs1, [KYX]
kyxs1) (FontOverlayMap
ovsRight, [KYX]
kyxsRight)
tmpResult :: Int -> m (Bool, KeyOrSlot, Int)
tmpResult Int
pointer1 = case Int -> [OKX] -> Maybe (OKX, KYX, Int)
findKYX Int
pointer1 [OKX]
frs of
Maybe (OKX, KYX, Int)
Nothing -> [Char] -> m (Bool, KeyOrSlot, Int)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Bool, KeyOrSlot, Int))
-> [Char] -> m (Bool, KeyOrSlot, Int)
forall a b. (a -> b) -> a -> b
$ [Char]
"no menu keys" [Char] -> [OKX] -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` [OKX]
frs
Just (OKX
_, (KeyOrSlot
ekm1, (PointUI, ButtonWidth)
_), Int
_) -> (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, KeyOrSlot
ekm1, Int
pointer1)
ignoreKey :: m (Bool, KeyOrSlot, Int)
ignoreKey = (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, KeyOrSlot
ekm, Int
pointer)
pageLen :: Int
pageLen = [KYX] -> Int
forall a. [a] -> Int
length [KYX]
kyxs
xix :: KYX -> Bool
xix :: KYX -> Bool
xix (KeyOrSlot
_, (PointUI Int
x1' Int
_, ButtonWidth
_)) = Int
x1' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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
- Int
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 :: [KYX]
restOKX = Int -> [KYX] -> [KYX]
forall a. Int -> [a] -> [a]
drop Int
firstRowOfNextPage [KYX]
allOKX
firstItemOfNextPage :: Int
firstItemOfNextPage = case (KYX -> Bool) -> [KYX] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (KeyOrSlot -> Bool
forall a b. Either a b -> Bool
isRight (KeyOrSlot -> Bool) -> (KYX -> KeyOrSlot) -> KYX -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KYX -> KeyOrSlot
forall a b. (a, b) -> a
fst) [KYX]
restOKX of
Just Int
p -> Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
firstRowOfNextPage
Maybe Int
_ -> Int
firstRowOfNextPage
interpretKey :: K.KM -> m (Bool, KeyOrSlot, Int)
interpretKey :: KM -> m (Bool, KeyOrSlot, Int)
interpretKey KM
ikm =
case KM -> Key
K.key KM
ikm of
Key
_ | KM
ikm KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.controlP -> do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
printScreen
m (Bool, KeyOrSlot, Int)
ignoreKey
Key
K.Return -> case KeyOrSlot
ekm of
Left 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 (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
km, Int
pointer)
else KM -> m (Bool, KeyOrSlot, Int)
interpretKey KM
km
Right SlotChar
c -> (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, SlotChar -> KeyOrSlot
forall a b. b -> Either a b
Right SlotChar
c, Int
pointer)
Key
K.LeftButtonRelease -> do
PointUI Int
mx Int
my <- (SessionUI -> PointUI) -> m PointUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
let onChoice :: KYX -> Bool
onChoice (KeyOrSlot
_, (PointUI Int
cx Int
cy, ButtonWidth DisplayFont
font Int
clen)) =
let blen :: Int
blen | DisplayFont -> Bool
isSquareFont DisplayFont
font = Int
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 (KYX -> Bool) -> [KYX] -> Maybe KYX
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find KYX -> Bool
onChoice [KYX]
kyxs of
Maybe KYX
Nothing | KM
ikm KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys ->
(Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
ikm, Int
pointer)
Maybe KYX
Nothing -> if KM
K.spaceKM KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys
then (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
K.spaceKM, Int
pointer)
else m (Bool, KeyOrSlot, Int)
ignoreKey
Just (KeyOrSlot
ckm, (PointUI, ButtonWidth)
_) -> case KeyOrSlot
ckm of
Left 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 (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
km, Int
pointer)
else KM -> m (Bool, KeyOrSlot, Int)
interpretKey KM
km
Right SlotChar
c -> (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, SlotChar -> KeyOrSlot
forall a b. b -> Either a b
Right SlotChar
c, Int
pointer)
Key
K.RightButtonRelease ->
if | KM
ikm KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys -> (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, KM -> KeyOrSlot
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 ->
(Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
K.escKM, Int
pointer)
| Bool
otherwise -> m (Bool, KeyOrSlot, Int)
ignoreKey
Key
K.Space | Int
firstItemOfNextPage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxIx ->
Int -> m (Bool, KeyOrSlot, Int)
tmpResult Int
firstItemOfNextPage
Key
_ | KM -> Key
K.key KM
ikm Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char -> Key
K.Char Char
'?', Int -> Key
K.Fun Int
1]
Bool -> Bool -> Bool
&& 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
== [Char]
"help" ->
Int -> m (Bool, KeyOrSlot, Int)
tmpResult Int
firstItemOfNextPage
K.Unknown [Char]
"SAFE_SPACE" ->
if Int
firstItemOfNextPage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxIx
then Int -> m (Bool, KeyOrSlot, Int)
tmpResult Int
firstItemOfNextPage
else Int -> m (Bool, KeyOrSlot, Int)
tmpResult Int
clearIx
Key
_ | KM
ikm KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
keys ->
(Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
ikm, Int
pointer)
Key
_ | KM -> Key
K.key KM
ikm Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
K.Up, Key
K.WheelNorth] ->
case (KYX -> Bool) -> [KYX] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex KYX -> Bool
xix ([KYX] -> Maybe Int) -> [KYX] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [KYX] -> [KYX]
forall a. [a] -> [a]
reverse ([KYX] -> [KYX]) -> [KYX] -> [KYX]
forall a b. (a -> b) -> a -> b
$ Int -> [KYX] -> [KYX]
forall a. Int -> [a] -> [a]
take Int
ixOnPage [KYX]
kyxs of
Maybe Int
Nothing -> KM -> m (Bool, KeyOrSlot, Int)
interpretKey KM
ikm{key :: Key
K.key=Key
K.Left}
Just Int
ix -> Int -> m (Bool, KeyOrSlot, Int)
tmpResult (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
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
- Int
1))
Key
_ | KM -> Key
K.key KM
ikm Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
K.Down, Key
K.WheelSouth] ->
case (KYX -> Bool) -> [KYX] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex KYX -> Bool
xix ([KYX] -> Maybe Int) -> [KYX] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> [KYX] -> [KYX]
forall a. Int -> [a] -> [a]
drop (Int
ixOnPage Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [KYX]
kyxs of
Maybe Int
Nothing -> KM -> m (Bool, KeyOrSlot, Int)
interpretKey KM
ikm{key :: Key
K.key=Key
K.Right}
Just Int
ix -> Int -> m (Bool, KeyOrSlot, Int)
tmpResult (Int
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Key
K.Left -> if Int
pointer Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int -> m (Bool, KeyOrSlot, Int)
tmpResult Int
maxIx
else Int -> m (Bool, KeyOrSlot, Int)
tmpResult (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
Key
K.Right -> if Int
pointer Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxIx then Int -> m (Bool, KeyOrSlot, Int)
tmpResult Int
0
else Int -> m (Bool, KeyOrSlot, Int)
tmpResult (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
+ Int
1))
Key
K.Home -> Int -> m (Bool, KeyOrSlot, Int)
tmpResult Int
clearIx
Key
K.End -> Int -> m (Bool, KeyOrSlot, Int)
tmpResult Int
maxIx
Key
K.PgUp ->
Int -> m (Bool, KeyOrSlot, Int)
tmpResult (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
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
- Int
1))
Key
K.PgDn ->
Int -> m (Bool, KeyOrSlot, Int)
tmpResult (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxIx Int
firstItemOfNextPage)
Key
K.Space -> if Int
pointer Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxIx
then Int -> m (Bool, KeyOrSlot, Int)
tmpResult Int
clearIx
else Int -> m (Bool, KeyOrSlot, Int)
tmpResult Int
maxIx
Key
_ -> [Char] -> m (Bool, KeyOrSlot, Int)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Bool, KeyOrSlot, Int))
-> [Char] -> m (Bool, KeyOrSlot, Int)
forall a b. (a -> b) -> a -> b
$ [Char]
"unknown key" [Char] -> KM -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` KM
ikm
KM
pkm <- ColorMode -> FontOverlayMap -> Bool -> [KM] -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> FontOverlayMap -> Bool -> [KM] -> m KM
promptGetKey ColorMode
dm FontOverlayMap
ovs Bool
sfBlank [KM]
legalKeys
KM -> m (Bool, KeyOrSlot, Int)
interpretKey KM
pkm
m :: Int -> OKX -> m (Bool, KeyOrSlot, Int)
m Int
pointer OKX
okxRight =
if [OKX] -> Bool
forall a. [a] -> Bool
null [OKX]
frs
then (Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
K.escKM, Int
pointer)
else do
(Bool
final, KeyOrSlot
km, Int
pointer1) <- Int -> OKX -> m (Bool, KeyOrSlot, Int)
page Int
pointer OKX
okxRight
let !_A1 :: ()
_A1 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert ((KM -> Bool) -> (SlotChar -> Bool) -> KeyOrSlot -> 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) KeyOrSlot
km) ()
let !_A2 :: ()
_A2 = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pointer1 Bool -> Bool -> Bool
&& Int
pointer1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxIx
Bool -> (Int, Int) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Int
pointer1, Int
maxIx)) ()
(Bool, KeyOrSlot, Int) -> m (Bool, KeyOrSlot, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
final, KeyOrSlot
km, Int
pointer1)
(Int, Int, Int, Int -> OKX -> m (Bool, KeyOrSlot, Int))
-> m (Int, Int, Int, Int -> OKX -> m (Bool, KeyOrSlot, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
maxIx, Int
initIx, Int
clearIx, Int -> OKX -> m (Bool, KeyOrSlot, Int)
m)
navigationKeys :: [K.KM]
navigationKeys :: [KM]
navigationKeys = [ KM
K.leftButtonReleaseKM, KM
K.rightButtonReleaseKM
, KM
K.returnKM, KM
K.spaceKM
, KM
K.upKM, KM
K.downKM, KM
K.wheelNorthKM, KM
K.wheelSouthKM
, KM
K.leftKM, KM
K.rightKM, KM
K.pgupKM, KM
K.pgdnKM
, KM
K.homeKM, KM
K.endKM, KM
K.controlP ]
findKYX :: Int -> [OKX] -> Maybe (OKX, KYX, Int)
findKYX :: Int -> [OKX] -> Maybe (OKX, KYX, Int)
findKYX Int
_ [] = Maybe (OKX, KYX, Int)
forall a. Maybe a
Nothing
findKYX Int
pointer (okx :: OKX
okx@(FontOverlayMap
_, [KYX]
kyxs) : [OKX]
frs2) =
case Int -> [KYX] -> [KYX]
forall a. Int -> [a] -> [a]
drop Int
pointer [KYX]
kyxs of
[] ->
case Int -> [OKX] -> Maybe (OKX, KYX, Int)
findKYX (Int
pointer Int -> Int -> Int
forall a. Num a => a -> a -> a
- [KYX] -> Int
forall a. [a] -> Int
length [KYX]
kyxs) [OKX]
frs2 of
Maybe (OKX, KYX, Int)
Nothing ->
case [KYX] -> [KYX]
forall a. [a] -> [a]
reverse [KYX]
kyxs of
[] -> Maybe (OKX, KYX, Int)
forall a. Maybe a
Nothing
KYX
kyx : [KYX]
_ -> (OKX, KYX, Int) -> Maybe (OKX, KYX, Int)
forall a. a -> Maybe a
Just (OKX
okx, KYX
kyx, [KYX] -> Int
forall a. [a] -> Int
length [KYX]
kyxs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Maybe (OKX, KYX, Int)
res -> Maybe (OKX, KYX, Int)
res
KYX
kyx : [KYX]
_ -> (OKX, KYX, Int) -> Maybe (OKX, KYX, Int)
forall a. a -> Maybe a
Just (OKX
okx, KYX
kyx, Int
pointer)
drawHighlight :: Int -> ButtonWidth -> Int -> AttrString -> AttrString
drawHighlight :: Int -> ButtonWidth -> Int -> AttrString -> AttrString
drawHighlight Int
x1 (ButtonWidth DisplayFont
font Int
len) Int
xstart AttrString
as =
let highableAttrs :: [Attr]
highableAttrs = [Attr
Color.defAttr, Attr
Color.defAttr {fg :: Color
Color.fg = Color
Color.BrBlack}]
highAttr :: AttrChar -> AttrChar
highAttr AttrChar
c | AttrChar -> Attr
Color.acAttr AttrChar
c 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
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' = AttrChar
c
highAttr AttrChar
c = AttrChar
c {acAttr :: Attr
Color.acAttr =
(AttrChar -> Attr
Color.acAttr AttrChar
c) {fg :: Color
Color.fg = Color
Color.BrWhite}}
cursorAttr :: AttrChar -> AttrChar
cursorAttr AttrChar
c = AttrChar
c {acAttr :: Attr
Color.acAttr =
(AttrChar -> Attr
Color.acAttr AttrChar
c)
{bg :: Highlight
Color.bg = Highlight
Color.HighlightNoneCursor}}
lenUI :: Int
lenUI = if DisplayFont -> Bool
isSquareFont DisplayFont
font then Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 else Int
len
x1MinusXStartChars :: Int
x1MinusXStartChars = if DisplayFont -> Bool
isSquareFont DisplayFont
font
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` Int
2
else Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xstart
(AttrString
as1, AttrString
asRest) = Int -> AttrString -> (AttrString, AttrString)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
x1MinusXStartChars AttrString
as
(AttrString
as2, AttrString
as3) = Int -> AttrString -> (AttrString, AttrString)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
len AttrString
asRest
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
as2High :: AttrString
as2High = case (AttrCharW32 -> AttrCharW32) -> AttrString -> AttrString
forall a b. (a -> b) -> [a] -> [b]
map AttrCharW32 -> AttrCharW32
highW32 AttrString
as2 of
[] -> []
AttrCharW32
ch : AttrString
chrest -> AttrCharW32 -> AttrCharW32
cursorW32 AttrCharW32
ch AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: AttrString
chrest
in if 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
then AttrString
as
else AttrString
as1 AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
as2High AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
as3