{-# LANGUAGE RankNTypes, TupleSections #-}
module Game.LambdaHack.Client.UI.KeyBindings
( keyHelp, okxsN
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
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.Slideshow
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Definition.Color as Color
keyHelp :: COps -> CCUI -> Int -> [(Text, OKX)]
keyHelp :: COps -> CCUI -> Int -> [(Text, OKX)]
keyHelp COps{RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule}
CCUI{ coinput :: CCUI -> InputContent
coinput=coinput :: InputContent
coinput@InputContent{..}
, coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight, [String]
rintroScreen :: ScreenContent -> [String]
rintroScreen :: [String]
rintroScreen, [String]
rmoveKeysScreen :: ScreenContent -> [String]
rmoveKeysScreen :: [String]
rmoveKeysScreen} }
offset :: Int
offset = Bool -> [(Text, OKX)] -> [(Text, OKX)]
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) ([(Text, OKX)] -> [(Text, OKX)]) -> [(Text, OKX)] -> [(Text, OKX)]
forall a b. (a -> b) -> a -> b
$
let
introBlurb :: [Text]
introBlurb =
""
Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
rintroScreen
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
[ ""
, "Press SPACE or PGDN for help and ESC to see the map again."
]
movBlurb :: [Text]
movBlurb = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
rmoveKeysScreen
movBlurbEnd :: [Text]
movBlurbEnd =
[ "Press SPACE or scroll the mouse wheel to see the minimal command set."
]
minimalBlurb :: [Text]
minimalBlurb =
[ "The following commands, joined with the basic set above,"
, "let you accomplish 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. (See the ending help screens for mouse commands.)"
, "Lastly, you can select a command with arrows or mouse directly"
, "from the help screen or the dashboard and execute it on the spot."
, ""
]
casualEnding :: [Text]
casualEnding =
[ ""
, "Press SPACE to see the detailed descriptions of all commands."
]
categoryEnding :: [Text]
categoryEnding =
[ ""
, "Press SPACE to see the next page of command descriptions."
]
itemMenuEnding :: [Text]
itemMenuEnding =
[ ""
, "Note how lower case item commands (pack an item, equip, stash)"
, "let you move items into a particular item store."
, ""
, "Press SPACE to see the detailed descriptions of other item-related commands."
]
itemRemainingEnding :: [Text]
itemRemainingEnding =
[ ""
, "Note how upper case item commands (manage Pack, Equipment,"
, "Stash, etc.) let you view and organize items within"
, "a particular item store. Once a menu is opened, you can"
, "switch stores at will, so each of the commands only"
, "determines the starting item store. Each store"
, "is accessible from the dashboard, as well."
, ""
, "Press SPACE to see the next page of command descriptions."
]
itemAllEnding :: [Text]
itemAllEnding =
[ ""
, "Note how lower case item commands (pack an item, equip, stash)"
, "let you move items into a particular item store, while"
, "upper case item commands (manage Pack, Equipment, Stash, etc.)"
, "let you view and organize items within an item store."
, "Once a store management menu is opened, you can switch"
, "stores at will, so the multiple commands only determine"
, "the starting item store. Each store is accessible"
, "from the dashboard as well."
, ""
, "Press SPACE to see the next page of command descriptions."
]
mouseBasicsBlurb :: [Text]
mouseBasicsBlurb =
[ "Screen area and UI mode (exploration/aiming) determine"
, "mouse click effects. First, 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.)"
, "Next we show mouse button effects per screen area,"
, "in exploration mode and (if different) in aiming mode."
, ""
]
mouseBasicsEnding :: [Text]
mouseBasicsEnding =
[ ""
, "Press SPACE to see mouse commands in exploration and aiming modes."
]
lastHelpEnding :: [Text]
lastHelpEnding =
[ ""
, "For more playing instructions see file PLAYING.md. Press PGUP or scroll"
, "mouse wheel for previous pages and press SPACE or ESC to see the map again."
]
keyL :: Int
keyL = 12
pickLeaderDescription :: [Text]
pickLeaderDescription =
[ Int -> Text -> Text -> Text
fmt Int
keyL "0, 1 ... 6" "pick a particular actor as the new leader"
]
casualDescription :: Text
casualDescription = "Minimal cheat sheet for casual play"
fmt :: Int -> Text -> Text -> Text
fmt n :: Int
n k :: Text
k h :: Text
h = " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
T.justifyLeft Int
n ' ' Text
k Text -> Text -> Text
<+> Text
h
fmts :: a -> a
fmts s :: a
s = " " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s
introText :: [Text]
introText = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
introBlurb
movText :: [Text]
movText = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
movBlurb
movTextEnd :: [Text]
movTextEnd = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
movBlurbEnd
minimalText :: [Text]
minimalText = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
minimalBlurb
casualEnd :: [Text]
casualEnd = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
casualEnding
categoryEnd :: [Text]
categoryEnd = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
categoryEnding
itemMenuEnd :: [Text]
itemMenuEnd = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
itemMenuEnding
itemRemainingEnd :: [Text]
itemRemainingEnd = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
itemRemainingEnding
itemAllEnd :: [Text]
itemAllEnd = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
itemAllEnding
mouseBasicsText :: [Text]
mouseBasicsText = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
mouseBasicsBlurb
mouseBasicsEnd :: [Text]
mouseBasicsEnd = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
mouseBasicsEnding
lastHelpEnd :: [Text]
lastHelpEnd = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
fmts [Text]
lastHelpEnding
keyCaptionN :: Int -> Text
keyCaptionN n :: Int
n = Int -> Text -> Text -> Text
fmt Int
n "keys" "command"
keyCaption :: Text
keyCaption = Int -> Text
keyCaptionN Int
keyL
okxs :: CmdCategory -> [Text] -> [Text] -> OKX
okxs = InputContent
-> Int
-> Int
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> [Text]
-> [Text]
-> OKX
okxsN InputContent
coinput Int
offset Int
keyL (Bool -> HumanCmd -> Bool
forall a b. a -> b -> a
const Bool
False) Bool
True
renumber :: a -> (a, (a, b, c)) -> (a, (a, b, c))
renumber y :: a
y (km :: a
km, (y0 :: a
y0, x1 :: b
x1, x2 :: c
x2)) = (a
km, (a
y0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
y, b
x1, c
x2))
mergeOKX :: OKX -> OKX -> OKX
mergeOKX :: OKX -> OKX -> OKX
mergeOKX (ov1 :: Overlay
ov1, ks1 :: [KYX]
ks1) (ov2 :: Overlay
ov2, ks2 :: [KYX]
ks2) =
(Overlay
ov1 Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Overlay
ov2, [KYX]
ks1 [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ (KYX -> KYX) -> [KYX] -> [KYX]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> KYX -> KYX
forall a a b c. Num a => a -> (a, (a, b, c)) -> (a, (a, b, c))
renumber (Int -> KYX -> KYX) -> Int -> KYX -> KYX
forall a b. (a -> b) -> a -> b
$ Overlay -> Int
forall a. [a] -> Int
length Overlay
ov1) [KYX]
ks2)
catLength :: CmdCategory -> Int
catLength cat :: CmdCategory
cat = [(KM, CmdTriple)] -> Int
forall a. [a] -> Int
length ([(KM, CmdTriple)] -> Int) -> [(KM, CmdTriple)] -> Int
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 :: Int
keyM = 13
keyB :: Int
keyB = 31
truncatem :: Text -> Text
truncatem b :: Text
b = if Text -> Int
T.length Text
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
keyB
then Int -> Text -> Text
T.take (Int
keyB Int -> Int -> Int
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 = Int -> Text -> Text -> Text
fmt Int
keyM Text
a (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text -> Text
fmt Int
keyB (Text -> Text
truncatem Text
b) (" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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 -> String -> HumanCmd
forall a. (?callStack::CallStack) => String -> a
error (String -> HumanCmd) -> String -> HumanCmd
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`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)
_ -> String -> [(CmdArea, HumanCmd)]
forall a. (?callStack::CallStack) => String -> a
error (String -> [(CmdArea, HumanCmd)])
-> String -> [(CmdArea, HumanCmd)]
forall a b. (a -> b) -> a -> b
$ "" String -> HumanCmd -> String
forall v. Show v => String -> v -> String
`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 -> String -> Maybe (KM, Text)
forall a. (?callStack::CallStack) => String -> a
error (String -> Maybe (KM, Text)) -> String -> Maybe (KM, Text)
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`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
[] -> String -> (KM, Text)
forall a. (?callStack::CallStack) => String -> a
error (String -> (KM, Text)) -> String -> (KM, Text)
forall a b. (a -> b) -> a -> b
$ "" String -> ([KM], HumanCmd) -> String
forall v. Show v => String -> v -> String
`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
okm :: (forall a. (a, a) -> a)
-> K.KM -> K.KM -> [Text] -> [Text]
-> OKX
okm :: (forall a. (a, a) -> a) -> KM -> KM -> [Text] -> [Text] -> OKX
okm sel :: forall a. (a, a) -> a
sel key1 :: KM
key1 key2 :: KM
key2 header :: [Text]
header footer :: [Text]
footer =
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) -> Int -> [KYX]
f (ca1 :: CmdArea
ca1, Left km1 :: KM
km1, _) (ca2 :: CmdArea
ca2, Left km2 :: KM
km2, _) y :: Int
y =
Bool -> [KYX] -> [KYX]
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (CmdArea
ca1 CmdArea -> CmdArea -> Bool
forall a. Eq a => a -> a -> Bool
== CmdArea
ca2 Bool
-> ([(CmdArea, Either KM SlotChar, Text)],
[(CmdArea, Either KM SlotChar, Text)])
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` ([(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], (Int
y, Int
keyM Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3, Int
keyB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
keyM Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3))
, ([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
km2], (Int
y, Int
keyB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
keyM Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 5, 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
keyB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
keyM Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 5)) ]
f c :: (CmdArea, Either KM SlotChar, Text)
c d :: (CmdArea, Either KM SlotChar, Text)
d e :: Int
e = String -> [KYX]
forall a. (?callStack::CallStack) => String -> a
error (String -> [KYX]) -> String -> [KYX]
forall a b. (a -> b) -> a -> b
$ "" String
-> ((CmdArea, Either KM SlotChar, Text),
(CmdArea, Either KM SlotChar, Text), Int)
-> String
forall v. Show v => String -> v -> String
`showFailure` ((CmdArea, Either KM SlotChar, Text)
c, (CmdArea, Either KM SlotChar, Text)
d, Int
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) -> Int -> [KYX])
-> [(CmdArea, Either KM SlotChar, Text)]
-> [(CmdArea, Either KM SlotChar, Text)]
-> [Int]
-> [[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) -> Int -> [KYX]
f [(CmdArea, Either KM SlotChar, Text)]
kst1 [(CmdArea, Either KM SlotChar, Text)]
kst2 [Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Text] -> Int
forall a. [a] -> Int
length [Text]
header..]
render :: (CmdArea, Either KM SlotChar, Text)
-> (CmdArea, Either KM SlotChar, Text) -> Text
render (ca1 :: CmdArea
ca1, _, desc1 :: Text
desc1) (_, _, desc2 :: Text
desc2) =
Text -> Text -> Text -> Text
fmm (CmdArea -> Text
areaDescription CmdArea
ca1) Text
desc1 Text
desc2
menu :: [Text]
menu = ((CmdArea, Either KM SlotChar, Text)
-> (CmdArea, Either KM SlotChar, Text) -> Text)
-> [(CmdArea, Either KM SlotChar, Text)]
-> [(CmdArea, Either KM SlotChar, Text)]
-> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (CmdArea, Either KM SlotChar, Text)
-> (CmdArea, Either KM SlotChar, Text) -> Text
render [(CmdArea, Either KM SlotChar, Text)]
kst1 [(CmdArea, Either KM SlotChar, Text)]
kst2
in ((Text -> AttrLine) -> [Text] -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrLine
textToAL ([Text] -> Overlay) -> [Text] -> Overlay
forall a b. (a -> b) -> a -> b
$ "" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
header [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
menu [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
footer, [KYX]
kxs)
in [[(Text, OKX)]] -> [(Text, OKX)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ ( RuleContent -> Text
rtitle RuleContent
corule Text -> Text -> Text
<+> "- backstory"
, ((Text -> AttrLine) -> [Text] -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrLine
textToAL [Text]
introText, []) ) ]
, if CmdCategory -> Int
catLength CmdCategory
CmdMinimal
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Text] -> Int
forall a. [a] -> Int
length [Text]
movText Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Text] -> Int
forall a. [a] -> Int
length [Text]
minimalText Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Text] -> Int
forall a. [a] -> Int
length [Text]
casualEnd
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 5 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
rheight then
[ ( Text
casualDescription Text -> Text -> Text
<+> "(1/2)."
, ((Text -> AttrLine) -> [Text] -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map Text -> AttrLine
textToAL ([""] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
movText [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [""] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
movTextEnd), []) )
, ( Text
casualDescription Text -> Text -> Text
<+> "(2/2)."
, CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdMinimal ([Text]
minimalText [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
keyCaption]) [Text]
casualEnd ) ]
else
[ ( Text
casualDescription Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
, CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdMinimal
([Text]
movText [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [""] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
minimalText [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
keyCaption])
[Text]
casualEnd ) ]
, if CmdCategory -> Int
catLength CmdCategory
CmdItemMenu Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CmdCategory -> Int
catLength CmdCategory
CmdItem
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 9 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
rheight then
[ ( CmdCategory -> Text
categoryDescription CmdCategory
CmdItemMenu Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
, CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdItemMenu [Text
keyCaption] [Text]
itemMenuEnd )
, ( CmdCategory -> Text
categoryDescription CmdCategory
CmdItem Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
, CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdItem [Text
keyCaption] [Text]
itemRemainingEnd ) ]
else
[ ( CmdCategory -> Text
categoryDescription CmdCategory
CmdItemMenu Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
, OKX -> OKX -> OKX
mergeOKX
(CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdItemMenu [Text
keyCaption] [""])
(CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdItem
[CmdCategory -> Text
categoryDescription CmdCategory
CmdItem Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".", "", Text
keyCaption]
[Text]
itemAllEnd) ) ]
, if CmdCategory -> Int
catLength CmdCategory
CmdMove Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CmdCategory -> Int
catLength CmdCategory
CmdAim
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 9 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
rheight then
[ ( "All terrain exploration and alteration commands."
, CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdMove [Text
keyCaption] ([Text]
pickLeaderDescription [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
categoryEnd) )
, ( CmdCategory -> Text
categoryDescription CmdCategory
CmdAim Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
, CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdAim [Text
keyCaption] [Text]
categoryEnd ) ]
else
[ ( "All terrain exploration and alteration commands."
, OKX -> OKX -> OKX
mergeOKX
(CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdMove [Text
keyCaption] ([Text]
pickLeaderDescription [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [""]))
(CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdAim
[CmdCategory -> Text
categoryDescription CmdCategory
CmdAim Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".", "", Text
keyCaption]
[Text]
categoryEnd) ) ]
, if 45 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
rheight then
[ ( "Mouse overview."
, let (ls :: Overlay
ls, _) = CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdMouse
([Text]
mouseBasicsText [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
keyCaption])
[Text]
mouseBasicsEnd
in (Overlay
ls, []) )
, ( "Mouse in exploration and aiming modes."
, OKX -> OKX -> OKX
mergeOKX
((forall a. (a, a) -> a) -> KM -> KM -> [Text] -> [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] -> [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"] [Text]
categoryEnd) ) ]
else
[ ( "Mouse commands."
, let (ls :: Overlay
ls, _) = CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdMouse
([Text]
mouseBasicsText [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
keyCaption])
[]
okx0 :: OKX
okx0 = (Overlay
ls, [])
in OKX -> OKX -> OKX
mergeOKX
(OKX -> OKX -> OKX
mergeOKX
OKX
okx0
((forall a. (a, a) -> a) -> KM -> KM -> [Text] -> [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] -> [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"] [Text]
categoryEnd) ) ]
, [ ( CmdCategory -> Text
categoryDescription CmdCategory
CmdMeta Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
, CmdCategory -> [Text] -> [Text] -> OKX
okxs CmdCategory
CmdMeta [Text
keyCaption] [Text]
lastHelpEnd ) ]
]
okxsN :: InputContent -> Int -> Int -> (HumanCmd -> Bool) -> Bool -> CmdCategory
-> [Text] -> [Text] -> OKX
okxsN :: InputContent
-> Int
-> Int
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> [Text]
-> [Text]
-> OKX
okxsN InputContent{..} offset :: Int
offset n :: Int
n greyedOut :: HumanCmd -> Bool
greyedOut showManyKeys :: Bool
showManyKeys cat :: CmdCategory
cat header :: [Text]
header footer :: [Text]
footer =
let fmt :: Text -> Text -> Text
fmt k :: Text
k h :: Text
h = " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
T.justifyLeft Int
n ' ' Text
k Text -> Text -> Text
<+> Text
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 (String -> [KM]
forall a. (?callStack::CallStack) => String -> a
error (String -> [KM]) -> String -> [KM]
forall a b. (a -> b) -> a -> b
$ "" String -> HumanCmd -> String
forall v. Show v => String -> v -> String
`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 (String -> Text
T.pack (String -> Text) -> (KM -> String) -> KM -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KM -> String
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))]
keys :: [(Either [KM] SlotChar, (Bool, Text))]
keys = [ ([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM]
kmsRes, (HumanCmd -> Bool
greyedOut HumanCmd
cmd, Text -> Text -> Text
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 Int -> [KM] -> [KM]
forall a. Int -> [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]
f :: (a, (a, Text)) -> a -> (a, (a, b, Int))
f (ks :: a
ks, (_, tkey :: Text
tkey)) y :: a
y = (a
ks, (a
y, 1, Text -> Int
T.length Text
tkey))
kxs :: [KYX]
kxs = ((Either [KM] SlotChar, (Bool, Text)) -> Int -> KYX)
-> [(Either [KM] SlotChar, (Bool, Text))] -> [Int] -> [KYX]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Either [KM] SlotChar, (Bool, Text)) -> Int -> KYX
forall b a a a. Num b => (a, (a, Text)) -> a -> (a, (a, b, Int))
f [(Either [KM] SlotChar, (Bool, Text))]
keys [Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Text] -> Int
forall a. [a] -> Int
length [Text]
header..]
ts :: [(Bool, Text)]
ts = (Text -> (Bool, Text)) -> [Text] -> [(Bool, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
False,) ("" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
header) [(Bool, Text)] -> [(Bool, Text)] -> [(Bool, Text)]
forall a. [a] -> [a] -> [a]
++ ((Either [KM] SlotChar, (Bool, Text)) -> (Bool, Text))
-> [(Either [KM] SlotChar, (Bool, Text))] -> [(Bool, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Either [KM] SlotChar, (Bool, Text)) -> (Bool, Text)
forall a b. (a, b) -> b
snd [(Either [KM] SlotChar, (Bool, Text))]
keys [(Bool, Text)] -> [(Bool, Text)] -> [(Bool, Text)]
forall a. [a] -> [a] -> [a]
++ (Text -> (Bool, Text)) -> [Text] -> [(Bool, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
False,) [Text]
footer
greyToAL :: (Bool, Text) -> AttrLine
greyToAL (b :: Bool
b, t :: Text
t) = if Bool
b then Color -> Text -> AttrLine
textFgToAL Color
Color.BrBlack Text
t else Text -> AttrLine
textToAL Text
t
in (((Bool, Text) -> AttrLine) -> [(Bool, Text)] -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Text) -> AttrLine
greyToAL [(Bool, Text)]
ts, [KYX]
kxs)