Allure-0.4.2: src/Keybindings.hs

module Keybindings where

import qualified Data.Map as M
import qualified Data.List as L

import Utils.Assert
import Action
import Command
import Geometry
import qualified Keys as K

-- | Keybindings.
data Keybindings = Keybindings
  { kdir   :: DirCommand
  , kudir  :: DirCommand
  , kother :: M.Map K.Key Command
  }

handleKey :: X -> Keybindings -> K.Key -> Action ()
handleKey lxsize kb k =
  K.handleDirection lxsize k (caction $ kdir kb) $
    K.handleUDirection lxsize k (caction $ kudir kb) $
      case M.lookup k (kother kb) of
        Just c  -> caction c
        Nothing -> abortWith $ "unknown command (" ++ K.showKey k ++ ")"

keyHelp :: (K.Key -> [K.Key]) -> Keybindings -> String
keyHelp aliases kb =
  let
    fmt k h = replicate 15 ' ' ++ k ++ replicate ((13 - length k) `max` 1) ' '
                               ++ h ++ replicate ((35 - length h) `max` 1) ' '
    fmts s  = replicate 2  ' ' ++ s ++ replicate ((71 - length s) `max` 1) ' '
    blank   = fmt "" ""
    movKs   =
      [ ""
      , "You move throughout the level using the numerical keypad or"
      , "the vi text editor keys (also known as \"Rogue-like keys\")."
      , ""
      , "               7 8 9     y k u"
      , "                \\|/       \\|/"
      , "               4-5-6     h-.-l"
      , "                /|\\       /|\\"
      , "               1 2 3     b j n"
      , ""
      , "Shift and a movement key make the hero run in the indicated direction,"
      , "until anything of interest is spotted. '5' and '.' skip a turn."
      , ""
      , "To search, open or attack, bump into walls, doors or monsters."
      , ""
      , "For more playing instructions see file PLAYING.md."
      , ""
      , "Press space to see the next page."
      , ""
      , ""
      ]
    mov     = map fmts movKs
    keyC    = fmt "keys" "command"
--    footer  =
--      fmts "(To search, open or attack, bump into walls, doors or monsters.)"
    disp k  = L.concatMap show $ aliases k
    rest    = [ fmt (disp k) h
              | (k, Described h _) <- M.toAscList (kother kb) ]
  in
    unlines ([blank] ++ mov ++ [blank, keyC] ++ rest)
--             [blank, footer, blank])

-- | Maps a key to the canonical key for the command it denotes.
-- Takes into account the keypad and any macros from a config file.
-- Macros cannot depend on each other, but they can on canonMoveKey.
-- This has to be fully evaluated to catch errors in macro definitions early.
macroKey :: [(String, String)] -> M.Map K.Key K.Key
macroKey section =
  let trans k = case K.keyTranslate k of
                  K.Unknown s -> assert `failure` ("unknown macro key " ++ s)
                  kt -> kt
      trMacro (from, to) = let fromTr = trans from
                               !toTr  = K.canonMoveKey $ trans to
                           in  if fromTr == toTr
                               then assert `failure` ("degenerate alias", toTr)
                               else (fromTr, toTr)
  in  M.fromList $ L.map trMacro section