{-# LANGUAGE RankNTypes #-}
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
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, []) )
, ( 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, [])
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, ""])) ) ]
]
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 )