{-# 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
  , cardinalAllKM, dirAllKey, handleCardinal, 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 Key
Esc      = String
"ESC"
showKey Key
Return   = String
"RET"
showKey Key
Space    = String
"SPACE"
showKey Key
Tab      = String
"TAB"
showKey Key
BackTab  = String
"S-TAB"
showKey Key
BackSpace = String
"BACKSPACE"
showKey Key
Up       = String
"UP"
showKey Key
Down     = String
"DOWN"
showKey Key
Left     = String
"LEFT"
showKey Key
Right    = String
"RIGHT"
showKey Key
Home     = String
"HOME"
showKey Key
End      = String
"END"
showKey Key
PgUp     = String
"PGUP"
showKey Key
PgDn     = String
"PGDN"
showKey Key
Begin    = String
"BEGIN"
showKey Key
Insert   = String
"INS"
showKey Key
Delete   = String
"DEL"
showKey Key
PrintScreen = String
"PRTSCR"
showKey (KP Char
c)   = String
"KP_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c]
showKey (Char Char
c) = [Char
c]
showKey (Fun Int
n) = String
"F" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
showKey Key
LeftButtonPress = String
"LMB-PRESS"
showKey Key
MiddleButtonPress = String
"MMB-PRESS"
showKey Key
RightButtonPress = String
"RMB-PRESS"
showKey Key
LeftButtonRelease = String
"LMB"
showKey Key
MiddleButtonRelease = String
"MMB"
showKey Key
RightButtonRelease = String
"RMB"
showKey Key
WheelNorth = String
"WHEEL-UP"
showKey Key
WheelSouth = String
"WHEEL-DN"
showKey (Unknown String
s) = String
s
showKey Key
DeadKey      = String
"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} = String
"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} = String
"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} = String
"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} = String
"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} = String
"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 String
"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 String
"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 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

cardinalKeypadKM :: [KM]
cardinalKeypadKM :: [KM]
cardinalKeypadKM = (Key -> KM) -> [Key] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (Modifier -> Key -> KM
KM Modifier
NoModifier) [Key
Up, Key
Right, Key
Down, Key
Left]

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 = [Char
'7', Char
'8', Char
'9', Char
'6', Char
'3', Char
'2', Char
'1', Char
'4']

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

cardinalLeftHandKM :: [KM]
cardinalLeftHandKM :: [KM]
cardinalLeftHandKM = (Char -> KM) -> String -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (Modifier -> Key -> KM
KM Modifier
NoModifier (Key -> KM) -> (Char -> Key) -> Char -> KM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Key
Char) [Char
'w', Char
'd', Char
'x', Char
'a']

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

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

cardinalViKM :: [KM]
cardinalViKM :: [KM]
cardinalViKM = (Char -> KM) -> String -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (Modifier -> Key -> KM
KM Modifier
NoModifier (Key -> KM) -> (Char -> Key) -> Char -> KM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Key
Char) [Char
'k', Char
'l', Char
'j', Char
'h']

dirViChar :: [Char]
dirViChar :: String
dirViChar = [Char
'y', Char
'k', Char
'u', Char
'l', Char
'n', Char
'j', Char
'b', Char
'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 Bool
uVi 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 Bool
uVi 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

cardinalAllKM :: Bool -> Bool -> [KM]
cardinalAllKM :: Bool -> Bool -> [KM]
cardinalAllKM Bool
uVi Bool
uLeftHand = [[KM]] -> [KM]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KM]] -> [KM]) -> [[KM]] -> [KM]
forall a b. (a -> b) -> a -> b
$
  [[KM]
cardinalKeypadKM]
  [[KM]] -> [[KM]] -> [[KM]]
forall a. [a] -> [a] -> [a]
++ [[KM]
cardinalViKM | Bool
uVi]
  [[KM]] -> [[KM]] -> [[KM]]
forall a. [a] -> [a] -> [a]
++ [[KM]
cardinalLeftHandKM | Bool
uLeftHand]

dirAllKey :: Bool -> Bool -> [Key]
dirAllKey :: Bool -> Bool -> [Key]
dirAllKey Bool
uVi 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

handleCardinal :: [KM] -> KM -> Maybe Vector
handleCardinal :: [KM] -> KM -> Maybe Vector
handleCardinal [KM]
dirKeys KM
key =
  let assocs :: [(KM, Vector)]
assocs = [KM] -> [Vector] -> [(KM, Vector)]
forall a b. [a] -> [b] -> [(a, b)]
zip [KM]
dirKeys ([Vector] -> [(KM, Vector)]) -> [Vector] -> [(KM, Vector)]
forall a b. (a -> b) -> a -> b
$ [Vector] -> [Vector]
forall a. [a] -> [a]
cycle [Vector]
movesCardinal
  in KM -> [(KM, Vector)] -> Maybe Vector
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup KM
key [(KM, Vector)]
assocs

-- | 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 [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 [Key]
_ KM
_ = 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 Bool
uVi Bool
uLeftHand Vector -> a
move Vector -> a
run =
  let assign :: (t -> b) -> a -> t -> (a, b)
assign t -> b
f a
km t
dir = (a
km, t -> b
f t
dir)
      mapMove :: Modifier -> [Key] -> [(KM, a)]
mapMove Modifier
modifier [Key]
keys =
        (KM -> Vector -> (KM, a)) -> [KM] -> [Vector] -> [(KM, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Vector -> a) -> KM -> Vector -> (KM, a)
forall t b a. (t -> b) -> a -> t -> (a, b)
assign Vector -> a
move) ((Key -> KM) -> [Key] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (Modifier -> Key -> KM
KM Modifier
modifier) [Key]
keys) ([Vector] -> [Vector]
forall a. [a] -> [a]
cycle [Vector]
moves)
      mapRun :: Modifier -> [Key] -> [(KM, a)]
mapRun Modifier
modifier [Key]
keys =
        (KM -> Vector -> (KM, a)) -> [KM] -> [Vector] -> [(KM, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Vector -> a) -> KM -> Vector -> (KM, a)
forall t b a. (t -> b) -> a -> t -> (a, b)
assign Vector -> a
run) ((Key -> KM) -> [Key] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (Modifier -> Key -> KM
KM Modifier
modifier) [Key]
keys) ([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 String
s = let mkKey :: String -> Key
mkKey String
sk =
               case String -> Key
keyTranslate String
sk of
                 Unknown String
_ -> String -> Key
forall a. HasCallStack => String -> a
error (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String
"unknown key" String -> ShowS
forall v. Show v => String -> v -> String
`showFailure` String
s
                 Key
key -> Key
key
         in case String
s of
           Char
'C':Char
'-':Char
'S':Char
'-':String
rest -> Modifier -> Key -> KM
KM Modifier
ControlShift (String -> Key
mkKey String
rest)
           Char
'S':Char
'-':Char
'C':Char
'-':String
rest -> Modifier -> Key -> KM
KM Modifier
ControlShift (String -> Key
mkKey String
rest)
           Char
'A':Char
'-':Char
'S':Char
'-':String
rest -> Modifier -> Key -> KM
KM Modifier
AltShift (String -> Key
mkKey String
rest)
           Char
'S':Char
'-':Char
'A':Char
'-':String
rest -> Modifier -> Key -> KM
KM Modifier
AltShift (String -> Key
mkKey String
rest)
           Char
'S':Char
'-':String
rest -> Modifier -> Key -> KM
KM Modifier
Shift (String -> Key
mkKey String
rest)
           Char
'C':Char
'-':String
rest -> Modifier -> Key -> KM
KM Modifier
Control (String -> Key
mkKey String
rest)
           Char
'A':Char
'-':String
rest -> Modifier -> Key -> KM
KM Modifier
Alt (String -> Key
mkKey String
rest)
           String
_ -> Modifier -> Key -> KM
KM Modifier
NoModifier (String -> Key
mkKey String
s)

mkChar :: Char -> KM
mkChar :: Char -> KM
mkChar 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 String
"less"          = Char -> Key
Char Char
'<'
keyTranslate String
"greater"       = Char -> Key
Char Char
'>'
keyTranslate String
"period"        = Char -> Key
Char Char
'.'
keyTranslate String
"colon"         = Char -> Key
Char Char
':'
keyTranslate String
"semicolon"     = Char -> Key
Char Char
';'
keyTranslate String
"comma"         = Char -> Key
Char Char
','
keyTranslate String
"question"      = Char -> Key
Char Char
'?'
keyTranslate String
"numbersign"    = Char -> Key
Char Char
'#'
keyTranslate String
"dollar"        = Char -> Key
Char Char
'$'
keyTranslate String
"parenleft"     = Char -> Key
Char Char
'('
keyTranslate String
"parenright"    = Char -> Key
Char Char
')'
keyTranslate String
"asterisk"      = Char -> Key
Char Char
'*'  -- KP and normal are merged here
keyTranslate String
"KP_Multiply"   = Char -> Key
Char Char
'*'
keyTranslate String
"slash"         = Char -> Key
Char Char
'/'
keyTranslate String
"KP_Divide"     = Char -> Key
Char Char
'/'
keyTranslate String
"bar"           = Char -> Key
Char Char
'|'
keyTranslate String
"backslash"     = Char -> Key
Char Char
'\\'
keyTranslate String
"asciicircum"   = Char -> Key
Char Char
'^'
keyTranslate String
"underscore"    = Char -> Key
Char Char
'_'
keyTranslate String
"minus"         = Char -> Key
Char Char
'-'
keyTranslate String
"KP_Subtract"   = Char -> Key
Char Char
'-'  -- KP and normal are merged here
keyTranslate String
"plus"          = Char -> Key
Char Char
'+'
keyTranslate String
"KP_Add"        = Char -> Key
Char Char
'+'  -- KP and normal are merged here
keyTranslate String
"equal"         = Char -> Key
Char Char
'='
keyTranslate String
"bracketleft"   = Char -> Key
Char Char
'['
keyTranslate String
"bracketright"  = Char -> Key
Char Char
']'
keyTranslate String
"braceleft"     = Char -> Key
Char Char
'{'
keyTranslate String
"braceright"    = Char -> Key
Char Char
'}'
keyTranslate String
"caret"         = Char -> Key
Char Char
'^'
keyTranslate String
"ampersand"     = Char -> Key
Char Char
'&'
keyTranslate String
"at"            = Char -> Key
Char Char
'@'
keyTranslate String
"asciitilde"    = Char -> Key
Char Char
'~'
keyTranslate String
"grave"         = Char -> Key
Char Char
'`'
keyTranslate String
"exclam"        = Char -> Key
Char Char
'!'
keyTranslate String
"apostrophe"    = Char -> Key
Char Char
'\''
keyTranslate String
"quotedbl"      = Char -> Key
Char Char
'"'
keyTranslate String
"Escape"        = Key
Esc
keyTranslate String
"ESC"           = Key
Esc
keyTranslate String
"Return"        = Key
Return
keyTranslate String
"RET"           = Key
Return
keyTranslate String
"space"         = Key
Space
keyTranslate String
"SPACE"         = Key
Space
keyTranslate String
"Tab"           = Key
Tab
keyTranslate String
"TAB"           = Key
Tab
keyTranslate String
"BackTab"       = Key
BackTab
keyTranslate String
"ISO_Left_Tab"  = Key
BackTab
keyTranslate String
"BackSpace"     = Key
BackSpace
keyTranslate String
"BACKSPACE"     = Key
BackSpace
keyTranslate String
"Up"            = Key
Up
keyTranslate String
"UP"            = Key
Up
keyTranslate String
"KP_Up"         = Key
Up
keyTranslate String
"Down"          = Key
Down
keyTranslate String
"DOWN"          = Key
Down
keyTranslate String
"KP_Down"       = Key
Down
keyTranslate String
"Left"          = Key
Left
keyTranslate String
"LEFT"          = Key
Left
keyTranslate String
"KP_Left"       = Key
Left
keyTranslate String
"Right"         = Key
Right
keyTranslate String
"RIGHT"         = Key
Right
keyTranslate String
"KP_Right"      = Key
Right
keyTranslate String
"Home"          = Key
Home
keyTranslate String
"HOME"          = Key
Home
keyTranslate String
"KP_Home"       = Key
Home
keyTranslate String
"End"           = Key
End
keyTranslate String
"END"           = Key
End
keyTranslate String
"KP_End"        = Key
End
keyTranslate String
"Page_Up"       = Key
PgUp
keyTranslate String
"PGUP"          = Key
PgUp
keyTranslate String
"KP_Page_Up"    = Key
PgUp
keyTranslate String
"Prior"         = Key
PgUp
keyTranslate String
"KP_Prior"      = Key
PgUp
keyTranslate String
"Page_Down"     = Key
PgDn
keyTranslate String
"PGDN"          = Key
PgDn
keyTranslate String
"KP_Page_Down"  = Key
PgDn
keyTranslate String
"Next"          = Key
PgDn
keyTranslate String
"KP_Next"       = Key
PgDn
keyTranslate String
"Begin"         = Key
Begin
keyTranslate String
"BEGIN"         = Key
Begin
keyTranslate String
"KP_Begin"      = Key
Begin
keyTranslate String
"Clear"         = Key
Begin
keyTranslate String
"KP_Clear"      = Key
Begin
keyTranslate String
"Center"        = Key
Begin
keyTranslate String
"KP_Center"     = Key
Begin
keyTranslate String
"Insert"        = Key
Insert
keyTranslate String
"INS"           = Key
Insert
keyTranslate String
"KP_Insert"     = Key
Insert
keyTranslate String
"Delete"        = Key
Delete
keyTranslate String
"DEL"           = Key
Delete
keyTranslate String
"KP_Delete"     = Key
Delete
keyTranslate String
"KP_Enter"      = Key
Return
keyTranslate String
"F1"            = Int -> Key
Fun Int
1
keyTranslate String
"F2"            = Int -> Key
Fun Int
2
keyTranslate String
"F3"            = Int -> Key
Fun Int
3
keyTranslate String
"F4"            = Int -> Key
Fun Int
4
keyTranslate String
"F5"            = Int -> Key
Fun Int
5
keyTranslate String
"F6"            = Int -> Key
Fun Int
6
keyTranslate String
"F7"            = Int -> Key
Fun Int
7
keyTranslate String
"F8"            = Int -> Key
Fun Int
8
keyTranslate String
"F9"            = Int -> Key
Fun Int
9
keyTranslate String
"F10"           = Int -> Key
Fun Int
10
keyTranslate String
"F11"           = Int -> Key
Fun Int
11
keyTranslate String
"F12"           = Int -> Key
Fun Int
12
keyTranslate String
"LeftButtonPress" = Key
LeftButtonPress
keyTranslate String
"LMB-PRESS" = Key
LeftButtonPress
keyTranslate String
"MiddleButtonPress" = Key
MiddleButtonPress
keyTranslate String
"MMB-PRESS" = Key
MiddleButtonPress
keyTranslate String
"RightButtonPress" = Key
RightButtonPress
keyTranslate String
"RMB-PRESS" = Key
RightButtonPress
keyTranslate String
"LeftButtonRelease" = Key
LeftButtonRelease
keyTranslate String
"LMB" = Key
LeftButtonRelease
keyTranslate String
"MiddleButtonRelease" = Key
MiddleButtonRelease
keyTranslate String
"MMB" = Key
MiddleButtonRelease
keyTranslate String
"RightButtonRelease" = Key
RightButtonRelease
keyTranslate String
"RMB" = Key
RightButtonRelease
keyTranslate String
"WheelNorth"    = Key
WheelNorth
keyTranslate String
"WHEEL-UP"      = Key
WheelNorth
keyTranslate String
"WheelSouth"    = Key
WheelSouth
keyTranslate String
"WHEEL-DN"      = Key
WheelSouth
-- dead keys
keyTranslate String
"Shift_L"          = Key
DeadKey
keyTranslate String
"Shift_R"          = Key
DeadKey
keyTranslate String
"Control_L"        = Key
DeadKey
keyTranslate String
"Control_R"        = Key
DeadKey
keyTranslate String
"Super_L"          = Key
DeadKey
keyTranslate String
"Super_R"          = Key
DeadKey
keyTranslate String
"Menu"             = Key
DeadKey
keyTranslate String
"Alt_L"            = Key
DeadKey
keyTranslate String
"Alt_R"            = Key
DeadKey
keyTranslate String
"Meta_L"           = Key
DeadKey
keyTranslate String
"Meta_R"           = Key
DeadKey
keyTranslate String
"ISO_Level2_Shift" = Key
DeadKey
keyTranslate String
"ISO_Level3_Shift" = Key
DeadKey
keyTranslate String
"ISO_Level2_Latch" = Key
DeadKey
keyTranslate String
"ISO_Level3_Latch" = Key
DeadKey
keyTranslate String
"Num_Lock"         = Key
DeadKey
keyTranslate String
"NumLock"          = Key
DeadKey
keyTranslate String
"Caps_Lock"        = Key
DeadKey
keyTranslate String
"CapsLock"         = Key
DeadKey
keyTranslate String
"VoidSymbol"       = Key
DeadKey
-- numeric keypad
keyTranslate [Char
'K',Char
'P',Char
'_',Char
c] = Char -> Key
KP Char
c
-- standard characters
keyTranslate [Char
c]             = Char -> Key
Char Char
c
keyTranslate 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 String
"1"          Bool
True = Char -> Key
KP Char
'1'
keyTranslateWeb String
"2"          Bool
True = Char -> Key
KP Char
'2'
keyTranslateWeb String
"3"          Bool
True = Char -> Key
KP Char
'3'
keyTranslateWeb String
"4"          Bool
True = Char -> Key
KP Char
'4'
keyTranslateWeb String
"5"          Bool
True = Char -> Key
KP Char
'5'
keyTranslateWeb String
"6"          Bool
True = Char -> Key
KP Char
'6'
keyTranslateWeb String
"7"          Bool
True = Char -> Key
KP Char
'7'
keyTranslateWeb String
"8"          Bool
True = Char -> Key
KP Char
'8'
keyTranslateWeb String
"9"          Bool
True = Char -> Key
KP Char
'9'
keyTranslateWeb String
"End"        Bool
True = Char -> Key
KP Char
'1'
keyTranslateWeb String
"ArrowDown"  Bool
True = Char -> Key
KP Char
'2'
keyTranslateWeb String
"PageDown"   Bool
True = Char -> Key
KP Char
'3'
keyTranslateWeb String
"ArrowLeft"  Bool
True = Char -> Key
KP Char
'4'
keyTranslateWeb String
"Begin"      Bool
True = Char -> Key
KP Char
'5'
keyTranslateWeb String
"Clear"      Bool
True = Char -> Key
KP Char
'5'
keyTranslateWeb String
"ArrowRight" Bool
True = Char -> Key
KP Char
'6'
keyTranslateWeb String
"Home"       Bool
True = Char -> Key
KP Char
'7'
keyTranslateWeb String
"ArrowUp"    Bool
True = Char -> Key
KP Char
'8'
keyTranslateWeb String
"PageUp"     Bool
True = Char -> Key
KP Char
'9'
keyTranslateWeb String
"Backspace"  Bool
_ = Key
BackSpace
keyTranslateWeb String
"Tab"        Bool
True = Key
BackTab
keyTranslateWeb String
"Tab"        Bool
False = Key
Tab
keyTranslateWeb String
"BackTab"    Bool
_ = Key
BackTab
keyTranslateWeb String
"Begin"      Bool
_ = Key
Begin
keyTranslateWeb String
"Clear"      Bool
_ = Key
Begin
keyTranslateWeb String
"Enter"      Bool
_ = Key
Return
keyTranslateWeb String
"Esc"        Bool
_ = Key
Esc
keyTranslateWeb String
"Escape"     Bool
_ = Key
Esc
keyTranslateWeb String
"Del"        Bool
_ = Key
Delete
keyTranslateWeb String
"Delete"     Bool
_ = Key
Delete
keyTranslateWeb String
"Home"       Bool
_ = Key
Home
keyTranslateWeb String
"Up"         Bool
_ = Key
Up
keyTranslateWeb String
"ArrowUp"    Bool
_ = Key
Up
keyTranslateWeb String
"Down"       Bool
_ = Key
Down
keyTranslateWeb String
"ArrowDown"  Bool
_ = Key
Down
keyTranslateWeb String
"Left"       Bool
_ = Key
Left
keyTranslateWeb String
"ArrowLeft"  Bool
_ = Key
Left
keyTranslateWeb String
"Right"      Bool
_ = Key
Right
keyTranslateWeb String
"ArrowRight" Bool
_ = Key
Right
keyTranslateWeb String
"PageUp"     Bool
_ = Key
PgUp
keyTranslateWeb String
"PageDown"   Bool
_ = Key
PgDn
keyTranslateWeb String
"End"        Bool
_ = Key
End
keyTranslateWeb String
"Insert"     Bool
_ = Key
Insert
keyTranslateWeb String
"space"      Bool
_ = Key
Space
keyTranslateWeb String
"Equals"     Bool
_ = Char -> Key
Char Char
'='
keyTranslateWeb String
"Multiply"   Bool
_ = Char -> Key
Char Char
'*'  -- KP and normal are merged here
keyTranslateWeb String
"*"          Bool
_ = Char -> Key
Char Char
'*'
keyTranslateWeb String
"Add"        Bool
_ = Char -> Key
Char Char
'+'  -- KP and normal are merged here
keyTranslateWeb String
"Subtract"   Bool
_ = Char -> Key
Char Char
'-'  -- KP and normal are merged here
keyTranslateWeb String
"Divide"     Bool
True = Char -> Key
Char Char
'?'
keyTranslateWeb String
"Divide"     Bool
False = Char -> Key
Char Char
'/' -- KP and normal are merged here
keyTranslateWeb String
"/"          Bool
True = Char -> Key
Char Char
'?'
keyTranslateWeb String
"/"          Bool
False = Char -> Key
Char Char
'/' -- KP and normal are merged here
keyTranslateWeb String
"Decimal"    Bool
_ = Char -> Key
Char Char
'.'  -- dot and comma are merged here
keyTranslateWeb String
"Separator"  Bool
_ = Char -> Key
Char Char
'.'  -- to sidestep national standards
keyTranslateWeb String
"F1"         Bool
_ = Int -> Key
Fun Int
1
keyTranslateWeb String
"F2"         Bool
_ = Int -> Key
Fun Int
2
keyTranslateWeb String
"F3"         Bool
_ = Int -> Key
Fun Int
3
keyTranslateWeb String
"F4"         Bool
_ = Int -> Key
Fun Int
4
keyTranslateWeb String
"F5"         Bool
_ = Int -> Key
Fun Int
5
keyTranslateWeb String
"F6"         Bool
_ = Int -> Key
Fun Int
6
keyTranslateWeb String
"F7"         Bool
_ = Int -> Key
Fun Int
7
keyTranslateWeb String
"F8"         Bool
_ = Int -> Key
Fun Int
8
keyTranslateWeb String
"F9"         Bool
_ = Int -> Key
Fun Int
9
keyTranslateWeb String
"F10"        Bool
_ = Int -> Key
Fun Int
10
keyTranslateWeb String
"F11"        Bool
_ = Int -> Key
Fun Int
11
keyTranslateWeb String
"F12"        Bool
_ = Int -> Key
Fun Int
12
-- dead keys
keyTranslateWeb String
"Dead"        Bool
_ = Key
DeadKey
keyTranslateWeb String
"Shift"       Bool
_ = Key
DeadKey
keyTranslateWeb String
"Control"     Bool
_ = Key
DeadKey
keyTranslateWeb String
"Meta"        Bool
_ = Key
DeadKey
keyTranslateWeb String
"Menu"        Bool
_ = Key
DeadKey
keyTranslateWeb String
"ContextMenu" Bool
_ = Key
DeadKey
keyTranslateWeb String
"Alt"         Bool
_ = Key
DeadKey
keyTranslateWeb String
"AltGraph"    Bool
_ = Key
DeadKey
keyTranslateWeb String
"Num_Lock"    Bool
_ = Key
DeadKey
keyTranslateWeb String
"NumLock"     Bool
_ = Key
DeadKey
keyTranslateWeb String
"Caps_Lock"   Bool
_ = Key
DeadKey
keyTranslateWeb String
"CapsLock"    Bool
_ = Key
DeadKey
keyTranslateWeb String
"Win"         Bool
_ = Key
DeadKey
-- browser quirks
keyTranslateWeb String
"Unidentified" Bool
_ = Key
Begin  -- hack for Firefox
keyTranslateWeb [Char
'\ESC']     Bool
_ = Key
Esc
keyTranslateWeb [Char
' ']        Bool
_ = Key
Space
keyTranslateWeb [Char
'\n']       Bool
_ = Key
Return
keyTranslateWeb [Char
'\r']       Bool
_ = Key
DeadKey
keyTranslateWeb [Char
'\t']       Bool
_ = Key
Tab
-- standard characters
keyTranslateWeb [Char
c]          Bool
_ = Char -> Key
Char Char
c
keyTranslateWeb String
s            Bool
_ = String -> Key
Unknown String
s