-- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons

-- | Colors and friends.
module Yi.Style where

import Data.Word (Word8)
import Data.Char (chr, ord)
import Data.Monoid

-- | Visual text attributes to be applied during layout.
data Attributes = Attributes
  { Attributes -> Color
foreground :: !Color
  , Attributes -> Color
background :: !Color
  , Attributes -> Bool
reverseAttr :: !Bool
    -- ^ The text should be show as "active" or "selected".
    -- This can be implemented by reverse video on the terminal.
  , Attributes -> Bool
bold :: !Bool
  , Attributes -> Bool
italic :: !Bool
  , Attributes -> Bool
underline :: !Bool
  } deriving (Attributes -> Attributes -> Bool
(Attributes -> Attributes -> Bool)
-> (Attributes -> Attributes -> Bool) -> Eq Attributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attributes -> Attributes -> Bool
$c/= :: Attributes -> Attributes -> Bool
== :: Attributes -> Attributes -> Bool
$c== :: Attributes -> Attributes -> Bool
Eq, Eq Attributes
Eq Attributes
-> (Attributes -> Attributes -> Ordering)
-> (Attributes -> Attributes -> Bool)
-> (Attributes -> Attributes -> Bool)
-> (Attributes -> Attributes -> Bool)
-> (Attributes -> Attributes -> Bool)
-> (Attributes -> Attributes -> Attributes)
-> (Attributes -> Attributes -> Attributes)
-> Ord Attributes
Attributes -> Attributes -> Bool
Attributes -> Attributes -> Ordering
Attributes -> Attributes -> Attributes
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 :: Attributes -> Attributes -> Attributes
$cmin :: Attributes -> Attributes -> Attributes
max :: Attributes -> Attributes -> Attributes
$cmax :: Attributes -> Attributes -> Attributes
>= :: Attributes -> Attributes -> Bool
$c>= :: Attributes -> Attributes -> Bool
> :: Attributes -> Attributes -> Bool
$c> :: Attributes -> Attributes -> Bool
<= :: Attributes -> Attributes -> Bool
$c<= :: Attributes -> Attributes -> Bool
< :: Attributes -> Attributes -> Bool
$c< :: Attributes -> Attributes -> Bool
compare :: Attributes -> Attributes -> Ordering
$ccompare :: Attributes -> Attributes -> Ordering
$cp1Ord :: Eq Attributes
Ord, Int -> Attributes -> ShowS
[Attributes] -> ShowS
Attributes -> String
(Int -> Attributes -> ShowS)
-> (Attributes -> String)
-> ([Attributes] -> ShowS)
-> Show Attributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attributes] -> ShowS
$cshowList :: [Attributes] -> ShowS
show :: Attributes -> String
$cshow :: Attributes -> String
showsPrec :: Int -> Attributes -> ShowS
$cshowsPrec :: Int -> Attributes -> ShowS
Show)

emptyAttributes :: Attributes
emptyAttributes :: Attributes
emptyAttributes = Attributes :: Color -> Color -> Bool -> Bool -> Bool -> Bool -> Attributes
Attributes { foreground :: Color
foreground = Color
Default, background :: Color
background = Color
Default, reverseAttr :: Bool
reverseAttr = Bool
False, bold :: Bool
bold = Bool
False, italic :: Bool
italic = Bool
False, underline :: Bool
underline = Bool
False }

-- | The style is used to transform attributes by modifying
--   one or more of the visual text attributes.
type Style = Endo Attributes

-- | The UI type
data UIStyle = UIStyle
  { UIStyle -> Attributes
modelineAttributes :: Attributes -- ^ ground attributes for the modeline
  , UIStyle -> Style
modelineFocusStyle :: Style      -- ^ transformation of modeline in focus

  , UIStyle -> Attributes
tabBarAttributes   :: Attributes -- ^ ground attributes for the tabbar
  , UIStyle -> Style
tabInFocusStyle    :: Style      -- ^ a tab that currently holds the focus
  , UIStyle -> Style
tabNotFocusedStyle :: Style      -- ^ a tab that does not have the current focus

  , UIStyle -> Attributes
baseAttributes     :: Attributes -- ^ ground attributes for the main text views

  -- General styles applied to the ground attributes above
  , UIStyle -> Style
selectedStyle      :: Style      -- ^ the selected portion
  , UIStyle -> Style
eofStyle           :: Style      -- ^ empty file marker colours

  , UIStyle -> Style
errorStyle         :: Style      -- ^ indicates errors in text
  , UIStyle -> Style
hintStyle          :: Style      -- ^ search matches/paren matches/other hints
  , UIStyle -> Style
strongHintStyle    :: Style      -- ^ current search match

  -- Syntax highlighting styles
  , UIStyle -> Style
commentStyle       :: Style      -- ^ all comments
  , UIStyle -> Style
blockCommentStyle  :: Style      -- ^ additional only for block comments
  , UIStyle -> Style
keywordStyle       :: Style      -- ^ applied to language keywords
  , UIStyle -> Style
numberStyle        :: Style      -- ^ numbers
  , UIStyle -> Style
preprocessorStyle  :: Style      -- ^ preprocessor directive (often in Haskell or C)
  , UIStyle -> Style
stringStyle        :: Style      -- ^ constant strings
  , UIStyle -> Style
longStringStyle    :: Style      -- ^ additional style for long strings
  , UIStyle -> Style
typeStyle          :: Style      -- ^ type name (such as class in an OO language)
  , UIStyle -> Style
dataConstructorStyle
                       :: Style      -- ^ data constructor
  , UIStyle -> Style
importStyle        :: Style      -- ^ style of import names
  , UIStyle -> Style
builtinStyle       :: Style      -- ^ builtin things, e.g. Array in JavaScript
  , UIStyle -> Style
regexStyle         :: Style      -- ^ regular expressions
  , UIStyle -> Style
variableStyle      :: Style      -- ^ any standard variable (identifier)
  , UIStyle -> Style
operatorStyle      :: Style      -- ^ infix operators

  , UIStyle -> Style
quoteStyle         :: Style      -- ^ Style of a quotation (e.g. in template haskell)

  , UIStyle -> Style
makeFileAction     :: Style      -- ^ stuff that's passed to the shell in a Makefile
  , UIStyle -> Style
makeFileRuleHead   :: Style      -- ^ makefile rule headers
  }

-- | A StyleName determines what style to use, taking into account the
-- set of rendering preferences given by a 'UIStyle'.  Typically, style
-- names will be 'Style'-valued field names of 'UIStyle'.
type StyleName = UIStyle -> Style

withFg, withBg :: Color -> Style
-- | A style that sets the foreground.
withFg :: Color -> Style
withFg Color
c = (Attributes -> Attributes) -> Style
forall a. (a -> a) -> Endo a
Endo ((Attributes -> Attributes) -> Style)
-> (Attributes -> Attributes) -> Style
forall a b. (a -> b) -> a -> b
$ \Attributes
s -> Attributes
s { foreground :: Color
foreground = Color
c }
-- | A style that sets the background.
withBg :: Color -> Style
withBg Color
c = (Attributes -> Attributes) -> Style
forall a. (a -> a) -> Endo a
Endo ((Attributes -> Attributes) -> Style)
-> (Attributes -> Attributes) -> Style
forall a b. (a -> b) -> a -> b
$ \Attributes
s -> Attributes
s { background :: Color
background = Color
c }

withBd, withItlc, withUnderline, withReverse :: Bool -> Style
-- | A style that sets the font to bold
withBd :: Bool -> Style
withBd Bool
c = (Attributes -> Attributes) -> Style
forall a. (a -> a) -> Endo a
Endo ((Attributes -> Attributes) -> Style)
-> (Attributes -> Attributes) -> Style
forall a b. (a -> b) -> a -> b
$ \Attributes
s -> Attributes
s { bold :: Bool
bold = Bool
c }
-- | A style that sets the style to italics
withItlc :: Bool -> Style
withItlc Bool
c = (Attributes -> Attributes) -> Style
forall a. (a -> a) -> Endo a
Endo ((Attributes -> Attributes) -> Style)
-> (Attributes -> Attributes) -> Style
forall a b. (a -> b) -> a -> b
$ \Attributes
s -> Attributes
s { italic :: Bool
italic = Bool
c }
-- | A style that sets the style to underlined
withUnderline :: Bool -> Style
withUnderline Bool
c = (Attributes -> Attributes) -> Style
forall a. (a -> a) -> Endo a
Endo ((Attributes -> Attributes) -> Style)
-> (Attributes -> Attributes) -> Style
forall a b. (a -> b) -> a -> b
$ \Attributes
s -> Attributes
s { underline :: Bool
underline = Bool
c }
-- | A style that sets the style to underlined
withReverse :: Bool -> Style
withReverse Bool
c = (Attributes -> Attributes) -> Style
forall a. (a -> a) -> Endo a
Endo ((Attributes -> Attributes) -> Style)
-> (Attributes -> Attributes) -> Style
forall a b. (a -> b) -> a -> b
$ \Attributes
s -> Attributes
s { reverseAttr :: Bool
reverseAttr = Bool
c }

-- | The identity transform.
defaultStyle :: StyleName
defaultStyle :: UIStyle -> Style
defaultStyle = UIStyle -> Style
forall a. Monoid a => a
mempty

data Color
    = RGB {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
    | Default
    -- ^ The system-default color of the engine used.
    -- e.g. in Gtk this should pick whatever the user has chosen as default color
    -- (background or forground depending on usage) for the text.
    deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq,Eq Color
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
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 :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord,Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show)

-- | Convert a color to its text specification, as to be accepted by XParseColor
colorToText :: Color -> String
colorToText :: Color -> String
colorToText Color
Default = String
"default"
colorToText (RGB Word8
r Word8
g Word8
b) = (Char
'#'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
forall a. Integral a => a -> ShowS
showsHex Word8
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
forall a. Integral a => a -> ShowS
showsHex Word8
g ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ShowS
forall a. Integral a => a -> ShowS
showsHex Word8
b ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ []
    where showsHex :: a -> ShowS
showsHex a
x String
s = a -> Char
forall a. Integral a => a -> Char
showHex1 (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
16) Char -> ShowS
forall a. a -> [a] -> [a]
: a -> Char
forall a. Integral a => a -> Char
showHex1 (a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
16) Char -> ShowS
forall a. a -> [a] -> [a]
: String
s
          showHex1 :: a -> Char
showHex1 a
x | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 = Int -> Char
chr (Char -> Int
ord Char
'0' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x)
                     | Bool
otherwise = Int -> Char
chr (Char -> Int
ord Char
'A' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)

------------------------------------------------------------------------

-- Some simple colours

black, grey, lightGrey, darkred, red, darkgreen, green, brown, yellow :: Color
darkblue, blue, purple, magenta, darkcyan, cyan, white, brightwhite   :: Color
black :: Color
black       = Word8 -> Word8 -> Word8 -> Color
RGB Word8
0 Word8
0 Word8
0
grey :: Color
grey        = Word8 -> Word8 -> Word8 -> Color
RGB Word8
128 Word8
128 Word8
128
lightGrey :: Color
lightGrey   = Word8 -> Word8 -> Word8 -> Color
RGB Word8
100 Word8
100 Word8
100
darkred :: Color
darkred     = Word8 -> Word8 -> Word8 -> Color
RGB Word8
139 Word8
0 Word8
0
red :: Color
red         = Word8 -> Word8 -> Word8 -> Color
RGB Word8
255 Word8
0 Word8
0
darkgreen :: Color
darkgreen   = Word8 -> Word8 -> Word8 -> Color
RGB Word8
0 Word8
100 Word8
0
green :: Color
green       = Word8 -> Word8 -> Word8 -> Color
RGB Word8
0 Word8
128 Word8
0
brown :: Color
brown       = Word8 -> Word8 -> Word8 -> Color
RGB Word8
165 Word8
42 Word8
42
yellow :: Color
yellow      = Word8 -> Word8 -> Word8 -> Color
RGB Word8
255 Word8
255 Word8
0
darkblue :: Color
darkblue    = Word8 -> Word8 -> Word8 -> Color
RGB Word8
0 Word8
0 Word8
139
blue :: Color
blue        = Word8 -> Word8 -> Word8 -> Color
RGB Word8
0 Word8
0 Word8
255
purple :: Color
purple      = Word8 -> Word8 -> Word8 -> Color
RGB Word8
128 Word8
0 Word8
128
magenta :: Color
magenta     = Word8 -> Word8 -> Word8 -> Color
RGB Word8
255 Word8
0 Word8
255
darkcyan :: Color
darkcyan    = Word8 -> Word8 -> Word8 -> Color
RGB Word8
0 Word8
139 Word8
139
cyan :: Color
cyan        = Word8 -> Word8 -> Word8 -> Color
RGB Word8
0 Word8
255 Word8
255
white :: Color
white       = Word8 -> Word8 -> Word8 -> Color
RGB Word8
165 Word8
165 Word8
165
brightwhite :: Color
brightwhite = Word8 -> Word8 -> Word8 -> Color
RGB Word8
255 Word8
255 Word8
255