{-# LANGUAGE RankNTypes, TupleSections #-}
-- | 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.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

-- | 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 :: 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, []) )  -- don't capture mouse wheel, etc.
        , ( "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, [])  -- don't capture mouse wheel, etc.
            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 ) ]
    ]

-- | Turn the specified portion of bindings into a menu.
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)