{-# LANGUAGE DeriveGeneric #-}
-- | Frontend-independent keyboard input operations.
module Game.LambdaHack.Client.UI.Key
  ( Key(..), Modifier(..), KM(..), KMP(..)
  , showKey, showKM
  , escKM, controlEscKM, spaceKM, safeSpaceKM, undefinedKM, returnKM
  , pgupKM, pgdnKM, wheelNorthKM, wheelSouthKM
  , upKM, downKM, leftKM, rightKM
  , homeKM, endKM, backspaceKM, controlP
  , leftButtonReleaseKM, middleButtonReleaseKM, rightButtonReleaseKM
  , dirAllKey, handleDir, moveBinding, mkKM, mkChar
  , keyTranslate, keyTranslateWeb
  , dirMoveNoModifier, dirRunNoModifier, dirRunControl, dirRunShift
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , dirKeypadKey, dirKeypadShiftChar, dirKeypadShiftKey
  , dirLeftHandKey, dirLeftHandShiftKey
  , dirViChar, dirViKey, dirViShiftKey
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude hiding (Left, Right)

import           Control.DeepSeq
import           Data.Binary
import qualified Data.Char as Char
import           GHC.Generics (Generic)

import Game.LambdaHack.Client.UI.PointUI
import Game.LambdaHack.Common.Vector

-- | Frontend-independent datatype to represent keys.
data Key =
    Esc
  | Return
  | Space
  | Tab
  | BackTab
  | BackSpace
  | PgUp
  | PgDn
  | Left
  | Right
  | Up
  | Down
  | End
  | Begin
  | Insert
  | Delete
  | PrintScreen
  | Home
  | KP Char      -- ^ a keypad key for a character (digits and operators)
  | Char Char    -- ^ a single printable character
  | Fun Int      -- ^ function key
  | LeftButtonPress    -- ^ left mouse button pressed
  | MiddleButtonPress  -- ^ middle mouse button pressed
  | RightButtonPress   -- ^ right mouse button pressed
  | LeftButtonRelease    -- ^ left mouse button released
  | MiddleButtonRelease  -- ^ middle mouse button released
  | RightButtonRelease   -- ^ right mouse button released
  | WheelNorth  -- ^ mouse wheel rotated north
  | WheelSouth  -- ^ mouse wheel rotated south
  | Unknown String -- ^ an unknown key, registered to warn the user
  | DeadKey
  deriving (Eq Key
Eq Key =>
(Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, (forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Key x -> Key
$cfrom :: forall x. Key -> Rep Key x
Generic)

instance Binary Key

instance NFData Key

-- | Our own encoding of modifiers.
data Modifier =
    NoModifier
  | ControlShift
  | AltShift
  | Shift
  | Control
  | Alt
  deriving (Int -> Modifier -> ShowS
[Modifier] -> ShowS
Modifier -> String
(Int -> Modifier -> ShowS)
-> (Modifier -> String) -> ([Modifier] -> ShowS) -> Show Modifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modifier] -> ShowS
$cshowList :: [Modifier] -> ShowS
show :: Modifier -> String
$cshow :: Modifier -> String
showsPrec :: Int -> Modifier -> ShowS
$cshowsPrec :: Int -> Modifier -> ShowS
Show, Eq Modifier
Eq Modifier =>
(Modifier -> Modifier -> Ordering)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Modifier)
-> (Modifier -> Modifier -> Modifier)
-> Ord Modifier
Modifier -> Modifier -> Bool
Modifier -> Modifier -> Ordering
Modifier -> Modifier -> Modifier
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Modifier -> Modifier -> Modifier
$cmin :: Modifier -> Modifier -> Modifier
max :: Modifier -> Modifier -> Modifier
$cmax :: Modifier -> Modifier -> Modifier
>= :: Modifier -> Modifier -> Bool
$c>= :: Modifier -> Modifier -> Bool
> :: Modifier -> Modifier -> Bool
$c> :: Modifier -> Modifier -> Bool
<= :: Modifier -> Modifier -> Bool
$c<= :: Modifier -> Modifier -> Bool
< :: Modifier -> Modifier -> Bool
$c< :: Modifier -> Modifier -> Bool
compare :: Modifier -> Modifier -> Ordering
$ccompare :: Modifier -> Modifier -> Ordering
$cp1Ord :: Eq Modifier
Ord, Modifier -> Modifier -> Bool
(Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool) -> Eq Modifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Modifier -> Modifier -> Bool
$c/= :: Modifier -> Modifier -> Bool
== :: Modifier -> Modifier -> Bool
$c== :: Modifier -> Modifier -> Bool
Eq, (forall x. Modifier -> Rep Modifier x)
-> (forall x. Rep Modifier x -> Modifier) -> Generic Modifier
forall x. Rep Modifier x -> Modifier
forall x. Modifier -> Rep Modifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Modifier x -> Modifier
$cfrom :: forall x. Modifier -> Rep Modifier x
Generic)

instance Binary Modifier

instance NFData Modifier

-- | Key and modifier.
data KM = KM { KM -> Modifier
modifier :: Modifier
             , KM -> Key
key      :: Key }
  deriving (Eq KM
Eq KM =>
(KM -> KM -> Ordering)
-> (KM -> KM -> Bool)
-> (KM -> KM -> Bool)
-> (KM -> KM -> Bool)
-> (KM -> KM -> Bool)
-> (KM -> KM -> KM)
-> (KM -> KM -> KM)
-> Ord KM
KM -> KM -> Bool
KM -> KM -> Ordering
KM -> KM -> KM
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KM -> KM -> KM
$cmin :: KM -> KM -> KM
max :: KM -> KM -> KM
$cmax :: KM -> KM -> KM
>= :: KM -> KM -> Bool
$c>= :: KM -> KM -> Bool
> :: KM -> KM -> Bool
$c> :: KM -> KM -> Bool
<= :: KM -> KM -> Bool
$c<= :: KM -> KM -> Bool
< :: KM -> KM -> Bool
$c< :: KM -> KM -> Bool
compare :: KM -> KM -> Ordering
$ccompare :: KM -> KM -> Ordering
$cp1Ord :: Eq KM
Ord, KM -> KM -> Bool
(KM -> KM -> Bool) -> (KM -> KM -> Bool) -> Eq KM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KM -> KM -> Bool
$c/= :: KM -> KM -> Bool
== :: KM -> KM -> Bool
$c== :: KM -> KM -> Bool
Eq, (forall x. KM -> Rep KM x)
-> (forall x. Rep KM x -> KM) -> Generic KM
forall x. Rep KM x -> KM
forall x. KM -> Rep KM x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KM x -> KM
$cfrom :: forall x. KM -> Rep KM x
Generic)

instance Binary KM

instance NFData KM

instance Show KM where
  show :: KM -> String
show = KM -> String
showKM

-- | Key, modifier and position of mouse pointer.
data KMP = KMP { KMP -> KM
kmpKeyMod  :: KM
               , KMP -> PointUI
kmpPointer :: PointUI }

-- | Common and terse names for keys.
showKey :: Key -> String
showKey :: Key -> String
showKey Esc      = "ESC"
showKey Return   = "RET"
showKey Space    = "SPACE"
showKey Tab      = "TAB"
showKey BackTab  = "S-TAB"
showKey BackSpace = "BACKSPACE"
showKey Up       = "UP"
showKey Down     = "DOWN"
showKey Left     = "LEFT"
showKey Right    = "RIGHT"
showKey Home     = "HOME"
showKey End      = "END"
showKey PgUp     = "PGUP"
showKey PgDn     = "PGDN"
showKey Begin    = "BEGIN"
showKey Insert   = "INS"
showKey Delete   = "DEL"
showKey PrintScreen = "PRTSCR"
showKey (KP c :: Char
c)   = "KP_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c]
showKey (Char c :: Char
c) = [Char
c]
showKey (Fun n :: Int
n) = "F" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
showKey LeftButtonPress = "LMB-PRESS"
showKey MiddleButtonPress = "MMB-PRESS"
showKey RightButtonPress = "RMB-PRESS"
showKey LeftButtonRelease = "LMB"
showKey MiddleButtonRelease = "MMB"
showKey RightButtonRelease = "RMB"
showKey WheelNorth = "WHEEL-UP"
showKey WheelSouth = "WHEEL-DN"
showKey (Unknown s :: String
s) = "'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'"
showKey DeadKey      = "DEADKEY"

-- | Show a key with a modifier, if any.
showKM :: KM -> String
showKM :: KM -> String
showKM KM{modifier :: KM -> Modifier
modifier=Modifier
NoModifier, Key
key :: Key
key :: KM -> Key
key} = Key -> String
showKey Key
key
showKM KM{modifier :: KM -> Modifier
modifier=Modifier
ControlShift, Key
key :: Key
key :: KM -> Key
key} = "C-S-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
showKey Key
key
showKM KM{modifier :: KM -> Modifier
modifier=Modifier
AltShift, Key
key :: Key
key :: KM -> Key
key} = "A-S-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
showKey Key
key
showKM KM{modifier :: KM -> Modifier
modifier=Modifier
Shift, Key
key :: Key
key :: KM -> Key
key} = "S-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
showKey Key
key
showKM KM{modifier :: KM -> Modifier
modifier=Modifier
Control, Key
key :: Key
key :: KM -> Key
key} = "C-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
showKey Key
key
showKM KM{modifier :: KM -> Modifier
modifier=Modifier
Alt, Key
key :: Key
key :: KM -> Key
key} = "A-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
showKey Key
key

escKM :: KM
escKM :: KM
escKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
Esc

controlEscKM :: KM
controlEscKM :: KM
controlEscKM = Modifier -> Key -> KM
KM Modifier
Control Key
Esc

spaceKM :: KM
spaceKM :: KM
spaceKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
Space

safeSpaceKM :: KM
safeSpaceKM :: KM
safeSpaceKM = Modifier -> Key -> KM
KM Modifier
NoModifier (Key -> KM) -> Key -> KM
forall a b. (a -> b) -> a -> b
$ String -> Key
Unknown "SAFE_SPACE"

undefinedKM :: KM
undefinedKM :: KM
undefinedKM = Modifier -> Key -> KM
KM Modifier
NoModifier (Key -> KM) -> Key -> KM
forall a b. (a -> b) -> a -> b
$ String -> Key
Unknown "UNDEFINED KEY"

returnKM :: KM
returnKM :: KM
returnKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
Return

pgupKM :: KM
pgupKM :: KM
pgupKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
PgUp

pgdnKM :: KM
pgdnKM :: KM
pgdnKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
PgDn

wheelNorthKM :: KM
wheelNorthKM :: KM
wheelNorthKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
WheelNorth

wheelSouthKM :: KM
wheelSouthKM :: KM
wheelSouthKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
WheelSouth

upKM :: KM
upKM :: KM
upKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
Up

downKM :: KM
downKM :: KM
downKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
Down

leftKM :: KM
leftKM :: KM
leftKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
Left

rightKM :: KM
rightKM :: KM
rightKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
Right

homeKM :: KM
homeKM :: KM
homeKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
Home

endKM :: KM
endKM :: KM
endKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
End

backspaceKM :: KM
backspaceKM :: KM
backspaceKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
BackSpace

controlP :: KM
controlP :: KM
controlP = Modifier -> Key -> KM
KM Modifier
Control (Char -> Key
Char 'P')

leftButtonReleaseKM :: KM
leftButtonReleaseKM :: KM
leftButtonReleaseKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
LeftButtonRelease

middleButtonReleaseKM :: KM
middleButtonReleaseKM :: KM
middleButtonReleaseKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
MiddleButtonRelease

rightButtonReleaseKM :: KM
rightButtonReleaseKM :: KM
rightButtonReleaseKM = Modifier -> Key -> KM
KM Modifier
NoModifier Key
RightButtonRelease

dirKeypadKey :: [Key]
dirKeypadKey :: [Key]
dirKeypadKey = [Key
Home, Key
Up, Key
PgUp, Key
Right, Key
PgDn, Key
Down, Key
End, Key
Left]

dirKeypadShiftChar :: [Char]
dirKeypadShiftChar :: String
dirKeypadShiftChar = ['7', '8', '9', '6', '3', '2', '1', '4']

dirKeypadShiftKey :: [Key]
dirKeypadShiftKey :: [Key]
dirKeypadShiftKey = (Char -> Key) -> String -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Key
KP String
dirKeypadShiftChar

dirLeftHandKey :: [Key]
dirLeftHandKey :: [Key]
dirLeftHandKey = (Char -> Key) -> String -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Key
Char ['q', 'w', 'e', 'd', 'c', 'x', 'z', 'a']

dirLeftHandShiftKey :: [Key]
dirLeftHandShiftKey :: [Key]
dirLeftHandShiftKey = (Char -> Key) -> String -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Key
Char ['Q', 'W', 'E', 'D', 'C', 'X', 'Z', 'A']

dirViChar :: [Char]
dirViChar :: String
dirViChar = ['y', 'k', 'u', 'l', 'n', 'j', 'b', 'h']

dirViKey :: [Key]
dirViKey :: [Key]
dirViKey = (Char -> Key) -> String -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Key
Char String
dirViChar

dirViShiftKey :: [Key]
dirViShiftKey :: [Key]
dirViShiftKey = (Char -> Key) -> String -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Key
Char (Char -> Key) -> (Char -> Char) -> Char -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
Char.toUpper) String
dirViChar

dirMoveNoModifier :: Bool -> Bool -> [Key]
dirMoveNoModifier :: Bool -> Bool -> [Key]
dirMoveNoModifier uVi :: Bool
uVi uLeftHand :: Bool
uLeftHand =
  [Key]
dirKeypadKey [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ (if Bool
uVi then [Key]
dirViKey else [])
               [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ (if Bool
uLeftHand then [Key]
dirLeftHandKey else [])

dirRunNoModifier :: Bool -> Bool -> [Key]
dirRunNoModifier :: Bool -> Bool -> [Key]
dirRunNoModifier uVi :: Bool
uVi uLeftHand :: Bool
uLeftHand =
  [Key]
dirKeypadShiftKey [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ (if Bool
uVi then [Key]
dirViShiftKey else [])
                    [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ (if Bool
uLeftHand then [Key]
dirLeftHandShiftKey else [])

dirRunControl :: [Key]
dirRunControl :: [Key]
dirRunControl = [Key]
dirKeypadKey
                [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ [Key]
dirKeypadShiftKey
                [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ (Char -> Key) -> String -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Key
Char String
dirKeypadShiftChar

dirRunShift :: [Key]
dirRunShift :: [Key]
dirRunShift = [Key]
dirRunControl

dirAllKey :: Bool -> Bool -> [Key]
dirAllKey :: Bool -> Bool -> [Key]
dirAllKey uVi :: Bool
uVi uLeftHand :: Bool
uLeftHand =
  Bool -> Bool -> [Key]
dirMoveNoModifier Bool
uVi Bool
uLeftHand
  [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ Bool -> Bool -> [Key]
dirRunNoModifier Bool
uVi Bool
uLeftHand
  [Key] -> [Key] -> [Key]
forall a. [a] -> [a] -> [a]
++ [Key]
dirRunControl

-- | Configurable event handler for the direction keys.
-- Used for directed commands such as close door.
handleDir :: [Key] -> KM -> Maybe Vector
handleDir :: [Key] -> KM -> Maybe Vector
handleDir dirKeys :: [Key]
dirKeys KM{modifier :: KM -> Modifier
modifier=Modifier
NoModifier, Key
key :: Key
key :: KM -> Key
key} =
  let assocs :: [(Key, Vector)]
assocs = [Key] -> [Vector] -> [(Key, Vector)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key]
dirKeys ([Vector] -> [(Key, Vector)]) -> [Vector] -> [(Key, Vector)]
forall a b. (a -> b) -> a -> b
$ [Vector] -> [Vector]
forall a. [a] -> [a]
cycle [Vector]
moves
  in Key -> [(Key, Vector)] -> Maybe Vector
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Key
key [(Key, Vector)]
assocs
handleDir _ _ = Maybe Vector
forall a. Maybe a
Nothing

-- | Binding of both sets of movement keys, vi and laptop.
moveBinding :: Bool -> Bool -> (Vector -> a) -> (Vector -> a)
            -> [(KM, a)]
moveBinding :: Bool -> Bool -> (Vector -> a) -> (Vector -> a) -> [(KM, a)]
moveBinding uVi :: Bool
uVi uLeftHand :: Bool
uLeftHand move :: Vector -> a
move run :: Vector -> a
run =
  let assign :: (t -> b) -> (a, t) -> (a, b)
assign f :: t -> b
f (km :: a
km, dir :: t
dir) = (a
km, t -> b
f t
dir)
      mapMove :: Modifier -> [Key] -> [(KM, a)]
mapMove modifier :: Modifier
modifier keys :: [Key]
keys =
        ((KM, Vector) -> (KM, a)) -> [(KM, Vector)] -> [(KM, a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Vector -> a) -> (KM, Vector) -> (KM, a)
forall t b a. (t -> b) -> (a, t) -> (a, b)
assign Vector -> a
move) ([KM] -> [Vector] -> [(KM, Vector)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Key -> KM) -> [Key] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (Modifier -> Key -> KM
KM Modifier
modifier) [Key]
keys) ([Vector] -> [(KM, Vector)]) -> [Vector] -> [(KM, Vector)]
forall a b. (a -> b) -> a -> b
$ [Vector] -> [Vector]
forall a. [a] -> [a]
cycle [Vector]
moves)
      mapRun :: Modifier -> [Key] -> [(KM, a)]
mapRun modifier :: Modifier
modifier keys :: [Key]
keys =
        ((KM, Vector) -> (KM, a)) -> [(KM, Vector)] -> [(KM, a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Vector -> a) -> (KM, Vector) -> (KM, a)
forall t b a. (t -> b) -> (a, t) -> (a, b)
assign Vector -> a
run) ([KM] -> [Vector] -> [(KM, Vector)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Key -> KM) -> [Key] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (Modifier -> Key -> KM
KM Modifier
modifier) [Key]
keys) ([Vector] -> [(KM, Vector)]) -> [Vector] -> [(KM, Vector)]
forall a b. (a -> b) -> a -> b
$ [Vector] -> [Vector]
forall a. [a] -> [a]
cycle [Vector]
moves)
  in Modifier -> [Key] -> [(KM, a)]
mapMove Modifier
NoModifier (Bool -> Bool -> [Key]
dirMoveNoModifier Bool
uVi Bool
uLeftHand)
     [(KM, a)] -> [(KM, a)] -> [(KM, a)]
forall a. [a] -> [a] -> [a]
++ Modifier -> [Key] -> [(KM, a)]
mapRun Modifier
NoModifier (Bool -> Bool -> [Key]
dirRunNoModifier Bool
uVi Bool
uLeftHand)
     [(KM, a)] -> [(KM, a)] -> [(KM, a)]
forall a. [a] -> [a] -> [a]
++ Modifier -> [Key] -> [(KM, a)]
mapRun Modifier
Control [Key]
dirRunControl
     [(KM, a)] -> [(KM, a)] -> [(KM, a)]
forall a. [a] -> [a] -> [a]
++ Modifier -> [Key] -> [(KM, a)]
mapRun Modifier
Shift [Key]
dirRunShift

mkKM :: String -> KM
mkKM :: String -> KM
mkKM s :: String
s = let mkKey :: String -> Key
mkKey sk :: String
sk =
               case String -> Key
keyTranslate String
sk of
                 Unknown _ -> String -> Key
forall a. HasCallStack => String -> a
error (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ "unknown key" String -> ShowS
forall v. Show v => String -> v -> String
`showFailure` String
s
                 key :: Key
key -> Key
key
         in case String
s of
           'C':'-':'S':'-':rest :: String
rest -> Modifier -> Key -> KM
KM Modifier
ControlShift (String -> Key
mkKey String
rest)
           'S':'-':'C':'-':rest :: String
rest -> Modifier -> Key -> KM
KM Modifier
ControlShift (String -> Key
mkKey String
rest)
           'A':'-':'S':'-':rest :: String
rest -> Modifier -> Key -> KM
KM Modifier
AltShift (String -> Key
mkKey String
rest)
           'S':'-':'A':'-':rest :: String
rest -> Modifier -> Key -> KM
KM Modifier
AltShift (String -> Key
mkKey String
rest)
           'S':'-':rest :: String
rest -> Modifier -> Key -> KM
KM Modifier
Shift (String -> Key
mkKey String
rest)
           'C':'-':rest :: String
rest -> Modifier -> Key -> KM
KM Modifier
Control (String -> Key
mkKey String
rest)
           'A':'-':rest :: String
rest -> Modifier -> Key -> KM
KM Modifier
Alt (String -> Key
mkKey String
rest)
           _ -> Modifier -> Key -> KM
KM Modifier
NoModifier (String -> Key
mkKey String
s)

mkChar :: Char -> KM
mkChar :: Char -> KM
mkChar c :: Char
c = Modifier -> Key -> KM
KM Modifier
NoModifier (Key -> KM) -> Key -> KM
forall a b. (a -> b) -> a -> b
$ Char -> Key
Char Char
c

-- | Translate key from a GTK string description to our internal key type.
-- To be used, in particular, for the command bindings and macros
-- in the config file.
--
-- See <https://github.com/twobob/gtk-/blob/master/gdk/keynames.txt>
keyTranslate :: String -> Key
keyTranslate :: String -> Key
keyTranslate "less"          = Char -> Key
Char '<'
keyTranslate "greater"       = Char -> Key
Char '>'
keyTranslate "period"        = Char -> Key
Char '.'
keyTranslate "colon"         = Char -> Key
Char ':'
keyTranslate "semicolon"     = Char -> Key
Char ';'
keyTranslate "comma"         = Char -> Key
Char ','
keyTranslate "question"      = Char -> Key
Char '?'
keyTranslate "numbersign"    = Char -> Key
Char '#'
keyTranslate "dollar"        = Char -> Key
Char '$'
keyTranslate "parenleft"     = Char -> Key
Char '('
keyTranslate "parenright"    = Char -> Key
Char ')'
keyTranslate "asterisk"      = Char -> Key
Char '*'  -- KP and normal are merged here
keyTranslate "KP_Multiply"   = Char -> Key
Char '*'
keyTranslate "slash"         = Char -> Key
Char '/'
keyTranslate "KP_Divide"     = Char -> Key
Char '/'
keyTranslate "bar"           = Char -> Key
Char '|'
keyTranslate "backslash"     = Char -> Key
Char '\\'
keyTranslate "asciicircum"   = Char -> Key
Char '^'
keyTranslate "underscore"    = Char -> Key
Char '_'
keyTranslate "minus"         = Char -> Key
Char '-'
keyTranslate "KP_Subtract"   = Char -> Key
Char '-'  -- KP and normal are merged here
keyTranslate "plus"          = Char -> Key
Char '+'
keyTranslate "KP_Add"        = Char -> Key
Char '+'  -- KP and normal are merged here
keyTranslate "equal"         = Char -> Key
Char '='
keyTranslate "bracketleft"   = Char -> Key
Char '['
keyTranslate "bracketright"  = Char -> Key
Char ']'
keyTranslate "braceleft"     = Char -> Key
Char '{'
keyTranslate "braceright"    = Char -> Key
Char '}'
keyTranslate "caret"         = Char -> Key
Char '^'
keyTranslate "ampersand"     = Char -> Key
Char '&'
keyTranslate "at"            = Char -> Key
Char '@'
keyTranslate "asciitilde"    = Char -> Key
Char '~'
keyTranslate "grave"         = Char -> Key
Char '`'
keyTranslate "exclam"        = Char -> Key
Char '!'
keyTranslate "apostrophe"    = Char -> Key
Char '\''
keyTranslate "quotedbl"      = Char -> Key
Char '"'
keyTranslate "Escape"        = Key
Esc
keyTranslate "ESC"           = Key
Esc
keyTranslate "Return"        = Key
Return
keyTranslate "RET"           = Key
Return
keyTranslate "space"         = Key
Space
keyTranslate "SPACE"         = Key
Space
keyTranslate "Tab"           = Key
Tab
keyTranslate "TAB"           = Key
Tab
keyTranslate "BackTab"       = Key
BackTab
keyTranslate "ISO_Left_Tab"  = Key
BackTab
keyTranslate "BackSpace"     = Key
BackSpace
keyTranslate "BACKSPACE"     = Key
BackSpace
keyTranslate "Up"            = Key
Up
keyTranslate "UP"            = Key
Up
keyTranslate "KP_Up"         = Key
Up
keyTranslate "Down"          = Key
Down
keyTranslate "DOWN"          = Key
Down
keyTranslate "KP_Down"       = Key
Down
keyTranslate "Left"          = Key
Left
keyTranslate "LEFT"          = Key
Left
keyTranslate "KP_Left"       = Key
Left
keyTranslate "Right"         = Key
Right
keyTranslate "RIGHT"         = Key
Right
keyTranslate "KP_Right"      = Key
Right
keyTranslate "Home"          = Key
Home
keyTranslate "HOME"          = Key
Home
keyTranslate "KP_Home"       = Key
Home
keyTranslate "End"           = Key
End
keyTranslate "END"           = Key
End
keyTranslate "KP_End"        = Key
End
keyTranslate "Page_Up"       = Key
PgUp
keyTranslate "PGUP"          = Key
PgUp
keyTranslate "KP_Page_Up"    = Key
PgUp
keyTranslate "Prior"         = Key
PgUp
keyTranslate "KP_Prior"      = Key
PgUp
keyTranslate "Page_Down"     = Key
PgDn
keyTranslate "PGDN"          = Key
PgDn
keyTranslate "KP_Page_Down"  = Key
PgDn
keyTranslate "Next"          = Key
PgDn
keyTranslate "KP_Next"       = Key
PgDn
keyTranslate "Begin"         = Key
Begin
keyTranslate "BEGIN"         = Key
Begin
keyTranslate "KP_Begin"      = Key
Begin
keyTranslate "Clear"         = Key
Begin
keyTranslate "KP_Clear"      = Key
Begin
keyTranslate "Center"        = Key
Begin
keyTranslate "KP_Center"     = Key
Begin
keyTranslate "Insert"        = Key
Insert
keyTranslate "INS"           = Key
Insert
keyTranslate "KP_Insert"     = Key
Insert
keyTranslate "Delete"        = Key
Delete
keyTranslate "DEL"           = Key
Delete
keyTranslate "KP_Delete"     = Key
Delete
keyTranslate "KP_Enter"      = Key
Return
keyTranslate "F1"            = Int -> Key
Fun 1
keyTranslate "F2"            = Int -> Key
Fun 2
keyTranslate "F3"            = Int -> Key
Fun 3
keyTranslate "F4"            = Int -> Key
Fun 4
keyTranslate "F5"            = Int -> Key
Fun 5
keyTranslate "F6"            = Int -> Key
Fun 6
keyTranslate "F7"            = Int -> Key
Fun 7
keyTranslate "F8"            = Int -> Key
Fun 8
keyTranslate "F9"            = Int -> Key
Fun 9
keyTranslate "F10"           = Int -> Key
Fun 10
keyTranslate "F11"           = Int -> Key
Fun 11
keyTranslate "F12"           = Int -> Key
Fun 12
keyTranslate "LeftButtonPress" = Key
LeftButtonPress
keyTranslate "LMB-PRESS" = Key
LeftButtonPress
keyTranslate "MiddleButtonPress" = Key
MiddleButtonPress
keyTranslate "MMB-PRESS" = Key
MiddleButtonPress
keyTranslate "RightButtonPress" = Key
RightButtonPress
keyTranslate "RMB-PRESS" = Key
RightButtonPress
keyTranslate "LeftButtonRelease" = Key
LeftButtonRelease
keyTranslate "LMB" = Key
LeftButtonRelease
keyTranslate "MiddleButtonRelease" = Key
MiddleButtonRelease
keyTranslate "MMB" = Key
MiddleButtonRelease
keyTranslate "RightButtonRelease" = Key
RightButtonRelease
keyTranslate "RMB" = Key
RightButtonRelease
keyTranslate "WheelNorth"    = Key
WheelNorth
keyTranslate "WHEEL-UP"      = Key
WheelNorth
keyTranslate "WheelSouth"    = Key
WheelSouth
keyTranslate "WHEEL-DN"      = Key
WheelSouth
-- dead keys
keyTranslate "Shift_L"          = Key
DeadKey
keyTranslate "Shift_R"          = Key
DeadKey
keyTranslate "Control_L"        = Key
DeadKey
keyTranslate "Control_R"        = Key
DeadKey
keyTranslate "Super_L"          = Key
DeadKey
keyTranslate "Super_R"          = Key
DeadKey
keyTranslate "Menu"             = Key
DeadKey
keyTranslate "Alt_L"            = Key
DeadKey
keyTranslate "Alt_R"            = Key
DeadKey
keyTranslate "Meta_L"           = Key
DeadKey
keyTranslate "Meta_R"           = Key
DeadKey
keyTranslate "ISO_Level2_Shift" = Key
DeadKey
keyTranslate "ISO_Level3_Shift" = Key
DeadKey
keyTranslate "ISO_Level2_Latch" = Key
DeadKey
keyTranslate "ISO_Level3_Latch" = Key
DeadKey
keyTranslate "Num_Lock"         = Key
DeadKey
keyTranslate "NumLock"          = Key
DeadKey
keyTranslate "Caps_Lock"        = Key
DeadKey
keyTranslate "CapsLock"         = Key
DeadKey
keyTranslate "VoidSymbol"       = Key
DeadKey
-- numeric keypad
keyTranslate ['K','P','_',c :: Char
c] = Char -> Key
KP Char
c
-- standard characters
keyTranslate [c :: Char
c]             = Char -> Key
Char Char
c
keyTranslate s :: String
s               = String -> Key
Unknown String
s

-- | Translate key from a Web API string description
-- (<https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent/key#Key_values>)
-- to our internal key type. To be used in web frontends.
-- The argument says whether Shift is pressed.
keyTranslateWeb :: String -> Bool -> Key
keyTranslateWeb :: String -> Bool -> Key
keyTranslateWeb "1"          True = Char -> Key
KP '1'
keyTranslateWeb "2"          True = Char -> Key
KP '2'
keyTranslateWeb "3"          True = Char -> Key
KP '3'
keyTranslateWeb "4"          True = Char -> Key
KP '4'
keyTranslateWeb "5"          True = Char -> Key
KP '5'
keyTranslateWeb "6"          True = Char -> Key
KP '6'
keyTranslateWeb "7"          True = Char -> Key
KP '7'
keyTranslateWeb "8"          True = Char -> Key
KP '8'
keyTranslateWeb "9"          True = Char -> Key
KP '9'
keyTranslateWeb "End"        True = Char -> Key
KP '1'
keyTranslateWeb "ArrowDown"  True = Char -> Key
KP '2'
keyTranslateWeb "PageDown"   True = Char -> Key
KP '3'
keyTranslateWeb "ArrowLeft"  True = Char -> Key
KP '4'
keyTranslateWeb "Begin"      True = Char -> Key
KP '5'
keyTranslateWeb "Clear"      True = Char -> Key
KP '5'
keyTranslateWeb "ArrowRight" True = Char -> Key
KP '6'
keyTranslateWeb "Home"       True = Char -> Key
KP '7'
keyTranslateWeb "ArrowUp"    True = Char -> Key
KP '8'
keyTranslateWeb "PageUp"     True = Char -> Key
KP '9'
keyTranslateWeb "Backspace"  _ = Key
BackSpace
keyTranslateWeb "Tab"        True = Key
BackTab
keyTranslateWeb "Tab"        False = Key
Tab
keyTranslateWeb "BackTab"    _ = Key
BackTab
keyTranslateWeb "Begin"      _ = Key
Begin
keyTranslateWeb "Clear"      _ = Key
Begin
keyTranslateWeb "Enter"      _ = Key
Return
keyTranslateWeb "Esc"        _ = Key
Esc
keyTranslateWeb "Escape"     _ = Key
Esc
keyTranslateWeb "Del"        _ = Key
Delete
keyTranslateWeb "Delete"     _ = Key
Delete
keyTranslateWeb "Home"       _ = Key
Home
keyTranslateWeb "Up"         _ = Key
Up
keyTranslateWeb "ArrowUp"    _ = Key
Up
keyTranslateWeb "Down"       _ = Key
Down
keyTranslateWeb "ArrowDown"  _ = Key
Down
keyTranslateWeb "Left"       _ = Key
Left
keyTranslateWeb "ArrowLeft"  _ = Key
Left
keyTranslateWeb "Right"      _ = Key
Right
keyTranslateWeb "ArrowRight" _ = Key
Right
keyTranslateWeb "PageUp"     _ = Key
PgUp
keyTranslateWeb "PageDown"   _ = Key
PgDn
keyTranslateWeb "End"        _ = Key
End
keyTranslateWeb "Insert"     _ = Key
Insert
keyTranslateWeb "space"      _ = Key
Space
keyTranslateWeb "Equals"     _ = Char -> Key
Char '='
keyTranslateWeb "Multiply"   _ = Char -> Key
Char '*'  -- KP and normal are merged here
keyTranslateWeb "*"          _ = Char -> Key
Char '*'
keyTranslateWeb "Add"        _ = Char -> Key
Char '+'  -- KP and normal are merged here
keyTranslateWeb "Subtract"   _ = Char -> Key
Char '-'  -- KP and normal are merged here
keyTranslateWeb "Divide"     True = Char -> Key
Char '?'
keyTranslateWeb "Divide"     False = Char -> Key
Char '/' -- KP and normal are merged here
keyTranslateWeb "/"          True = Char -> Key
Char '?'
keyTranslateWeb "/"          False = Char -> Key
Char '/' -- KP and normal are merged here
keyTranslateWeb "Decimal"    _ = Char -> Key
Char '.'  -- dot and comma are merged here
keyTranslateWeb "Separator"  _ = Char -> Key
Char '.'  -- to sidestep national standards
keyTranslateWeb "F1"         _ = Int -> Key
Fun 1
keyTranslateWeb "F2"         _ = Int -> Key
Fun 2
keyTranslateWeb "F3"         _ = Int -> Key
Fun 3
keyTranslateWeb "F4"         _ = Int -> Key
Fun 4
keyTranslateWeb "F5"         _ = Int -> Key
Fun 5
keyTranslateWeb "F6"         _ = Int -> Key
Fun 6
keyTranslateWeb "F7"         _ = Int -> Key
Fun 7
keyTranslateWeb "F8"         _ = Int -> Key
Fun 8
keyTranslateWeb "F9"         _ = Int -> Key
Fun 9
keyTranslateWeb "F10"        _ = Int -> Key
Fun 10
keyTranslateWeb "F11"        _ = Int -> Key
Fun 11
keyTranslateWeb "F12"        _ = Int -> Key
Fun 12
-- dead keys
keyTranslateWeb "Dead"        _ = Key
DeadKey
keyTranslateWeb "Shift"       _ = Key
DeadKey
keyTranslateWeb "Control"     _ = Key
DeadKey
keyTranslateWeb "Meta"        _ = Key
DeadKey
keyTranslateWeb "Menu"        _ = Key
DeadKey
keyTranslateWeb "ContextMenu" _ = Key
DeadKey
keyTranslateWeb "Alt"         _ = Key
DeadKey
keyTranslateWeb "AltGraph"    _ = Key
DeadKey
keyTranslateWeb "Num_Lock"    _ = Key
DeadKey
keyTranslateWeb "NumLock"     _ = Key
DeadKey
keyTranslateWeb "Caps_Lock"   _ = Key
DeadKey
keyTranslateWeb "CapsLock"    _ = Key
DeadKey
keyTranslateWeb "Win"         _ = Key
DeadKey
-- browser quirks
keyTranslateWeb "Unidentified" _ = Key
Begin  -- hack for Firefox
keyTranslateWeb ['\ESC']     _ = Key
Esc
keyTranslateWeb [' ']        _ = Key
Space
keyTranslateWeb ['\n']       _ = Key
Return
keyTranslateWeb ['\r']       _ = Key
DeadKey
keyTranslateWeb ['\t']       _ = Key
Tab
-- standard characters
keyTranslateWeb [c :: Char
c]          _ = Char -> Key
Char Char
c
keyTranslateWeb s :: String
s            _ = String -> Key
Unknown String
s