module Yi.Event
    (
     Event(..), prettyEvent,
     Key(..), Modifier(..),

     -- * Key codes
     eventToChar
    ) where

import Data.Bits   (setBit)
import Data.Char   (chr, ord)

data Modifier = MShift | MCtrl | MMeta | MSuper | MHyper
                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,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,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)

data Key = KEsc | KFun Int | KPrtScr | KPause | KASCII Char | KBS | KIns
         | KHome | KPageUp | KDel | KEnd | KPageDown | KNP5 | KUp | KMenu
         | KLeft | KDown | KRight | KEnter | KTab deriving (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,Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show,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)

data Event = Event Key [Modifier] deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)

instance Ord Event where
    compare :: Event -> Event -> Ordering
compare (Event Key
k1 [Modifier]
m1) (Event Key
k2 [Modifier]
m2) = [Modifier] -> [Modifier] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Modifier]
m1 [Modifier]
m2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` Key -> Key -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Key
k1 Key
k2
    -- so, all Ctrl+char, meta+char, etc. all form a continuous range

instance Show Event where
    show :: Event -> String
show = Event -> String
prettyEvent

prettyEvent :: Event -> String
prettyEvent :: Event -> String
prettyEvent (Event Key
k [Modifier]
mods) =
           (Modifier -> String) -> [Modifier] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-") ShowS -> (Modifier -> String) -> Modifier -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modifier -> String
forall a. Show a => a -> String
prettyModifier) [Modifier]
mods String -> ShowS
forall a. [a] -> [a] -> [a]
++ Key -> String
prettyKey Key
k
  where prettyKey :: Key -> String
prettyKey (KFun Int
i) = Char
'F' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i
        prettyKey (KASCII Char
c) = [Char
c]
        prettyKey Key
key = ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Key -> String
forall a. Show a => a -> String
show Key
key
        prettyModifier :: a -> String
prettyModifier a
m = [ a -> String
forall a. Show a => a -> String
show a
m String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
1]



-- | Map an Event to a Char. This is used in the emacs keymap for Ctrl-Q and vim keymap 'insertSpecialChar'
eventToChar :: Event -> Char
eventToChar :: Event -> Char
eventToChar (Event Key
KEnter [Modifier]
_) = Char
'\CR'
eventToChar (Event Key
KEsc [Modifier]
_)   = Char
'\ESC'
eventToChar (Event Key
KBS [Modifier]
_)    = Char
'\127'
eventToChar (Event Key
KTab [Modifier]
_)   = Char
'\t'

eventToChar (Event (KASCII Char
c) [Modifier]
mods) = (if Modifier
MMeta Modifier -> [Modifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
mods then Char -> Char
setMeta else Char -> Char
forall a. a -> a
id) (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$
                                      (if Modifier
MCtrl Modifier -> [Modifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Modifier]
mods then Char -> Char
ctrlLowcase else Char -> Char
forall a. a -> a
id) Char
c

eventToChar Event
_ev = Char
'?'



remapChar :: Char -> Char -> Char -> Char -> Char -> Char
remapChar :: Char -> Char -> Char -> Char -> Char -> Char
remapChar Char
a1 Char
b1 Char
a2 Char
_ Char
c
    | Char
a1 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
b1 = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
a1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
a2
    | Bool
otherwise          = Char
c

ctrlLowcase :: Char -> Char
ctrlLowcase :: Char -> Char
ctrlLowcase   = Char -> Char -> Char -> Char -> Char -> Char
remapChar Char
'a'   Char
'z'   Char
'\^A' Char
'\^Z'

-- set the meta bit, as if Mod1/Alt had been pressed
setMeta :: Char -> Char
setMeta :: Char -> Char
setMeta Char
c = Int -> Char
chr (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
setBit (Char -> Int
ord Char
c) Int
metaBit)

metaBit :: Int
metaBit :: Int
metaBit = Int
7