{-# LANGUAGE RankNTypes #-}
-- | Verifying, aggregating and displaying binding of keys to commands.
module Game.LambdaHack.Client.UI.KeyBindings
  ( keyHelp, okxsN
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

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.Input
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.HumanCmd
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.Overlay
import           Game.LambdaHack.Client.UI.PointUI
import           Game.LambdaHack.Client.UI.Slideshow
import qualified Game.LambdaHack.Definition.Color as Color

-- | Produce a set of help/menu screens from the key bindings.
--
-- When the intro screen mentions KP_5, this really is KP_Begin,
-- but since that is harder to understand we assume a different, non-default
-- state of NumLock in the help text than in the code that handles keys.
keyHelp :: CCUI -> FontSetup -> [(Text, OKX)]
keyHelp :: CCUI -> FontSetup -> [(Text, OKX)]
keyHelp CCUI{ coinput :: CCUI -> InputContent
coinput=coinput :: InputContent
coinput@InputContent{[(KM, CmdTriple)]
Map KM CmdTriple
Map HumanCmd [KM]
brevMap :: InputContent -> Map HumanCmd [KM]
bcmdList :: InputContent -> [(KM, CmdTriple)]
bcmdMap :: InputContent -> Map KM CmdTriple
brevMap :: Map HumanCmd [KM]
bcmdList :: [(KM, CmdTriple)]
bcmdMap :: Map KM CmdTriple
..}
            , coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: ScreenContent -> X
rwidth :: X
rwidth, X
rheight :: ScreenContent -> X
rheight :: X
rheight} } FontSetup{DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
..} =
  let
    movBlurb1 :: [Text]
movBlurb1 =
      [ Text
"Walk throughout a level with mouse or numeric keypad (right diagram below)"
      , Text
"or the Vi editor keys (middle) or the left-hand movement keys (left). Run until"
      , Text
"disturbed with Shift or Control. Go-to a position with LMB (left mouse button)."
      , Text
"In aiming mode, the same keys (and mouse) move the aiming crosshair."
      ]
    movSchema :: [Text]
movSchema =
      [ Text
"     q w e     y k u     7 8 9"
      , Text
"      \\|/       \\|/       \\|/"
      , Text
"     a-s-d     h-.-l     4-5-6"
      , Text
"      /|\\       /|\\       /|\\"
      , Text
"     z x c     b j n     1 2 3"
      ]
    movBlurb2 :: [Text]
movBlurb2 =
      [ Text
"Press `KP_5` (`5` on keypad) to wait, bracing for impact, which reduces any"
      , Text
"damage taken and prevents displacement by foes. Press `S-KP_5` or `C-KP_5`"
      , Text
"(the same key with Shift or Control) to lurk 0.1 of a turn, without bracing."
      , Text
""
      , Text
"Displace enemies by running into them with Shift/Control or S-LMB. Search,"
      , Text
"open, descend and melee by bumping into walls, doors, stairs and enemies."
      , Text
"The best, and not on cooldown, melee weapon is automatically chosen"
      , Text
"for attack from your equipment and from among your body parts."
      ]
    minimalBlurb :: [Text]
minimalBlurb =
      [ Text
"The following few commands, joined with the movement and running keys,"
      , Text
"let you accomplish almost anything in the game, though not necessarily"
      , Text
"with the fewest keystrokes. You can also play the game exclusively"
      , Text
"with a mouse, or both mouse and keyboard (e.g., mouse for go-to"
      , Text
"and terrain inspection and keyboard for everything else). Lastly,"
      , Text
"you can select a command with arrows or mouse directly from the help"
      , Text
"screen or the dashboard and execute it on the spot."
      ]
    itemAllEnding :: [Text]
itemAllEnding =
      [ Text
"Note how lower case item commands (stash item, equip item) place items"
      , Text
"into a particular item store, while upper case item commands (manage Inventory,"
      , Text
"manage Outfit) open management menu for a store. Once a store menu is opened,"
      , Text
"you can switch stores with `<` and `>`, so the multiple commands only determine"
      , Text
"the starting item store. Each store is accessible from the dashboard as well."
      ]
    mouseBasicsBlurb :: [Text]
mouseBasicsBlurb =
      [ Text
"Screen area and UI mode (exploration/aiming) determine mouse click"
      , Text
"effects. Here we give an overview of effects of each button over"
      , Text
"the game map area. The list includes not only left and right buttons,"
      , Text
"but also the optional middle mouse button (MMB) and the mouse wheel,"
      , Text
"which is also used over menus to move selection. For mice without RMB,"
      , Text
"one can use Control key with LMB and for mice without MMB, one can use"
      , Text
"C-RMB or C-S-LMB."
      ]
    mouseAreasBlurb :: [Text]
mouseAreasBlurb =
      [ Text
"Next we show mouse button effects per screen area, in exploration and"
      , Text
"(if different) aiming mode. Note that mouse is optional. Keyboard suffices,"
      , Text
"occasionally requiring a lookup for an obscure command key in help screens."
      ]
    mouseAreasMini :: [Text]
mouseAreasMini =
      [ Text
"Mouse button effects per screen area, in exploration and in aiming modes"
      ]
    movTextEnd :: Text
movTextEnd = Text
"Press SPACE or PGDN to advance or ESC to see the map again."
    lastHelpEnd :: Text
lastHelpEnd = Text
"Use PGUP to go back and ESC to see the map again."
    seeAlso :: Text
seeAlso = Text
"For more playing instructions see file PLAYING.md."
    offsetCol2 :: X
offsetCol2 = X
12
    pickLeaderDescription :: [Text]
pickLeaderDescription =
      [ X -> Text -> Text -> Text
fmt X
offsetCol2 Text
"0, 1 ... 9"
                       Text
"pick a particular actor as the new pointman"
      ]
    casualDescription :: Text
casualDescription = Text
"Minimal cheat sheet for casual play"
    fmt0 :: X -> Text -> Text -> Text
fmt0 X
n Text
k Text
h = X -> Char -> Text -> Text
T.justifyLeft X
n Char
' ' Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
h
    fmt :: X -> Text -> Text -> Text
fmt X
n Text
k Text
h = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> X -> Text -> Text -> Text
fmt0 X
n Text
k Text
h
    keyCaption :: Text
keyCaption = X -> Text -> Text -> Text
fmt X
offsetCol2 Text
"keys" Text
"command"
    mouseOverviewCaption :: Text
mouseOverviewCaption = X -> Text -> Text -> Text
fmt X
offsetCol2 Text
"keys" Text
"command (exploration/aiming)"
    spLen :: X
spLen = DisplayFont -> [Char] -> X
forall a. DisplayFont -> [a] -> X
textSize DisplayFont
monoFont [Char]
" "
    okxs :: CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
cat ([Text], [Text], [Text])
headers ([Text], [Text])
footers = X -> X -> OKX -> OKX
xytranslateOKX X
spLen X
0 (OKX -> OKX) -> OKX -> OKX
forall a b. (a -> b) -> a -> b
$
      InputContent
-> DisplayFont
-> DisplayFont
-> X
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> ([Text], [Text], [Text])
-> ([Text], [Text])
-> OKX
okxsN InputContent
coinput DisplayFont
monoFont DisplayFont
propFont X
offsetCol2 (Bool -> HumanCmd -> Bool
forall a b. a -> b -> a
const Bool
False)
            Bool
True CmdCategory
cat ([Text], [Text], [Text])
headers ([Text], [Text])
footers
    mergeOKX :: OKX -> OKX -> OKX
    mergeOKX :: OKX -> OKX -> OKX
mergeOKX OKX
okx1 OKX
okx2 =
      let off :: X
off = X
1 X -> X -> X
forall a. Num a => a -> a -> a
+ FontOverlayMap -> X
maxYofFontOverlayMap (OKX -> FontOverlayMap
forall a b. (a, b) -> a
fst OKX
okx1)
      in X -> X -> OKX -> OKX -> OKX
sideBySideOKX X
0 X
off OKX
okx1 OKX
okx2
    catLength :: CmdCategory -> X
catLength CmdCategory
cat = [(KM, CmdTriple)] -> X
forall a. [a] -> X
length ([(KM, CmdTriple)] -> X) -> [(KM, CmdTriple)] -> X
forall a b. (a -> b) -> a -> b
$ ((KM, CmdTriple) -> Bool) -> [(KM, CmdTriple)] -> [(KM, CmdTriple)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(KM
_, ([CmdCategory]
cats, Text
desc, HumanCmd
_)) ->
      CmdCategory
cat CmdCategory -> [CmdCategory] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdCategory]
cats Bool -> Bool -> Bool
&& (Text
desc Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" Bool -> Bool -> Bool
|| CmdCategory
CmdInternal CmdCategory -> [CmdCategory] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdCategory]
cats)) [(KM, CmdTriple)]
bcmdList
    keyM :: X
keyM = X
13
    keyB :: X
keyB = X
31
    truncatem :: Text -> Text
truncatem Text
b = if Text -> X
T.length Text
b X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
keyB
                  then X -> Text -> Text
T.take (X
keyB X -> X -> X
forall a. Num a => a -> a -> a
- X
1) Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"$"
                  else Text
b
    fmm :: Text -> Text -> Text -> Text
fmm Text
a Text
b Text
c = X -> Text -> Text -> Text
fmt (X
keyM X -> X -> X
forall a. Num a => a -> a -> a
+ X
1) Text
a (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ X -> Text -> Text -> Text
fmt0 X
keyB (Text -> Text
truncatem Text
b) (Text -> Text
truncatem Text
c)
    areaCaption :: Text -> Text
areaCaption Text
t = Text -> Text -> Text -> Text
fmm Text
t Text
"LMB (left mouse button)" Text
"RMB (right mouse button)"
    keySel :: (forall a. (a, a) -> a) -> K.KM
           -> [(CmdArea, KeyOrSlot, Text)]
    keySel :: (forall a. (a, a) -> a) -> KM -> [(CmdArea, KeyOrSlot, Text)]
keySel forall a. (a, a) -> a
sel KM
key =
      let cmd :: HumanCmd
cmd = case KM -> Map KM CmdTriple -> Maybe CmdTriple
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KM
key Map KM CmdTriple
bcmdMap of
            Just ([CmdCategory]
_, Text
_, HumanCmd
cmd2) -> HumanCmd
cmd2
            Maybe CmdTriple
Nothing -> [Char] -> HumanCmd
forall a. HasCallStack => [Char] -> a
error ([Char] -> HumanCmd) -> [Char] -> HumanCmd
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> KM -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` KM
key
          caCmds :: [(CmdArea, HumanCmd)]
caCmds = case HumanCmd
cmd of
            ByAimMode AimModeCmd{exploration :: AimModeCmd -> HumanCmd
exploration=ByArea [(CmdArea, HumanCmd)]
lexp, aiming :: AimModeCmd -> HumanCmd
aiming=ByArea [(CmdArea, HumanCmd)]
laim} ->
              [(CmdArea, HumanCmd)] -> [(CmdArea, HumanCmd)]
forall a. Ord a => [a] -> [a]
sort ([(CmdArea, HumanCmd)] -> [(CmdArea, HumanCmd)])
-> [(CmdArea, HumanCmd)] -> [(CmdArea, HumanCmd)]
forall a b. (a -> b) -> a -> b
$ ([(CmdArea, HumanCmd)], [(CmdArea, HumanCmd)])
-> [(CmdArea, HumanCmd)]
forall a. (a, a) -> a
sel ([(CmdArea, HumanCmd)]
lexp, [(CmdArea, HumanCmd)]
laim [(CmdArea, HumanCmd)]
-> [(CmdArea, HumanCmd)] -> [(CmdArea, HumanCmd)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(CmdArea, HumanCmd)]
lexp)
            HumanCmd
_ -> [Char] -> [(CmdArea, HumanCmd)]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [(CmdArea, HumanCmd)])
-> [Char] -> [(CmdArea, HumanCmd)]
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> HumanCmd -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` HumanCmd
cmd
          caMakeChoice :: (CmdArea, HumanCmd) -> (CmdArea, KeyOrSlot, Text)
caMakeChoice (CmdArea
ca, HumanCmd
cmd2) =
            let (KM
km, Text
desc) = case HumanCmd -> Map HumanCmd [KM] -> Maybe [KM]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup HumanCmd
cmd2 Map HumanCmd [KM]
brevMap of
                  Just [KM]
ks ->
                    let descOfKM :: KM -> Maybe (KM, Text)
descOfKM KM
km2 = case KM -> Map KM CmdTriple -> Maybe CmdTriple
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KM
km2 Map KM CmdTriple
bcmdMap of
                          Just ([CmdCategory]
_, Text
"", HumanCmd
_) -> Maybe (KM, Text)
forall a. Maybe a
Nothing
                          Just ([CmdCategory]
_, Text
desc2, HumanCmd
_) -> (KM, Text) -> Maybe (KM, Text)
forall a. a -> Maybe a
Just (KM
km2, Text
desc2)
                          Maybe CmdTriple
Nothing -> [Char] -> Maybe (KM, Text)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe (KM, Text)) -> [Char] -> Maybe (KM, Text)
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> KM -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` KM
km2
                    in case (KM -> Maybe (KM, Text)) -> [KM] -> [(KM, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe KM -> Maybe (KM, Text)
descOfKM [KM]
ks of
                      [] -> [Char] -> (KM, Text)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (KM, Text)) -> [Char] -> (KM, Text)
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> ([KM], HumanCmd) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ([KM]
ks, HumanCmd
cmd2)
                      (KM, Text)
kmdesc3 : [(KM, Text)]
_ -> (KM, Text)
kmdesc3
                  Maybe [KM]
Nothing -> (KM
key, Text
"(not described:" Text -> Text -> Text
<+> HumanCmd -> Text
forall a. Show a => a -> Text
tshow HumanCmd
cmd2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
            in (CmdArea
ca, KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
km, Text
desc)
      in ((CmdArea, HumanCmd) -> (CmdArea, KeyOrSlot, Text))
-> [(CmdArea, HumanCmd)] -> [(CmdArea, KeyOrSlot, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (CmdArea, HumanCmd) -> (CmdArea, KeyOrSlot, Text)
caMakeChoice [(CmdArea, HumanCmd)]
caCmds
    doubleIfSquare :: X -> X
doubleIfSquare X
n | DisplayFont -> Bool
isSquareFont DisplayFont
monoFont = X
2 X -> X -> X
forall a. Num a => a -> a -> a
* X
n
                     | Bool
otherwise = X
n
    okm :: (forall a. (a, a) -> a) -> K.KM -> K.KM -> [Text] -> OKX
    okm :: (forall a. (a, a) -> a) -> KM -> KM -> [Text] -> OKX
okm forall a. (a, a) -> a
sel KM
key1 KM
key2 [Text]
header =
      let kst1 :: [(CmdArea, KeyOrSlot, Text)]
kst1 = (forall a. (a, a) -> a) -> KM -> [(CmdArea, KeyOrSlot, Text)]
keySel forall a. (a, a) -> a
sel KM
key1
          kst2 :: [(CmdArea, KeyOrSlot, Text)]
kst2 = (forall a. (a, a) -> a) -> KM -> [(CmdArea, KeyOrSlot, Text)]
keySel forall a. (a, a) -> a
sel KM
key2
          f :: (CmdArea, KeyOrSlot, Text)
-> (CmdArea, KeyOrSlot, Text)
-> X
-> [(KeyOrSlot, (PointUI, ButtonWidth))]
f (CmdArea
ca1, Left KM
km1, Text
_) (CmdArea
ca2, Left KM
km2, Text
_) X
y =
            Bool
-> [(KeyOrSlot, (PointUI, ButtonWidth))]
-> [(KeyOrSlot, (PointUI, ButtonWidth))]
forall a. HasCallStack => Bool -> a -> a
assert (CmdArea
ca1 CmdArea -> CmdArea -> Bool
forall a. Eq a => a -> a -> Bool
== CmdArea
ca2 Bool
-> (CmdArea, CmdArea, KM, KM, [(CmdArea, KeyOrSlot, Text)],
    [(CmdArea, KeyOrSlot, Text)])
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (CmdArea
ca1, CmdArea
ca2, KM
km1, KM
km2, [(CmdArea, KeyOrSlot, Text)]
kst1, [(CmdArea, KeyOrSlot, Text)]
kst2))
              [ (KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
km1, ( X -> X -> PointUI
PointUI (X -> X
doubleIfSquare (X -> X) -> X -> X
forall a b. (a -> b) -> a -> b
$ X
keyM X -> X -> X
forall a. Num a => a -> a -> a
+ X
4) X
y
                           , DisplayFont -> X -> ButtonWidth
ButtonWidth DisplayFont
monoFont X
keyB ))
              , (KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
km2, ( X -> X -> PointUI
PointUI (X -> X
doubleIfSquare (X -> X) -> X -> X
forall a b. (a -> b) -> a -> b
$ X
keyB X -> X -> X
forall a. Num a => a -> a -> a
+ X
keyM X -> X -> X
forall a. Num a => a -> a -> a
+ X
5) X
y
                           , DisplayFont -> X -> ButtonWidth
ButtonWidth DisplayFont
monoFont X
keyB )) ]
          f (CmdArea, KeyOrSlot, Text)
c (CmdArea, KeyOrSlot, Text)
d X
e = [Char] -> [(KeyOrSlot, (PointUI, ButtonWidth))]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [(KeyOrSlot, (PointUI, ButtonWidth))])
-> [Char] -> [(KeyOrSlot, (PointUI, ButtonWidth))]
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char]
-> ((CmdArea, KeyOrSlot, Text), (CmdArea, KeyOrSlot, Text), X)
-> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ((CmdArea, KeyOrSlot, Text)
c, (CmdArea, KeyOrSlot, Text)
d, X
e)
          kxs :: [(KeyOrSlot, (PointUI, ButtonWidth))]
kxs = [[(KeyOrSlot, (PointUI, ButtonWidth))]]
-> [(KeyOrSlot, (PointUI, ButtonWidth))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(KeyOrSlot, (PointUI, ButtonWidth))]]
 -> [(KeyOrSlot, (PointUI, ButtonWidth))])
-> [[(KeyOrSlot, (PointUI, ButtonWidth))]]
-> [(KeyOrSlot, (PointUI, ButtonWidth))]
forall a b. (a -> b) -> a -> b
$ ((CmdArea, KeyOrSlot, Text)
 -> (CmdArea, KeyOrSlot, Text)
 -> X
 -> [(KeyOrSlot, (PointUI, ButtonWidth))])
-> [(CmdArea, KeyOrSlot, Text)]
-> [(CmdArea, KeyOrSlot, Text)]
-> [X]
-> [[(KeyOrSlot, (PointUI, ButtonWidth))]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (CmdArea, KeyOrSlot, Text)
-> (CmdArea, KeyOrSlot, Text)
-> X
-> [(KeyOrSlot, (PointUI, ButtonWidth))]
f [(CmdArea, KeyOrSlot, Text)]
kst1 [(CmdArea, KeyOrSlot, Text)]
kst2 [X
1 X -> X -> X
forall a. Num a => a -> a -> a
+ [Text] -> X
forall a. [a] -> X
length [Text]
header..]
          menuLeft :: [AttrLine]
menuLeft = ((CmdArea, KeyOrSlot, Text) -> AttrLine)
-> [(CmdArea, KeyOrSlot, Text)] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (\(CmdArea
ca1, KeyOrSlot
_, Text
_) -> Text -> AttrLine
textToAL (Text -> AttrLine) -> Text -> AttrLine
forall a b. (a -> b) -> a -> b
$ CmdArea -> Text
areaDescription CmdArea
ca1) [(CmdArea, KeyOrSlot, Text)]
kst1
          menuMiddle :: [AttrLine]
menuMiddle = ((CmdArea, KeyOrSlot, Text) -> AttrLine)
-> [(CmdArea, KeyOrSlot, Text)] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (\(CmdArea
_, KeyOrSlot
_, Text
desc) -> Text -> AttrLine
textToAL Text
desc) [(CmdArea, KeyOrSlot, Text)]
kst1
          menuRight :: [AttrLine]
menuRight = ((CmdArea, KeyOrSlot, Text) -> AttrLine)
-> [(CmdArea, KeyOrSlot, Text)] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (\(CmdArea
_, KeyOrSlot
_, Text
desc) -> Text -> AttrLine
textToAL Text
desc) [(CmdArea, KeyOrSlot, Text)]
kst2
          y0 :: X
y0 = X
1 X -> X -> X
forall a. Num a => a -> a -> a
+ [Text] -> X
forall a. [a] -> X
length [Text]
header
      in ( ([(PointUI, AttrLine)]
 -> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)])
-> [FontOverlayMap] -> FontOverlayMap
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith [(PointUI, AttrLine)]
-> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
forall a. [a] -> [a] -> [a]
(++)
             [ [Text] -> FontOverlayMap
typesetInMono ([Text] -> FontOverlayMap) -> [Text] -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
header
             , DisplayFont -> [(PointUI, AttrLine)] -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont
               ([(PointUI, AttrLine)] -> FontOverlayMap)
-> [(PointUI, AttrLine)] -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ (X, X) -> [AttrLine] -> [(PointUI, AttrLine)]
typesetXY (X -> X
doubleIfSquare X
2, X
y0) [AttrLine]
menuLeft
             , DisplayFont -> [(PointUI, AttrLine)] -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont
               ([(PointUI, AttrLine)] -> FontOverlayMap)
-> [(PointUI, AttrLine)] -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ (X, X) -> [AttrLine] -> [(PointUI, AttrLine)]
typesetXY (X -> X
doubleIfSquare (X -> X) -> X -> X
forall a b. (a -> b) -> a -> b
$ X
keyM X -> X -> X
forall a. Num a => a -> a -> a
+ X
4, X
y0) [AttrLine]
menuMiddle
             , DisplayFont -> [(PointUI, AttrLine)] -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont
               ([(PointUI, AttrLine)] -> FontOverlayMap)
-> [(PointUI, AttrLine)] -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ (X, X) -> [AttrLine] -> [(PointUI, AttrLine)]
typesetXY (X -> X
doubleIfSquare (X -> X) -> X -> X
forall a b. (a -> b) -> a -> b
$ X
keyB X -> X -> X
forall a. Num a => a -> a -> a
+ X
keyM X -> X -> X
forall a. Num a => a -> a -> a
+ X
5, X
y0) [AttrLine]
menuRight ]
         , [(KeyOrSlot, (PointUI, ButtonWidth))]
kxs )
    typesetInSquare :: [Text] -> FontOverlayMap
    typesetInSquare :: [Text] -> FontOverlayMap
typesetInSquare =
      DisplayFont -> [(PointUI, AttrLine)] -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
squareFont ([(PointUI, AttrLine)] -> FontOverlayMap)
-> ([Text] -> [(PointUI, AttrLine)]) -> [Text] -> FontOverlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X, X) -> [AttrLine] -> [(PointUI, AttrLine)]
typesetXY (X
spLen, X
0) ([AttrLine] -> [(PointUI, AttrLine)])
-> ([Text] -> [AttrLine]) -> [Text] -> [(PointUI, AttrLine)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> AttrLine) -> [Text] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrLine
textToAL
    typesetInMono :: [Text] -> FontOverlayMap
    typesetInMono :: [Text] -> FontOverlayMap
typesetInMono =
      DisplayFont -> [(PointUI, AttrLine)] -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont ([(PointUI, AttrLine)] -> FontOverlayMap)
-> ([Text] -> [(PointUI, AttrLine)]) -> [Text] -> FontOverlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X, X) -> [AttrLine] -> [(PointUI, AttrLine)]
typesetXY (X
spLen, X
0) ([AttrLine] -> [(PointUI, AttrLine)])
-> ([Text] -> [AttrLine]) -> [Text] -> [(PointUI, AttrLine)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> AttrLine) -> [Text] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrLine
textToAL
    typesetInProp :: [Text] -> FontOverlayMap
    typesetInProp :: [Text] -> FontOverlayMap
typesetInProp =
      DisplayFont -> [(PointUI, AttrLine)] -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
propFont ([(PointUI, AttrLine)] -> FontOverlayMap)
-> ([Text] -> [(PointUI, AttrLine)]) -> [Text] -> FontOverlayMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (X, X) -> [AttrLine] -> [(PointUI, AttrLine)]
typesetXY (X
spLen, X
0) ([AttrLine] -> [(PointUI, AttrLine)])
-> ([Text] -> [AttrLine]) -> [Text] -> [(PointUI, AttrLine)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> AttrLine) -> [Text] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrLine
textToAL
    sideBySide :: [(Text, OKX)] -> [(Text, OKX)]
    sideBySide :: [(Text, OKX)] -> [(Text, OKX)]
sideBySide ((Text
_t1, OKX
okx1) : (Text
t2, OKX
okx2) : [(Text, OKX)]
rest) | Bool -> Bool
not (DisplayFont -> Bool
isSquareFont DisplayFont
propFont) =
      (Text
t2, X -> X -> OKX -> OKX -> OKX
sideBySideOKX X
rwidth X
0 OKX
okx1 OKX
okx2) (Text, OKX) -> [(Text, OKX)] -> [(Text, OKX)]
forall a. a -> [a] -> [a]
: [(Text, OKX)] -> [(Text, OKX)]
sideBySide [(Text, OKX)]
rest
    sideBySide [(Text, OKX)]
l = [(Text, OKX)]
l
  in [(Text, OKX)] -> [(Text, OKX)]
sideBySide ([(Text, OKX)] -> [(Text, OKX)]) -> [(Text, OKX)] -> [(Text, OKX)]
forall a b. (a -> b) -> a -> b
$ [[(Text, OKX)]] -> [(Text, OKX)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ if CmdCategory -> X
catLength CmdCategory
CmdMinimal
         X -> X -> X
forall a. Num a => a -> a -> a
+ [Text] -> X
forall a. [a] -> X
length [Text]
movBlurb1 X -> X -> X
forall a. Num a => a -> a -> a
+ [Text] -> X
forall a. [a] -> X
length [Text]
movSchema X -> X -> X
forall a. Num a => a -> a -> a
+ [Text] -> X
forall a. [a] -> X
length [Text]
movBlurb2
         X -> X -> X
forall a. Num a => a -> a -> a
+ [Text] -> X
forall a. [a] -> X
length [Text]
minimalBlurb
         X -> X -> X
forall a. Num a => a -> a -> a
+ X
6 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
rheight then
        [ ( Text
movTextEnd
          , OKX -> OKX -> OKX
mergeOKX
              (OKX -> OKX -> OKX
mergeOKX ( [Text] -> FontOverlayMap
typesetInMono [Text
"", Text
casualDescription Text -> Text -> Text
<+> Text
"(1/2)", Text
""]
                        , [] )
                        (OKX -> OKX -> OKX
mergeOKX ([Text] -> FontOverlayMap
typesetInProp [Text]
movBlurb1, [])
                                  ([Text] -> FontOverlayMap
typesetInSquare ([Text] -> FontOverlayMap) -> [Text] -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
movSchema, [])))
              ([Text] -> FontOverlayMap
typesetInProp ([Text] -> FontOverlayMap) -> [Text] -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
movBlurb2, []) )
        , ( Text
movTextEnd
          , CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMinimal
                 ( [Text
"", Text
casualDescription Text -> Text -> Text
<+> Text
"(2/2)", Text
""]
                 , [Text]
minimalBlurb [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
""]
                 , [Text
keyCaption] )
                 ([], []) ) ]
      else
        [ ( Text
movTextEnd
          , OKX -> OKX -> OKX
mergeOKX
              (OKX -> OKX -> OKX
mergeOKX ( [Text] -> FontOverlayMap
typesetInMono [Text
"", Text
casualDescription, Text
""]
                        , [] )
                        (OKX -> OKX -> OKX
mergeOKX ([Text] -> FontOverlayMap
typesetInProp [Text]
movBlurb1, [])
                                  ([Text] -> FontOverlayMap
typesetInSquare ([Text] -> FontOverlayMap) -> [Text] -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
movSchema, [])))
              (CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMinimal
                    ( []
                    , [Text
""] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
movBlurb2 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
""]
                       [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
minimalBlurb [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
""]
                    , [Text
keyCaption] )
                    ([], [Text
""])) ) ]
    , if X
45 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
rheight then
        [ ( Text
movTextEnd
          , let (FontOverlayMap
ls, [(KeyOrSlot, (PointUI, ButtonWidth))]
_) = CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMouse
                               ( [Text
"", Text
"Optional mouse commands", Text
""]
                               , [Text]
mouseBasicsBlurb [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
""]
                               , [Text
mouseOverviewCaption] )
                               ([], [])
            in (FontOverlayMap
ls, []) )  -- don't capture mouse wheel, etc.
        , ( Text
movTextEnd
          , OKX -> OKX -> OKX
mergeOKX
              ([Text] -> FontOverlayMap
typesetInMono ([Text] -> FontOverlayMap) -> [Text] -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
mouseAreasMini, [])
              (OKX -> OKX -> OKX
mergeOKX
                 ((forall a. (a, a) -> a) -> KM -> KM -> [Text] -> OKX
okm forall a. (a, a) -> a
forall a b. (a, b) -> a
fst KM
K.leftButtonReleaseKM KM
K.rightButtonReleaseKM
                      [Text -> Text
areaCaption Text
"Exploration"])
                 ((forall a. (a, a) -> a) -> KM -> KM -> [Text] -> OKX
okm forall a. (a, a) -> a
forall a b. (a, b) -> b
snd KM
K.leftButtonReleaseKM KM
K.rightButtonReleaseKM
                      [Text -> Text
areaCaption Text
"Aiming Mode"])) ) ]
      else
        [ ( Text
movTextEnd
          , let (FontOverlayMap
ls, [(KeyOrSlot, (PointUI, ButtonWidth))]
_) = CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMouse
                               ( [Text
"", Text
"Optional mouse commands", Text
""]
                               , [Text]
mouseBasicsBlurb [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
""]
                               , [Text
mouseOverviewCaption] )
                               ([], [])
                okx0 :: OKX
okx0 = (FontOverlayMap
ls, [])  -- don't capture mouse wheel, etc.
            in OKX -> OKX -> OKX
mergeOKX
                 (OKX -> OKX -> OKX
mergeOKX
                    OKX
okx0
                    ([Text] -> FontOverlayMap
typesetInProp ([Text] -> FontOverlayMap) -> [Text] -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
mouseAreasBlurb, []))
                 (OKX -> OKX -> OKX
mergeOKX
                    ((forall a. (a, a) -> a) -> KM -> KM -> [Text] -> OKX
okm forall a. (a, a) -> a
forall a b. (a, b) -> a
fst KM
K.leftButtonReleaseKM KM
K.rightButtonReleaseKM
                         [Text -> Text
areaCaption Text
"Exploration"])
                    ((forall a. (a, a) -> a) -> KM -> KM -> [Text] -> OKX
okm forall a. (a, a) -> a
forall a b. (a, b) -> b
snd KM
K.leftButtonReleaseKM KM
K.rightButtonReleaseKM
                         [Text -> Text
areaCaption Text
"Aiming Mode"] )) ) ]
    , if CmdCategory -> X
catLength CmdCategory
CmdItem X -> X -> X
forall a. Num a => a -> a -> a
+ CmdCategory -> X
catLength CmdCategory
CmdMove X -> X -> X
forall a. Num a => a -> a -> a
+ X
9 X -> X -> X
forall a. Num a => a -> a -> a
+ X
9 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
rheight then
        [ ( Text
movTextEnd
          , CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdItem
                 ([Text
"", CmdCategory -> Text
categoryDescription CmdCategory
CmdItem], [], [Text
"", Text
keyCaption])
                 ([], Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
itemAllEnding) )
        , ( Text
movTextEnd
          , CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMove
                 ([Text
"", CmdCategory -> Text
categoryDescription CmdCategory
CmdMove], [], [Text
"", Text
keyCaption])
                 ([Text]
pickLeaderDescription, []) ) ]
      else
        [ ( Text
movTextEnd
          , OKX -> OKX -> OKX
mergeOKX
              (CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdItem
                    ([Text
"", CmdCategory -> Text
categoryDescription CmdCategory
CmdItem], [], [Text
"", Text
keyCaption])
                    ([], Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
itemAllEnding))
              (CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMove
                    ( [Text
"", Text
"", CmdCategory -> Text
categoryDescription CmdCategory
CmdMove]
                    , []
                    , [Text
"", Text
keyCaption] )
                    ([Text]
pickLeaderDescription, [Text
""])) ) ]
    , if CmdCategory -> X
catLength CmdCategory
CmdAim X -> X -> X
forall a. Num a => a -> a -> a
+ CmdCategory -> X
catLength CmdCategory
CmdMeta X -> X -> X
forall a. Num a => a -> a -> a
+ X
9 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
rheight then
        [ ( Text
movTextEnd
          , CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdAim
                 ([Text
"", CmdCategory -> Text
categoryDescription CmdCategory
CmdAim], [], [Text
"", Text
keyCaption])
                 ([], []) )
        , ( Text
lastHelpEnd
          , CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMeta
                 ([Text
"", CmdCategory -> Text
categoryDescription CmdCategory
CmdMeta], [], [Text
"", Text
keyCaption])
                 ([], [Text
"", Text
seeAlso]) ) ]
      else
        [ ( Text
lastHelpEnd
          , OKX -> OKX -> OKX
mergeOKX
              (CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdAim
                    ([Text
"", CmdCategory -> Text
categoryDescription CmdCategory
CmdAim], [], [Text
"", Text
keyCaption])
                    ([], []))
              (CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMeta
                    ( [Text
"", Text
"", CmdCategory -> Text
categoryDescription CmdCategory
CmdMeta]
                    , []
                    , [Text
"", Text
keyCaption] )
                    ([], [Text
"", Text
seeAlso, Text
""])) ) ]
    ]

-- | Turn the specified portion of bindings into a menu.
--
-- The length of the button may be wrong if the two supplied fonts
-- have very different widths.
okxsN :: InputContent -> DisplayFont -> DisplayFont -> Int -> (HumanCmd -> Bool)
      -> Bool -> CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text])
      -> OKX
okxsN :: InputContent
-> DisplayFont
-> DisplayFont
-> X
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> ([Text], [Text], [Text])
-> ([Text], [Text])
-> OKX
okxsN InputContent{[(KM, CmdTriple)]
Map KM CmdTriple
Map HumanCmd [KM]
brevMap :: Map HumanCmd [KM]
bcmdList :: [(KM, CmdTriple)]
bcmdMap :: Map KM CmdTriple
brevMap :: InputContent -> Map HumanCmd [KM]
bcmdList :: InputContent -> [(KM, CmdTriple)]
bcmdMap :: InputContent -> Map KM CmdTriple
..} DisplayFont
labFont DisplayFont
descFont X
offsetCol2 HumanCmd -> Bool
greyedOut
      Bool
showManyKeys CmdCategory
cat ([Text]
headerMono1, [Text]
headerProp, [Text]
headerMono2)
      ([Text]
footerMono, [Text]
footerProp) =
  let fmt :: Text -> b -> (Text, b)
fmt Text
k b
h = (Char -> Text
T.singleton Char
'\x00a0' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k, b
h)
      coImage :: HumanCmd -> [K.KM]
      coImage :: HumanCmd -> [KM]
coImage HumanCmd
cmd = [KM] -> HumanCmd -> Map HumanCmd [KM] -> [KM]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault ([Char] -> [KM]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [KM]) -> [Char] -> [KM]
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> HumanCmd -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` HumanCmd
cmd) HumanCmd
cmd Map HumanCmd [KM]
brevMap
      disp :: [KM] -> Text
disp = Text -> [Text] -> Text
T.intercalate Text
" or " ([Text] -> Text) -> ([KM] -> [Text]) -> [KM] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KM -> Text) -> [KM] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Text
T.pack ([Char] -> Text) -> (KM -> [Char]) -> KM -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KM -> [Char]
K.showKM)
      keyKnown :: KM -> Bool
keyKnown KM
km = case KM -> Key
K.key KM
km of
        K.Unknown{} -> Bool
False
        Key
_ -> Bool
True
      keys :: [(KeyOrSlot, (Bool, (Text, Text)))]
      keys :: [(KeyOrSlot, (Bool, (Text, Text)))]
keys = [ (KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
km, (HumanCmd -> Bool
greyedOut HumanCmd
cmd, Text -> Text -> (Text, Text)
forall b. Text -> b -> (Text, b)
fmt Text
keyNames Text
desc))
             | (KM
_, ([CmdCategory]
cats, Text
desc, HumanCmd
cmd)) <- [(KM, CmdTriple)]
bcmdList
             , let kms :: [KM]
kms = HumanCmd -> [KM]
coImage HumanCmd
cmd
                   knownKeys :: [KM]
knownKeys = (KM -> Bool) -> [KM] -> [KM]
forall a. (a -> Bool) -> [a] -> [a]
filter KM -> Bool
keyKnown [KM]
kms
                   keyNames :: Text
keyNames =
                     [KM] -> Text
disp ([KM] -> Text) -> [KM] -> Text
forall a b. (a -> b) -> a -> b
$ (if Bool
showManyKeys then [KM] -> [KM]
forall a. a -> a
id else X -> [KM] -> [KM]
forall a. X -> [a] -> [a]
take X
1) [KM]
knownKeys
                   kmsRes :: [KM]
kmsRes = if Text
desc Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" then [KM]
knownKeys else [KM]
kms
                   km :: KM
km = case [KM]
kmsRes of
                     [] -> KM
K.escKM
                     KM
km1 : [KM]
_ -> KM
km1
             , CmdCategory
cat CmdCategory -> [CmdCategory] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdCategory]
cats
             , Text
desc Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" Bool -> Bool -> Bool
|| CmdCategory
CmdInternal CmdCategory -> [CmdCategory] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CmdCategory]
cats]
      spLen :: X
spLen = DisplayFont -> [Char] -> X
forall a. DisplayFont -> [a] -> X
textSize DisplayFont
labFont [Char]
" "
      f :: (KeyOrSlot, (Bool, (Text, Text)))
-> X -> (KeyOrSlot, (PointUI, ButtonWidth))
f (KeyOrSlot
ks, (Bool
_, (Text
_, Text
t2))) X
y =
        (KeyOrSlot
ks, ( X -> X -> PointUI
PointUI X
spLen X
y
             , DisplayFont -> X -> ButtonWidth
ButtonWidth DisplayFont
labFont (X
offsetCol2 X -> X -> X
forall a. Num a => a -> a -> a
+ X
2 X -> X -> X
forall a. Num a => a -> a -> a
+ Text -> X
T.length Text
t2 X -> X -> X
forall a. Num a => a -> a -> a
- X
1)))
      kxs :: [(KeyOrSlot, (PointUI, ButtonWidth))]
kxs = ((KeyOrSlot, (Bool, (Text, Text)))
 -> X -> (KeyOrSlot, (PointUI, ButtonWidth)))
-> [(KeyOrSlot, (Bool, (Text, Text)))]
-> [X]
-> [(KeyOrSlot, (PointUI, ButtonWidth))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (KeyOrSlot, (Bool, (Text, Text)))
-> X -> (KeyOrSlot, (PointUI, ButtonWidth))
f [(KeyOrSlot, (Bool, (Text, Text)))]
keys
              [[Text] -> X
forall a. [a] -> X
length [Text]
headerMono1 X -> X -> X
forall a. Num a => a -> a -> a
+ [Text] -> X
forall a. [a] -> X
length [Text]
headerProp X -> X -> X
forall a. Num a => a -> a -> a
+ [Text] -> X
forall a. [a] -> X
length [Text]
headerMono2 ..]
      ts :: [(Bool, (Text, Text))]
ts = (Text -> (Bool, (Text, Text))) -> [Text] -> [(Bool, (Text, Text))]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
t -> (Bool
False, (Text
t, Text
""))) [Text]
headerMono1
           [(Bool, (Text, Text))]
-> [(Bool, (Text, Text))] -> [(Bool, (Text, Text))]
forall a. [a] -> [a] -> [a]
++ (Text -> (Bool, (Text, Text))) -> [Text] -> [(Bool, (Text, Text))]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
t -> (Bool
False, (Text
"", Text
t))) [Text]
headerProp
           [(Bool, (Text, Text))]
-> [(Bool, (Text, Text))] -> [(Bool, (Text, Text))]
forall a. [a] -> [a] -> [a]
++ (Text -> (Bool, (Text, Text))) -> [Text] -> [(Bool, (Text, Text))]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
t -> (Bool
False, (Text
t, Text
""))) [Text]
headerMono2
           [(Bool, (Text, Text))]
-> [(Bool, (Text, Text))] -> [(Bool, (Text, Text))]
forall a. [a] -> [a] -> [a]
++ ((KeyOrSlot, (Bool, (Text, Text))) -> (Bool, (Text, Text)))
-> [(KeyOrSlot, (Bool, (Text, Text)))] -> [(Bool, (Text, Text))]
forall a b. (a -> b) -> [a] -> [b]
map (KeyOrSlot, (Bool, (Text, Text))) -> (Bool, (Text, Text))
forall a b. (a, b) -> b
snd [(KeyOrSlot, (Bool, (Text, Text)))]
keys
           [(Bool, (Text, Text))]
-> [(Bool, (Text, Text))] -> [(Bool, (Text, Text))]
forall a. [a] -> [a] -> [a]
++ (Text -> (Bool, (Text, Text))) -> [Text] -> [(Bool, (Text, Text))]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
t -> (Bool
False, (Text
t, Text
""))) [Text]
footerMono
           [(Bool, (Text, Text))]
-> [(Bool, (Text, Text))] -> [(Bool, (Text, Text))]
forall a. [a] -> [a] -> [a]
++ (Text -> (Bool, (Text, Text))) -> [Text] -> [(Bool, (Text, Text))]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
t -> (Bool
False, (Text
"", Text
t))) [Text]
footerProp
      greyToAL :: (Bool, (Text, Text)) -> (AttrLine, (X, AttrLine))
greyToAL (Bool
b, (Text
t1, Text
t2)) =
        if Bool
b
        then let al1 :: AttrLine
al1 = Color -> Text -> AttrLine
textFgToAL Color
Color.BrBlack Text
t1
             in (AttrLine
al1, ( if Text -> Bool
T.null Text
t1 then X
0 else X
spLen X -> X -> X
forall a. Num a => a -> a -> a
* (X
offsetCol2 X -> X -> X
forall a. Num a => a -> a -> a
+ X
2)
                      , Color -> Text -> AttrLine
textFgToAL Color
Color.BrBlack Text
t2 ))
        else let al1 :: AttrLine
al1 = Text -> AttrLine
textToAL Text
t1
             in (AttrLine
al1, ( if Text -> Bool
T.null Text
t1 then X
0 else X
spLen X -> X -> X
forall a. Num a => a -> a -> a
* (X
offsetCol2 X -> X -> X
forall a. Num a => a -> a -> a
+ X
2)
                      , Text -> AttrLine
textToAL Text
t2 ))
      ([AttrLine]
greyLab, [(X, AttrLine)]
greyDesc) = [(AttrLine, (X, AttrLine))] -> ([AttrLine], [(X, AttrLine)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(AttrLine, (X, AttrLine))] -> ([AttrLine], [(X, AttrLine)]))
-> [(AttrLine, (X, AttrLine))] -> ([AttrLine], [(X, AttrLine)])
forall a b. (a -> b) -> a -> b
$ ((Bool, (Text, Text)) -> (AttrLine, (X, AttrLine)))
-> [(Bool, (Text, Text))] -> [(AttrLine, (X, AttrLine))]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, (Text, Text)) -> (AttrLine, (X, AttrLine))
greyToAL [(Bool, (Text, Text))]
ts
  in ( ([(PointUI, AttrLine)]
 -> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)])
-> DisplayFont
-> [(PointUI, AttrLine)]
-> FontOverlayMap
-> FontOverlayMap
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith [(PointUI, AttrLine)]
-> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
forall a. [a] -> [a] -> [a]
(++) DisplayFont
descFont ([(X, AttrLine)] -> [(PointUI, AttrLine)]
offsetOverlayX [(X, AttrLine)]
greyDesc)
       (FontOverlayMap -> FontOverlayMap)
-> FontOverlayMap -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ DisplayFont -> [(PointUI, AttrLine)] -> FontOverlayMap
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
labFont ([AttrLine] -> [(PointUI, AttrLine)]
offsetOverlay [AttrLine]
greyLab)
     , [(KeyOrSlot, (PointUI, ButtonWidth))]
kxs )