-- | Binding of keys to commands.
-- No operation in this module involves the 'State' or 'Action' type.
module Game.LambdaHack.Client.UI.KeyBindings
  ( Binding(..), stdBinding, keyHelp
  ) where

import Control.Arrow (second)
import qualified Data.Char as Char
import Data.List
import qualified Data.Map.Strict as M
import Data.Text (Text)
import qualified Data.Text as T
import Data.Tuple (swap)

import qualified Game.LambdaHack.Client.Key as K
import Game.LambdaHack.Client.UI.Config
import Game.LambdaHack.Client.UI.Content.KeyKind
import Game.LambdaHack.Client.UI.HumanCmd
import Game.LambdaHack.Common.Msg

-- | Bindings and other information about human player commands.
data Binding = Binding
  { bcmdMap  :: !(M.Map K.KM (Text, [CmdCategory], HumanCmd))
                                        -- ^ binding of keys to commands
  , bcmdList :: ![(K.KM, (Text, [CmdCategory], HumanCmd))]
                                        -- ^ the properly ordered list
                                        --   of commands for the help menu
  , brevMap  :: !(M.Map HumanCmd K.KM)  -- ^ and from commands to their keys
  }

-- | Binding of keys to movement and other standard commands,
-- as well as commands defined in the config file.
stdBinding :: KeyKind  -- ^ default key bindings from the content
           -> Config   -- ^ game config
           -> Binding  -- ^ concrete binding
stdBinding copsClient !Config{configCommands, configVi, configLaptop} =
  let heroSelect k = ( K.toKM K.NoModifier (K.Char (Char.intToDigit k))
                     , ([CmdMeta], PickLeader k) )
      cmdWithHelp = rhumanCommands copsClient ++ configCommands
      cmdAll =
        cmdWithHelp
        ++ [ (K.mkKM "KP_Begin", ([CmdMove], Wait))
           , (K.mkKM "CTRL-KP_Begin", ([CmdMove], Macro "" ["KP_Begin"]))
           , (K.mkKM "KP_5", ([CmdMove], Macro "" ["KP_Begin"]))
           , (K.mkKM "CTRL-KP_5", ([CmdMove], Macro "" ["KP_Begin"])) ]
        ++ (if configVi
            then [ (K.mkKM "period", ([CmdMove], Macro "" ["KP_Begin"])) ]
            else if configLaptop
            then [ (K.mkKM "i", ([CmdMove], Macro "" ["KP_Begin"]))
                 , (K.mkKM "I", ([CmdMove], Macro "" ["KP_Begin"])) ]
            else [])
        ++ K.moveBinding configVi configLaptop (\v -> ([CmdMove], Move v))
                                               (\v -> ([CmdMove], Run v))
        ++ fmap heroSelect [0..6]
      mkDescribed (cats, cmd) = (cmdDescription cmd, cats, cmd)
  in Binding
  { bcmdMap = M.fromList $ map (second mkDescribed) cmdAll
  , bcmdList = map (second mkDescribed) cmdWithHelp
  , brevMap = M.fromList $ map (swap . second snd) cmdAll
  }

-- | Produce a set of help screens from the key bindings.
keyHelp :: Binding -> Slideshow
keyHelp Binding{bcmdList} =
  let
    movBlurb =
      [ "Walk throughout a level with mouse or numeric keypad (left diagram)"
      , "or its compact laptop replacement (middle) or the Vi text editor keys"
      , "(right, also known as \"Rogue-like keys\"; can be enabled in config.ui.ini)."
      , "Run, until disturbed, with left mouse button or SHIFT (or CTRL) and a key."
      , ""
      , "               7 8 9          7 8 9          y k u"
      , "                \\|/            \\|/            \\|/"
      , "               4-5-6          u-i-o          h-.-l"
      , "                /|\\            /|\\            /|\\"
      , "               1 2 3          j k l          b j n"
      , ""
      , "In aiming mode (KEYPAD_* or \\) the same keys (or mouse) move the crosshair."
      , "Press 'KEYPAD_5' (or 'i' or '.') to wait, bracing for blows, which reduces"
      , "any damage taken and makes it impossible for foes to displace you."
      , "You displace enemies or friends by bumping into them with SHIFT (or CTRL)."
      , ""
      , "Search, loot, open and attack by bumping into walls, doors and enemies."
      , "The best item to attack with is automatically chosen from among"
      , "weapons in your personal equipment and your unwounded organs."
      , ""
      , "Press SPACE to see the minimal command set."
      ]
    minimalBlurb =
      [ "The following minimal command set lets you accomplish anything in the game,"
      , "though not necessarily with the fewest number of keystrokes."
      , "Most of the other commands are shorthands, defined as macros"
      , "(with the exception of the advanced commands for assigning non-default"
      , "tactics and targets to your autonomous henchmen, if you have any)."
      , ""
      ]
    casualEndBlurb =
      [ ""
      , "Press SPACE to see the detailed descriptions of all commands."
      ]
    categoryBlurb =
      [ ""
      , "Press SPACE to see the next page of command descriptions."
      ]
    lastBlurb =
      [ ""
      , "For more playing instructions see file PLAYING.md."
      , "Press PGUP to return to previous pages or ESC to see the map again."
      ]
    pickLeaderDescription =
      [ fmt 16 "0, 1 ... 6" "pick a particular actor as the new leader"
      ]
    casualDescription = "Minimal cheat sheet for casual play"
    fmt n k h = T.justifyRight 72 ' '
                $ T.justifyLeft n ' ' k
                  <> T.justifyLeft 48 ' ' h
    fmts s = " " <> T.justifyLeft 71 ' ' s
    movText = map fmts movBlurb
    minimalText = map fmts minimalBlurb
    casualEndText = map fmts casualEndBlurb
    categoryText = map fmts categoryBlurb
    lastText = map fmts lastBlurb
    coImage :: K.KM -> [K.KM]
    coImage k = k : sort [ from
                         | (from, (_, cats, Macro _ [to])) <- bcmdList
                         , K.mkKM to == k
                         , any (`notElem` [CmdDebug, CmdInternal]) cats ]
    disp k = T.concat $ intersperse " or " $ map K.showKM $ coImage k
    keysN n cat = [ fmt n (disp k) h
                  | (k, (h, cats, _)) <- bcmdList, cat `elem` cats, h /= "" ]
    -- TODO: measure the longest key sequence and set the caption automatically
    keyCaptionN n = fmt n "keys" "command"
    keys = keysN 16
    keyCaption = keyCaptionN 16
  in toSlideshow (Just True)
    [ [casualDescription <+> "(1/2). [press SPACE to see more]"] ++ [""]
      ++ movText ++ [moreMsg]
    , [casualDescription <+> "(2/2). [press SPACE to see all commands]"] ++ [""]
      ++ minimalText
      ++ [keyCaption] ++ keys CmdMinimal ++ casualEndText ++ [moreMsg]
    , ["All terrain exploration and alteration commands"
       <> ". [press SPACE to advance]"] ++ [""]
      ++ [keyCaptionN 10] ++ keysN 10 CmdMove ++ categoryText ++ [moreMsg]
    , [categoryDescription CmdItem <> ". [press SPACE to advance]"] ++ [""]
      ++ [keyCaptionN 10] ++ keysN 10 CmdItem ++ categoryText ++ [moreMsg]
    , [categoryDescription CmdTgt <> ". [press SPACE to advance]"] ++ [""]
      ++ [keyCaption] ++ keys CmdTgt ++ categoryText ++ [moreMsg]
    , [categoryDescription CmdAuto <> ". [press SPACE to advance]"] ++ [""]
      ++ [keyCaption] ++ keys CmdAuto ++ categoryText ++ [moreMsg]
    , [categoryDescription CmdMeta <> ". [press SPACE to advance]"] ++ [""]
      ++ [keyCaption] ++ keys CmdMeta ++ pickLeaderDescription
      ++ categoryText ++ [moreMsg]
    , [categoryDescription CmdMouse
       <> ". [press PGUP to see previous, ESC to cancel]"] ++ [""]
      ++ [keyCaptionN 21] ++ keysN 21 CmdMouse ++ lastText ++ [endMsg]
    ]