{-# 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           Game.LambdaHack.Client.UI.ItemSlot
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{..}
            , coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: ScreenContent -> X
rwidth :: X
rwidth, X
rheight :: ScreenContent -> X
rheight :: X
rheight} } FontSetup{..} =
  let
    movBlurb1 :: [Text]
movBlurb1 =
      [ "Walk throughout a level with mouse or numeric keypad (right diagram below)"
      , "or the Vi editor keys (middle) or the left-hand movement keys (left). Run until"
      , "disturbed with Shift or Control. Go-to a position with LMB (left mouse button)."
      ]
    movSchema :: [Text]
movSchema =
      [ "     q w e     y k u     7 8 9"
      , "      \\|/       \\|/       \\|/"
      , "     a-s-d     h-.-l     4-5-6"
      , "      /|\\       /|\\       /|\\"
      , "     z x c     b j n     1 2 3"
      ]
    movBlurb2 :: [Text]
movBlurb2 =
      [ "In aiming mode, the same keys (and mouse) move the aiming crosshair."
      , "Press `KP_5` (`5` on keypad) to wait, bracing for impact, which reduces any"
      , "damage taken and prevents displacement by foes. Press `S-KP_5` or `C-KP_5`"
      , "(the same key with Shift or Control) to lurk 0.1 of a turn, without bracing."
      , ""
      , "Displace enemies by running into them with Shift/Control or S-LMB. Search,"
      , "open, descend and attack by bumping into walls, doors, stairs and enemies."
      , "The best, not on cooldown, melee weapon is automatically chosen from your"
      , "equipment and from among your body parts."
      ]
    minimalBlurb :: [Text]
minimalBlurb =
      [ "The following few commands, joined with the movement and running keys,"
      , "let you accomplish almost anything in the game, though not necessarily"
      , "with the fewest keystrokes. You can also play the game exclusively"
      , "with a mouse, or both mouse and keyboard (e.g., mouse for go-to"
      , "and terrain inspection and keyboard for everything else). Lastly,"
      , "you can select a command with arrows or mouse directly from the help"
      , "screen or the dashboard and execute it on the spot."
      ]
    itemAllEnding :: [Text]
itemAllEnding =
      [ "Note how lower case item commands (stash item, equip item) place items"
      , "into a particular item store, while upper case item commands (manage Inventory,"
      , "manage Outfit) open management menu for a store. Once a store menu is opened,"
      , "you can switch stores with `<` and `>`, so the multiple commands only determine"
      , "the starting item store. Each store is accessible from the dashboard as well."
      ]
    mouseBasicsBlurb :: [Text]
mouseBasicsBlurb =
      [ "Screen area and UI mode (exploration/aiming) determine mouse click"
      , "effects. Here we give an overview of effects of each button over"
      , "the game map area. The list includes not only left and right buttons,"
      , "but also the optional middle mouse button (MMB) and the mouse wheel,"
      , "which is also used over menus, to page-scroll them. For mice without RMB,"
      , "one can use Control key with LMB and for mice without MMB, one can use"
      , "C-RMB or C-S-LMB."
      ]
    mouseAreasBlurb :: [Text]
mouseAreasBlurb =
      [ "Next we show mouse button effects per screen area, in exploration mode"
      , "and (if different) in aiming mode. Note that this is all optional. Keyboard"
      , "suffices, at worst requiring the more obscure commands listed later on."
      ]
    mouseAreasMini :: [Text]
mouseAreasMini =
      [ "Mouse button effects per screen area, in exploration and in aiming modes"
      ]
    movTextEnd :: Text
movTextEnd = "Press SPACE or PGDN to advance or ESC to see the map again."
    lastHelpEnd :: Text
lastHelpEnd = "Use mouse wheel or PGUP to go back and ESC to see the map again."
    seeAlso :: Text
seeAlso = "For more playing instructions see file PLAYING.md."
    offsetCol2 :: X
offsetCol2 = 12
    pickLeaderDescription :: [Text]
pickLeaderDescription =
      [ X -> Text -> Text -> Text
fmt X
offsetCol2 "0, 1 ... 9"
                       "pick a particular actor as the new pointman"
      ]
    casualDescription :: Text
casualDescription = "Minimal cheat sheet for casual play"
    fmt0 :: X -> Text -> Text -> Text
fmt0 n :: X
n k :: Text
k h :: Text
h = X -> Char -> Text -> Text
T.justifyLeft X
n ' ' Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
h
    fmt :: X -> Text -> Text -> Text
fmt n :: X
n k :: Text
k h :: Text
h = " " 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 "keys" "command"
    mouseOverviewCaption :: Text
mouseOverviewCaption = X -> Text -> Text -> Text
fmt X
offsetCol2 "keys" "command (exploration/aiming)"
    spLen :: X
spLen = DisplayFont -> [Char] -> X
forall a. DisplayFont -> [a] -> X
textSize DisplayFont
monoFont " "
    pamoveRight :: Int -> (PointUI, a) -> (PointUI, a)
    pamoveRight :: X -> (PointUI, a) -> (PointUI, a)
pamoveRight xoff :: X
xoff (PointUI x :: X
x y :: X
y, a :: a
a) = (X -> X -> PointUI
PointUI (X
x X -> X -> X
forall a. Num a => a -> a -> a
+ X
xoff) X
y, a
a)
    okxs :: CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs cat :: CmdCategory
cat headers :: ([Text], [Text], [Text])
headers footers :: ([Text], [Text])
footers =
      let (ovs :: FontOverlayMap
ovs, kyx :: [KYX]
kyx) = InputContent
-> DisplayFont
-> DisplayFont
-> X
-> X
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> ([Text], [Text], [Text])
-> ([Text], [Text])
-> OKX
okxsN InputContent
coinput DisplayFont
monoFont DisplayFont
propFont 0 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
      in ( ([(PointUI, AttrLine)] -> [(PointUI, AttrLine)])
-> FontOverlayMap -> FontOverlayMap
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (((PointUI, AttrLine) -> (PointUI, AttrLine))
-> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (X -> (PointUI, AttrLine) -> (PointUI, AttrLine)
forall a. X -> (PointUI, a) -> (PointUI, a)
pamoveRight X
spLen)) FontOverlayMap
ovs
         , (KYX -> KYX) -> [KYX] -> [KYX]
forall a b. (a -> b) -> [a] -> [b]
map (((PointUI, ButtonWidth) -> (PointUI, ButtonWidth)) -> KYX -> KYX
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((PointUI, ButtonWidth) -> (PointUI, ButtonWidth)) -> KYX -> KYX)
-> ((PointUI, ButtonWidth) -> (PointUI, ButtonWidth)) -> KYX -> KYX
forall a b. (a -> b) -> a -> b
$ X -> (PointUI, ButtonWidth) -> (PointUI, ButtonWidth)
forall a. X -> (PointUI, a) -> (PointUI, a)
pamoveRight X
spLen) [KYX]
kyx )
    renumber :: X -> (a, (PointUI, b)) -> (a, (PointUI, b))
renumber dy :: X
dy (km :: a
km, (PointUI x :: X
x y :: X
y, len :: b
len)) = (a
km, (X -> X -> PointUI
PointUI X
x (X
y X -> X -> X
forall a. Num a => a -> a -> a
+ X
dy), b
len))
    renumberOv :: X -> [(PointUI, b)] -> [(PointUI, b)]
renumberOv dy :: X
dy = ((PointUI, b) -> (PointUI, b)) -> [(PointUI, b)] -> [(PointUI, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(PointUI x :: X
x y :: X
y, al :: b
al) -> (X -> X -> PointUI
PointUI X
x (X
y X -> X -> X
forall a. Num a => a -> a -> a
+ X
dy), b
al))
    mergeOKX :: OKX -> OKX -> OKX
    mergeOKX :: OKX -> OKX -> OKX
mergeOKX (ovs1 :: FontOverlayMap
ovs1, ks1 :: [KYX]
ks1) (ovs2 :: FontOverlayMap
ovs2, ks2 :: [KYX]
ks2) =
      let off :: X
off = 1 X -> X -> X
forall a. Num a => a -> a -> a
+ ([(PointUI, AttrLine)] -> X -> X) -> X -> FontOverlayMap -> X
forall a b k. (a -> b -> b) -> b -> EnumMap k a -> b
EM.foldr (\ov :: [(PointUI, AttrLine)]
ov acc :: X
acc -> X -> X -> X
forall a. Ord a => a -> a -> a
max X
acc ([(PointUI, AttrLine)] -> X
maxYofOverlay [(PointUI, AttrLine)]
ov)) 0 FontOverlayMap
ovs1
      in ( ([(PointUI, AttrLine)]
 -> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)])
-> FontOverlayMap -> FontOverlayMap -> FontOverlayMap
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith [(PointUI, AttrLine)]
-> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
forall a. [a] -> [a] -> [a]
(++) FontOverlayMap
ovs1 (FontOverlayMap -> FontOverlayMap)
-> FontOverlayMap -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ ([(PointUI, AttrLine)] -> [(PointUI, AttrLine)])
-> FontOverlayMap -> FontOverlayMap
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (X -> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
forall b. X -> [(PointUI, b)] -> [(PointUI, b)]
renumberOv X
off) FontOverlayMap
ovs2
         , [KYX]
ks1 [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ (KYX -> KYX) -> [KYX] -> [KYX]
forall a b. (a -> b) -> [a] -> [b]
map (X -> KYX -> KYX
forall a b. X -> (a, (PointUI, b)) -> (a, (PointUI, b))
renumber X
off) [KYX]
ks2 )
    catLength :: CmdCategory -> X
catLength cat :: 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 (\(_, (cats :: [CmdCategory]
cats, desc :: Text
desc, _)) ->
      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
/= "" 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 = 13
    keyB :: X
keyB = 31
    truncatem :: Text -> Text
truncatem b :: 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
- 1) Text
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "$"
                  else Text
b
    fmm :: Text -> Text -> Text -> Text
fmm a :: Text
a b :: Text
b c :: Text
c = X -> Text -> Text -> Text
fmt (X
keyM X -> X -> X
forall a. Num a => a -> a -> a
+ 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 t :: Text
t = Text -> Text -> Text -> Text
fmm Text
t "LMB (left mouse button)" "RMB (right mouse button)"
    keySel :: (forall a. (a, a) -> a) -> K.KM
           -> [(CmdArea, Either K.KM SlotChar, Text)]
    keySel :: (forall a. (a, a) -> a)
-> KM -> [(CmdArea, Either KM SlotChar, Text)]
keySel sel :: forall a. (a, a) -> a
sel key :: 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 (_, _, cmd2 :: HumanCmd
cmd2) -> HumanCmd
cmd2
            Nothing -> [Char] -> HumanCmd
forall a. HasCallStack => [Char] -> a
error ([Char] -> HumanCmd) -> [Char] -> HumanCmd
forall a b. (a -> b) -> a -> b
$ "" [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 lexp :: [(CmdArea, HumanCmd)]
lexp, aiming :: AimModeCmd -> HumanCmd
aiming=ByArea laim :: [(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)
            _ -> [Char] -> [(CmdArea, HumanCmd)]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [(CmdArea, HumanCmd)])
-> [Char] -> [(CmdArea, HumanCmd)]
forall a b. (a -> b) -> a -> b
$ "" [Char] -> HumanCmd -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` HumanCmd
cmd
          caMakeChoice :: (CmdArea, HumanCmd) -> (CmdArea, Either KM SlotChar, Text)
caMakeChoice (ca :: CmdArea
ca, cmd2 :: HumanCmd
cmd2) =
            let (km :: KM
km, desc :: 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 ks :: [KM]
ks ->
                    let descOfKM :: KM -> Maybe (KM, Text)
descOfKM km2 :: 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 (_, "", _) -> Maybe (KM, Text)
forall a. Maybe a
Nothing
                          Just (_, desc2 :: Text
desc2, _) -> (KM, Text) -> Maybe (KM, Text)
forall a. a -> Maybe a
Just (KM
km2, Text
desc2)
                          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] -> 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] -> ([KM], HumanCmd) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ([KM]
ks, HumanCmd
cmd2)
                      kmdesc3 :: (KM, Text)
kmdesc3 : _ -> (KM, Text)
kmdesc3
                  Nothing -> (KM
key, "(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
<> ")")
            in (CmdArea
ca, KM -> Either KM SlotChar
forall a b. a -> Either a b
Left KM
km, Text
desc)
      in ((CmdArea, HumanCmd) -> (CmdArea, Either KM SlotChar, Text))
-> [(CmdArea, HumanCmd)] -> [(CmdArea, Either KM SlotChar, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (CmdArea, HumanCmd) -> (CmdArea, Either KM SlotChar, Text)
caMakeChoice [(CmdArea, HumanCmd)]
caCmds
    doubleIfSquare :: X -> X
doubleIfSquare n :: X
n | DisplayFont -> Bool
isSquareFont DisplayFont
monoFont = 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 sel :: forall a. (a, a) -> a
sel key1 :: KM
key1 key2 :: KM
key2 header :: [Text]
header =
      let kst1 :: [(CmdArea, Either KM SlotChar, Text)]
kst1 = (forall a. (a, a) -> a)
-> KM -> [(CmdArea, Either KM SlotChar, Text)]
keySel forall a. (a, a) -> a
sel KM
key1
          kst2 :: [(CmdArea, Either KM SlotChar, Text)]
kst2 = (forall a. (a, a) -> a)
-> KM -> [(CmdArea, Either KM SlotChar, Text)]
keySel forall a. (a, a) -> a
sel KM
key2
          f :: (CmdArea, Either KM SlotChar, Text)
-> (CmdArea, Either KM SlotChar, Text) -> X -> [KYX]
f (ca1 :: CmdArea
ca1, Left km1 :: KM
km1, _) (ca2 :: CmdArea
ca2, Left km2 :: KM
km2, _) y :: X
y =
            Bool -> [KYX] -> [KYX]
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, Either KM SlotChar, Text)],
    [(CmdArea, Either KM SlotChar, Text)])
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (CmdArea
ca1, CmdArea
ca2, KM
km1, KM
km2, [(CmdArea, Either KM SlotChar, Text)]
kst1, [(CmdArea, Either KM SlotChar, Text)]
kst2))
              [ ([KM] -> Either [KM] SlotChar
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
+ 4) X
y
                             , DisplayFont -> X -> ButtonWidth
ButtonWidth DisplayFont
monoFont X
keyB ))
              , ([KM] -> Either [KM] SlotChar
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
+ 5) X
y
                             , DisplayFont -> X -> ButtonWidth
ButtonWidth DisplayFont
monoFont X
keyB )) ]
          f c :: (CmdArea, Either KM SlotChar, Text)
c d :: (CmdArea, Either KM SlotChar, Text)
d e :: X
e = [Char] -> [KYX]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [KYX]) -> [Char] -> [KYX]
forall a b. (a -> b) -> a -> b
$ "" [Char]
-> ((CmdArea, Either KM SlotChar, Text),
    (CmdArea, Either KM SlotChar, Text), X)
-> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` ((CmdArea, Either KM SlotChar, Text)
c, (CmdArea, Either KM SlotChar, Text)
d, X
e)
          kxs :: [KYX]
kxs = [[KYX]] -> [KYX]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KYX]] -> [KYX]) -> [[KYX]] -> [KYX]
forall a b. (a -> b) -> a -> b
$ ((CmdArea, Either KM SlotChar, Text)
 -> (CmdArea, Either KM SlotChar, Text) -> X -> [KYX])
-> [(CmdArea, Either KM SlotChar, Text)]
-> [(CmdArea, Either KM SlotChar, Text)]
-> [X]
-> [[KYX]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (CmdArea, Either KM SlotChar, Text)
-> (CmdArea, Either KM SlotChar, Text) -> X -> [KYX]
f [(CmdArea, Either KM SlotChar, Text)]
kst1 [(CmdArea, Either KM SlotChar, Text)]
kst2 [1 X -> X -> X
forall a. Num a => a -> a -> a
+ [Text] -> X
forall a. [a] -> X
length [Text]
header..]
          menuLeft :: [Text]
menuLeft = ((CmdArea, Either KM SlotChar, Text) -> Text)
-> [(CmdArea, Either KM SlotChar, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(ca1 :: CmdArea
ca1, _, _) -> CmdArea -> Text
areaDescription CmdArea
ca1) [(CmdArea, Either KM SlotChar, Text)]
kst1
          menuMiddle :: [Text]
menuMiddle = ((CmdArea, Either KM SlotChar, Text) -> Text)
-> [(CmdArea, Either KM SlotChar, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(_, _, desc :: Text
desc) -> Text
desc) [(CmdArea, Either KM SlotChar, Text)]
kst1
          menuRight :: [Text]
menuRight = ((CmdArea, Either KM SlotChar, Text) -> Text)
-> [(CmdArea, Either KM SlotChar, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(_, _, desc :: Text
desc) -> Text
desc) [(CmdArea, Either KM SlotChar, Text)]
kst2
          y0 :: X
y0 = 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]
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) -> [Text] -> [(PointUI, AttrLine)]
typesetXY (X -> X
doubleIfSquare 2, X
y0) [Text]
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) -> [Text] -> [(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
+ 4, X
y0) [Text]
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) -> [Text] -> [(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
+ 5, X
y0) [Text]
menuRight ]
         , [KYX]
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, AttrLine)] -> [(PointUI, AttrLine)]
offsetOverlayX
                      ([(X, AttrLine)] -> [(PointUI, AttrLine)])
-> ([Text] -> [(X, AttrLine)]) -> [Text] -> [(PointUI, AttrLine)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> (X, AttrLine)) -> [Text] -> [(X, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: Text
t -> (X
spLen, Text -> AttrLine
textToAL Text
t))
    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, AttrLine)] -> [(PointUI, AttrLine)]
offsetOverlayX
                    ([(X, AttrLine)] -> [(PointUI, AttrLine)])
-> ([Text] -> [(X, AttrLine)]) -> [Text] -> [(PointUI, AttrLine)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> (X, AttrLine)) -> [Text] -> [(X, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: Text
t -> (X
spLen, Text -> AttrLine
textToAL Text
t))
    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, AttrLine)] -> [(PointUI, AttrLine)]
offsetOverlayX
                    ([(X, AttrLine)] -> [(PointUI, AttrLine)])
-> ([Text] -> [(X, AttrLine)]) -> [Text] -> [(PointUI, AttrLine)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> (X, AttrLine)) -> [Text] -> [(X, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: Text
t -> (X
spLen, Text -> AttrLine
textToAL Text
t))
    typesetXY :: (Int, Int) -> [Text] -> Overlay
    typesetXY :: (X, X) -> [Text] -> [(PointUI, AttrLine)]
typesetXY (xoffset :: X
xoffset, yoffset :: X
yoffset) =
      ((X, Text) -> (PointUI, AttrLine))
-> [(X, Text)] -> [(PointUI, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (\(y :: X
y, t :: Text
t) -> (X -> X -> PointUI
PointUI X
xoffset (X
y X -> X -> X
forall a. Num a => a -> a -> a
+ X
yoffset), Text -> AttrLine
textToAL Text
t)) ([(X, Text)] -> [(PointUI, AttrLine)])
-> ([Text] -> [(X, Text)]) -> [Text] -> [(PointUI, AttrLine)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [X] -> [Text] -> [(X, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..]
    sideBySide :: [(Text, OKX)] -> [(Text, OKX)]
    sideBySide :: [(Text, OKX)] -> [(Text, OKX)]
sideBySide ((_t1 :: Text
_t1, (ovs1 :: FontOverlayMap
ovs1, kyx1 :: [KYX]
kyx1)) : (t2 :: Text
t2, (ovs2 :: FontOverlayMap
ovs2, kyx2 :: [KYX]
kyx2)) : rest :: [(Text, OKX)]
rest)
      | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ DisplayFont -> Bool
isSquareFont DisplayFont
propFont =
        (Text
t2, ( ([(PointUI, AttrLine)]
 -> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)])
-> FontOverlayMap -> FontOverlayMap -> FontOverlayMap
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith [(PointUI, AttrLine)]
-> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
forall a. [a] -> [a] -> [a]
(++) FontOverlayMap
ovs1 (([(PointUI, AttrLine)] -> [(PointUI, AttrLine)])
-> FontOverlayMap -> FontOverlayMap
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (((PointUI, AttrLine) -> (PointUI, AttrLine))
-> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (X -> (PointUI, AttrLine) -> (PointUI, AttrLine)
forall a. X -> (PointUI, a) -> (PointUI, a)
pamoveRight X
rwidth)) FontOverlayMap
ovs2)
             , (KYX -> (X, X)) -> [KYX] -> [KYX]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(_, (PointUI x :: X
x y :: X
y, _)) -> (X
y, X
x))
               ([KYX] -> [KYX]) -> [KYX] -> [KYX]
forall a b. (a -> b) -> a -> b
$ [KYX]
kyx1 [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ (KYX -> KYX) -> [KYX] -> [KYX]
forall a b. (a -> b) -> [a] -> [b]
map (((PointUI, ButtonWidth) -> (PointUI, ButtonWidth)) -> KYX -> KYX
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((PointUI, ButtonWidth) -> (PointUI, ButtonWidth)) -> KYX -> KYX)
-> ((PointUI, ButtonWidth) -> (PointUI, ButtonWidth)) -> KYX -> KYX
forall a b. (a -> b) -> a -> b
$ X -> (PointUI, ButtonWidth) -> (PointUI, ButtonWidth)
forall a. X -> (PointUI, a) -> (PointUI, a)
pamoveRight X
rwidth) [KYX]
kyx2 ))
        (Text, OKX) -> [(Text, OKX)] -> [(Text, OKX)]
forall a. a -> [a] -> [a]
: [(Text, OKX)] -> [(Text, OKX)]
sideBySide [(Text, OKX)]
rest
    sideBySide l :: [(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
+ 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
casualDescription Text -> Text -> Text
<+> "(1/2)", ""]
                        , [] )
                        (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]
forall a. a -> [a] -> [a]
: [Text]
movSchema, [])))
              ([Text] -> FontOverlayMap
typesetInProp ([Text] -> FontOverlayMap) -> [Text] -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ "" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
movBlurb2, []) )
        , ( Text
movTextEnd
          , CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMinimal
                 ( ["", Text
casualDescription Text -> Text -> Text
<+> "(2/2)", ""]
                 , [Text]
minimalBlurb [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [""]
                 , [Text
keyCaption] )
                 ([], []) ) ]
      else
        [ ( Text
movTextEnd
          , OKX -> OKX -> OKX
mergeOKX
              (OKX -> OKX -> OKX
mergeOKX ( [Text] -> FontOverlayMap
typesetInMono ["", Text
casualDescription, ""]
                        , [] )
                        (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]
forall a. a -> [a] -> [a]
: [Text]
movSchema, [])))
              (CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMinimal
                    ( []
                    , [""] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
movBlurb2 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [""]
                       [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
minimalBlurb [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [""]
                    , [Text
keyCaption] )
                    ([], [""])) ) ]
    , if 45 X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
rheight then
        [ ( Text
movTextEnd
          , let (ls :: FontOverlayMap
ls, _) = CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMouse
                               ( ["", "Optional mouse commands", ""]
                               , [Text]
mouseBasicsBlurb [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [""]
                               , [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]
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 "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 "Aiming Mode"])) ) ]
      else
        [ ( Text
movTextEnd
          , let (ls :: FontOverlayMap
ls, _) = CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMouse
                               ( ["", "Optional mouse commands", ""]
                               , [Text]
mouseBasicsBlurb [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [""]
                               , [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]
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 "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 "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
+ 9 X -> X -> X
forall a. Num a => a -> a -> a
+ 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
                 (["", CmdCategory -> Text
categoryDescription CmdCategory
CmdItem], [], ["", Text
keyCaption])
                 ([], "" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
itemAllEnding) )
        , ( Text
movTextEnd
          , CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMove
                 (["", CmdCategory -> Text
categoryDescription CmdCategory
CmdMove], [], ["", Text
keyCaption])
                 ([Text]
pickLeaderDescription, []) ) ]
      else
        [ ( Text
movTextEnd
          , OKX -> OKX -> OKX
mergeOKX
              (CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdItem
                    (["", CmdCategory -> Text
categoryDescription CmdCategory
CmdItem], [], ["", Text
keyCaption])
                    ([], "" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
itemAllEnding))
              (CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMove
                    ( ["", "", CmdCategory -> Text
categoryDescription CmdCategory
CmdMove]
                    , []
                    , ["", Text
keyCaption] )
                    ([Text]
pickLeaderDescription, [""])) ) ]
    , 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
+ 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
                 (["", CmdCategory -> Text
categoryDescription CmdCategory
CmdAim], [], ["", Text
keyCaption])
                 ([], []) )
        , ( Text
lastHelpEnd
          , CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMeta
                 (["", CmdCategory -> Text
categoryDescription CmdCategory
CmdMeta], [], ["", Text
keyCaption])
                 ([], ["", Text
seeAlso]) ) ]
      else
        [ ( Text
lastHelpEnd
          , OKX -> OKX -> OKX
mergeOKX
              (CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdAim
                    (["", CmdCategory -> Text
categoryDescription CmdCategory
CmdAim], [], ["", Text
keyCaption])
                    ([], []))
              (CmdCategory -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxs CmdCategory
CmdMeta
                    ( ["", "", CmdCategory -> Text
categoryDescription CmdCategory
CmdMeta]
                    , []
                    , ["", Text
keyCaption] )
                    ([], ["", Text
seeAlso, ""])) ) ]
    ]

-- | 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 -> Int
      -> (HumanCmd -> Bool) -> Bool -> CmdCategory
      -> ([Text], [Text], [Text]) -> ([Text], [Text]) -> OKX
okxsN :: InputContent
-> DisplayFont
-> DisplayFont
-> X
-> X
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> ([Text], [Text], [Text])
-> ([Text], [Text])
-> OKX
okxsN InputContent{..} keyFont :: DisplayFont
keyFont descFont :: DisplayFont
descFont offset :: X
offset offsetCol2 :: X
offsetCol2 greyedOut :: HumanCmd -> Bool
greyedOut
      showManyKeys :: Bool
showManyKeys cat :: CmdCategory
cat (headerMono1 :: [Text]
headerMono1, headerProp :: [Text]
headerProp, headerMono2 :: [Text]
headerMono2)
                       (footerMono :: [Text]
footerMono, footerProp :: [Text]
footerProp) =
  let fmt :: Text -> b -> (Text, b)
fmt k :: Text
k h :: b
h = (Char -> Text
T.singleton '\x00a0' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k, b
h)
      coImage :: HumanCmd -> [K.KM]
      coImage :: HumanCmd -> [KM]
coImage cmd :: 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] -> 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 " 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
km = case KM -> Key
K.key KM
km of
        K.Unknown{} -> Bool
False
        _ -> Bool
True
      keys :: [(Either [K.KM] SlotChar, (Bool, (Text, Text)))]
      keys :: [(Either [KM] SlotChar, (Bool, (Text, Text)))]
keys = [ ([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM]
kmsRes, (HumanCmd -> Bool
greyedOut HumanCmd
cmd, Text -> Text -> (Text, Text)
forall b. Text -> b -> (Text, b)
fmt Text
keyNames Text
desc))
             | (_, (cats :: [CmdCategory]
cats, desc :: Text
desc, cmd :: 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 1) [KM]
knownKeys
                   kmsRes :: [KM]
kmsRes = if Text
desc Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "" then [KM]
knownKeys else [KM]
kms
             , 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
/= "" 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
keyFont " "
      f :: (Either [KM] SlotChar, (Bool, (Text, Text))) -> X -> KYX
f (ks :: Either [KM] SlotChar
ks, (_, (_, t2 :: Text
t2))) y :: X
y =
        (Either [KM] SlotChar
ks, ( X -> X -> PointUI
PointUI X
spLen X
y
             , DisplayFont -> X -> ButtonWidth
ButtonWidth DisplayFont
keyFont (X
offsetCol2 X -> X -> X
forall a. Num a => a -> a -> a
+ 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
- 1)))
      kxs :: [KYX]
kxs = ((Either [KM] SlotChar, (Bool, (Text, Text))) -> X -> KYX)
-> [(Either [KM] SlotChar, (Bool, (Text, Text)))] -> [X] -> [KYX]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Either [KM] SlotChar, (Bool, (Text, Text))) -> X -> KYX
f [(Either [KM] SlotChar, (Bool, (Text, Text)))]
keys [X
offset X -> X -> X
forall a. Num a => a -> a -> a
+ [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 ..]
      renumberOv :: [(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
renumberOv = ((PointUI, AttrLine) -> (PointUI, AttrLine))
-> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (\(PointUI x :: X
x y :: X
y, al :: AttrLine
al) -> (X -> X -> PointUI
PointUI X
x (X
y X -> X -> X
forall a. Num a => a -> a -> a
+ X
offset), AttrLine
al))
      ts :: [(Bool, (Text, Text))]
ts = (Text -> (Bool, (Text, Text))) -> [Text] -> [(Bool, (Text, Text))]
forall a b. (a -> b) -> [a] -> [b]
map (\t :: Text
t -> (Bool
False, (Text
t, ""))) [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 (\t :: Text
t -> (Bool
False, ("", 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 (\t :: Text
t -> (Bool
False, (Text
t, ""))) [Text]
headerMono2
           [(Bool, (Text, Text))]
-> [(Bool, (Text, Text))] -> [(Bool, (Text, Text))]
forall a. [a] -> [a] -> [a]
++ ((Either [KM] SlotChar, (Bool, (Text, Text)))
 -> (Bool, (Text, Text)))
-> [(Either [KM] SlotChar, (Bool, (Text, Text)))]
-> [(Bool, (Text, Text))]
forall a b. (a -> b) -> [a] -> [b]
map (Either [KM] SlotChar, (Bool, (Text, Text)))
-> (Bool, (Text, Text))
forall a b. (a, b) -> b
snd [(Either [KM] SlotChar, (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 (\t :: Text
t -> (Bool
False, (Text
t, ""))) [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 (\t :: Text
t -> (Bool
False, ("", Text
t))) [Text]
footerProp
      greyToAL :: (Bool, (Text, Text)) -> (AttrLine, (X, AttrLine))
greyToAL (b :: Bool
b, (t1 :: Text
t1, t2 :: 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 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
+ 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 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
+ 2)
                      , Text -> AttrLine
textToAL Text
t2 ))
      (greyLab :: [AttrLine]
greyLab, greyDesc :: [(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 ([(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
renumberOv ([(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
keyFont ([(PointUI, AttrLine)] -> FontOverlayMap)
-> [(PointUI, AttrLine)] -> FontOverlayMap
forall a b. (a -> b) -> a -> b
$ [(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
renumberOv ([(PointUI, AttrLine)] -> [(PointUI, AttrLine)])
-> [(PointUI, AttrLine)] -> [(PointUI, AttrLine)]
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> [(PointUI, AttrLine)]
offsetOverlay [AttrLine]
greyLab
     , [KYX]
kxs )