module Yi.Frontend.Vty.Conversions
    ( colorToAttr
    , fromVtyEvent
    , fromVtyKey
    , fromVtyMod
    ) where

import           Data.List    (nub, sort)
import qualified Graphics.Vty as Vty (Attr, Color, Event (EvKey), Key (KBS, KBackTab, KBegin, KCenter, KChar, KDel, KDown, KEnd, KEnter, KEsc, KFun, KHome, KIns, KLeft, KMenu, KPageDown, KPageUp, KPause, KPrtScr, KRight, KUp),
                                      Modifier (..), black, blue, brightBlack,
                                      brightBlue, brightCyan, brightGreen,
                                      brightMagenta, brightRed, brightWhite,
                                      brightYellow, cyan, green, magenta, red,
                                      rgbColor, white, yellow)
import qualified Yi.Event     (Event (..), Key (..), Modifier (MCtrl, MMeta, MShift))
import qualified Yi.Style     (Color (..))

fromVtyEvent :: Vty.Event -> Yi.Event.Event
fromVtyEvent :: Event -> Event
fromVtyEvent (Vty.EvKey Key
Vty.KBackTab [Modifier]
mods) =
    Key -> [Modifier] -> Event
Yi.Event.Event Key
Yi.Event.KTab ([Modifier] -> [Modifier]
forall a. Ord a => [a] -> [a]
sort ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> a -> b
$ [Modifier] -> [Modifier]
forall a. Eq a => [a] -> [a]
nub ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> a -> b
$ Modifier
Yi.Event.MShift Modifier -> [Modifier] -> [Modifier]
forall a. a -> [a] -> [a]
: (Modifier -> Modifier) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> [a] -> [b]
map Modifier -> Modifier
fromVtyMod [Modifier]
mods)
fromVtyEvent (Vty.EvKey Key
k [Modifier]
mods) =
    Key -> [Modifier] -> Event
Yi.Event.Event (Key -> Key
fromVtyKey Key
k) ([Modifier] -> [Modifier]
forall a. Ord a => [a] -> [a]
sort ([Modifier] -> [Modifier]) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> a -> b
$ (Modifier -> Modifier) -> [Modifier] -> [Modifier]
forall a b. (a -> b) -> [a] -> [b]
map Modifier -> Modifier
fromVtyMod [Modifier]
mods)
fromVtyEvent Event
_ = [Char] -> Event
forall a. HasCallStack => [Char] -> a
error [Char]
"fromVtyEvent: unsupported event encountered."

fromVtyKey :: Vty.Key -> Yi.Event.Key
fromVtyKey :: Key -> Key
fromVtyKey (Key
Vty.KEsc      ) = Key
Yi.Event.KEsc
fromVtyKey (Vty.KFun Int
x    ) = Int -> Key
Yi.Event.KFun Int
x
fromVtyKey (Key
Vty.KPrtScr   ) = Key
Yi.Event.KPrtScr
fromVtyKey (Key
Vty.KPause    ) = Key
Yi.Event.KPause
fromVtyKey (Vty.KChar Char
'\t') = Key
Yi.Event.KTab
fromVtyKey (Vty.KChar Char
c   ) = Char -> Key
Yi.Event.KASCII Char
c
fromVtyKey (Key
Vty.KBS       ) = Key
Yi.Event.KBS
fromVtyKey (Key
Vty.KIns      ) = Key
Yi.Event.KIns
fromVtyKey (Key
Vty.KHome     ) = Key
Yi.Event.KHome
fromVtyKey (Key
Vty.KPageUp   ) = Key
Yi.Event.KPageUp
fromVtyKey (Key
Vty.KDel      ) = Key
Yi.Event.KDel
fromVtyKey (Key
Vty.KEnd      ) = Key
Yi.Event.KEnd
fromVtyKey (Key
Vty.KPageDown ) = Key
Yi.Event.KPageDown
fromVtyKey (Key
Vty.KCenter   ) = Key
Yi.Event.KNP5
fromVtyKey (Key
Vty.KUp       ) = Key
Yi.Event.KUp
fromVtyKey (Key
Vty.KMenu     ) = Key
Yi.Event.KMenu
fromVtyKey (Key
Vty.KLeft     ) = Key
Yi.Event.KLeft
fromVtyKey (Key
Vty.KDown     ) = Key
Yi.Event.KDown
fromVtyKey (Key
Vty.KRight    ) = Key
Yi.Event.KRight
fromVtyKey (Key
Vty.KEnter    ) = Key
Yi.Event.KEnter
fromVtyKey (Key
Vty.KBackTab  ) = [Char] -> Key
forall a. HasCallStack => [Char] -> a
error [Char]
"This should be handled in fromVtyEvent"
fromVtyKey (Key
Vty.KBegin    ) = [Char] -> Key
forall a. HasCallStack => [Char] -> a
error [Char]
"Yi.Frontend.Vty.Conversions.fromVtyKey: can't handle KBegin"
fromVtyKey Key
_ = [Char] -> Key
forall a. HasCallStack => [Char] -> a
error [Char]
"Unhandled key in fromVtyKey"

fromVtyMod :: Vty.Modifier -> Yi.Event.Modifier
fromVtyMod :: Modifier -> Modifier
fromVtyMod Modifier
Vty.MShift = Modifier
Yi.Event.MShift
fromVtyMod Modifier
Vty.MCtrl  = Modifier
Yi.Event.MCtrl
fromVtyMod Modifier
Vty.MMeta  = Modifier
Yi.Event.MMeta
fromVtyMod Modifier
Vty.MAlt   = Modifier
Yi.Event.MMeta


-- | Convert a Yi Attr into a Vty attribute change.
colorToAttr :: (Vty.Color -> Vty.Attr -> Vty.Attr)
    -> Yi.Style.Color -> Vty.Attr -> Vty.Attr
colorToAttr :: (Color -> Attr -> Attr) -> Color -> Attr -> Attr
colorToAttr Color -> Attr -> Attr
set Color
c =
  case Color
c of
    Yi.Style.RGB Word8
0 Word8
0 Word8
0         -> Color -> Attr -> Attr
set Color
Vty.black
    Yi.Style.RGB Word8
128 Word8
128 Word8
128   -> Color -> Attr -> Attr
set Color
Vty.brightBlack
    Yi.Style.RGB Word8
139 Word8
0 Word8
0       -> Color -> Attr -> Attr
set Color
Vty.red
    Yi.Style.RGB Word8
255 Word8
0 Word8
0       -> Color -> Attr -> Attr
set Color
Vty.brightRed
    Yi.Style.RGB Word8
0 Word8
100 Word8
0       -> Color -> Attr -> Attr
set Color
Vty.green
    Yi.Style.RGB Word8
0 Word8
128 Word8
0       -> Color -> Attr -> Attr
set Color
Vty.brightGreen
    Yi.Style.RGB Word8
165 Word8
42 Word8
42     -> Color -> Attr -> Attr
set Color
Vty.yellow
    Yi.Style.RGB Word8
255 Word8
255 Word8
0     -> Color -> Attr -> Attr
set Color
Vty.brightYellow
    Yi.Style.RGB Word8
0 Word8
0 Word8
139       -> Color -> Attr -> Attr
set Color
Vty.blue
    Yi.Style.RGB Word8
0 Word8
0 Word8
255       -> Color -> Attr -> Attr
set Color
Vty.brightBlue
    Yi.Style.RGB Word8
128 Word8
0 Word8
128     -> Color -> Attr -> Attr
set Color
Vty.magenta
    Yi.Style.RGB Word8
255 Word8
0 Word8
255     -> Color -> Attr -> Attr
set Color
Vty.brightMagenta
    Yi.Style.RGB Word8
0 Word8
139 Word8
139     -> Color -> Attr -> Attr
set Color
Vty.cyan
    Yi.Style.RGB Word8
0 Word8
255 Word8
255     -> Color -> Attr -> Attr
set Color
Vty.brightCyan
    Yi.Style.RGB Word8
165 Word8
165 Word8
165   -> Color -> Attr -> Attr
set Color
Vty.white
    Yi.Style.RGB Word8
255 Word8
255 Word8
255   -> Color -> Attr -> Attr
set Color
Vty.brightWhite
    Color
Yi.Style.Default           -> Attr -> Attr
forall a. a -> a
id
    Yi.Style.RGB Word8
r Word8
g Word8
b         -> Color -> Attr -> Attr
set (Word8 -> Word8 -> Word8 -> Color
forall i. Integral i => i -> i -> i -> Color
Vty.rgbColor Word8
r Word8
g Word8
b)