{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Graphics.Vty.Attributes.Color
  ( Color(..)
  , ColorMode(..)

  -- * Detecting Terminal Color Support
  , detectColorMode

  -- ** Fixed Colors
  -- | Standard 8-color ANSI terminal color codes.
  --
  -- Note that these map to colors in the terminal's custom palette. For
  -- instance, `white` maps to whatever the terminal color theme uses for
  -- white.
  --
  -- Use these functions if you want to make apps that fit the terminal theme.
  -- If you want access to more/stronger colors use `rgbColor`
  , black
  , red
  , green
  , yellow
  , blue
  , magenta
  , cyan
  , white

  -- | Bright/Vivid variants of the standard 8-color ANSI
  , brightBlack
  , brightRed
  , brightGreen
  , brightYellow
  , brightBlue
  , brightMagenta
  , brightCyan
  , brightWhite
  -- ** Creating Colors From RGB
  , linearColor
  , srgbColor
  , rgbColor
  , color240
  , module Graphics.Vty.Attributes.Color240
  )
where

import Data.Word
import GHC.Generics
import Control.DeepSeq
import System.Environment (lookupEnv)

import qualified System.Console.Terminfo as Terminfo
import Control.Exception (catch)
import Data.Maybe

import Graphics.Vty.Attributes.Color240

-- | Abstract data type representing a color.
--
-- Currently the foreground and background color are specified as points
-- in either a:
--
--  * 16 color palette. Where the first 8 colors are equal to the 8
--  colors of the ISO 6429 (ANSI) 8 color palette and the second 8
--  colors are bright/vivid versions of the first 8 colors.
--
--  * 240 color palette. This palette is a regular sampling of the full
--  RGB colorspace for the first 224 colors. The remaining 16 colors is
--  a greyscale palette.
--
-- The 8 ISO 6429 (ANSI) colors are as follows:
--
--      0. black
--
--      1. red
--
--      2. green
--
--      3. yellow
--
--      4. blue
--
--      5. magenta
--
--      6. cyan
--
--      7. white
--
-- The mapping from points in the 240 color palette to colors actually
-- displayable by the terminal depends on the number of colors the
-- terminal claims to support. Which is usually determined by the
-- terminfo "colors" property. If this property is not being accurately
-- reported then the color reproduction will be incorrect.
--
-- If the terminal reports <= 16 colors then the 240 color palette
-- points are only mapped to the 8 color palette. I'm not sure of
-- the RGB points for the "bright" colors which is why they are not
-- addressable via the 240 color palette.
--
-- If the terminal reports > 16 colors then the 240 color palette
-- points are mapped to the nearest points in a ("color count" - 16)
-- subsampling of the 240 color palette.
--
-- All of this assumes the terminals are behaving similarly to xterm and
-- rxvt when handling colors. And that the individual colors have not
-- been remapped by the user. There may be a way to verify this through
-- terminfo but I don't know it.
--
-- Seriously, terminal color support is INSANE.
data Color = ISOColor !Word8 | Color240 !Word8 | RGBColor !Word8 !Word8 !Word8
    deriving ( Color -> Color -> Bool
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, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
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, ReadPrec [Color]
ReadPrec Color
Int -> ReadS Color
ReadS [Color]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Color]
$creadListPrec :: ReadPrec [Color]
readPrec :: ReadPrec Color
$creadPrec :: ReadPrec Color
readList :: ReadS [Color]
$creadList :: ReadS [Color]
readsPrec :: Int -> ReadS Color
$creadsPrec :: Int -> ReadS Color
Read, forall x. Rep Color x -> Color
forall x. Color -> Rep Color x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Color x -> Color
$cfrom :: forall x. Color -> Rep Color x
Generic, Color -> ()
forall a. (a -> ()) -> NFData a
rnf :: Color -> ()
$crnf :: Color -> ()
NFData )

data ColorMode
    = NoColor
    | ColorMode8
    | ColorMode16
    | ColorMode240 !Word8
    | FullColor
    deriving ( ColorMode -> ColorMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorMode -> ColorMode -> Bool
$c/= :: ColorMode -> ColorMode -> Bool
== :: ColorMode -> ColorMode -> Bool
$c== :: ColorMode -> ColorMode -> Bool
Eq, Int -> ColorMode -> ShowS
[ColorMode] -> ShowS
ColorMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorMode] -> ShowS
$cshowList :: [ColorMode] -> ShowS
show :: ColorMode -> String
$cshow :: ColorMode -> String
showsPrec :: Int -> ColorMode -> ShowS
$cshowsPrec :: Int -> ColorMode -> ShowS
Show )

detectColorMode :: String -> IO ColorMode
detectColorMode :: String -> IO ColorMode
detectColorMode String
termName' = do
    Maybe Terminal
term <- forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Terminal
Terminfo.setupTerm String
termName')
                  (\(SetupTermError
_ :: Terminfo.SetupTermError) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
    let getCap :: Capability b -> Maybe b
getCap Capability b
cap = Maybe Terminal
term forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Terminal
t -> forall a. Terminal -> Capability a -> Maybe a
Terminfo.getCapability Terminal
t Capability b
cap
        termColors :: Int
termColors = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ forall {b}. Capability b -> Maybe b
getCap (String -> Capability Int
Terminfo.tiGetNum String
"colors")
    Maybe String
colorterm <- String -> IO (Maybe String)
lookupEnv String
"COLORTERM"
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if
        | Int
termColors forall a. Ord a => a -> a -> Bool
<  Int
8               -> ColorMode
NoColor
        | Int
termColors forall a. Ord a => a -> a -> Bool
<  Int
16              -> ColorMode
ColorMode8
        | Int
termColors forall a. Eq a => a -> a -> Bool
== Int
16              -> ColorMode
ColorMode16
        | Int
termColors forall a. Ord a => a -> a -> Bool
<  Int
256             -> Word8 -> ColorMode
ColorMode240 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
termColors forall a. Num a => a -> a -> a
- Word8
16)
        | Maybe String
colorterm forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"truecolor" -> ColorMode
FullColor
        | Maybe String
colorterm forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
"24bit"     -> ColorMode
FullColor
        | Bool
otherwise                     -> Word8 -> ColorMode
ColorMode240 Word8
240

black, red, green, yellow, blue, magenta, cyan, white :: Color
black :: Color
black  = Word8 -> Color
ISOColor Word8
0
red :: Color
red    = Word8 -> Color
ISOColor Word8
1
green :: Color
green  = Word8 -> Color
ISOColor Word8
2
yellow :: Color
yellow = Word8 -> Color
ISOColor Word8
3
blue :: Color
blue   = Word8 -> Color
ISOColor Word8
4
magenta :: Color
magenta= Word8 -> Color
ISOColor Word8
5
cyan :: Color
cyan   = Word8 -> Color
ISOColor Word8
6
white :: Color
white  = Word8 -> Color
ISOColor Word8
7

brightBlack, brightRed, brightGreen, brightYellow :: Color
brightBlue, brightMagenta, brightCyan, brightWhite :: Color
brightBlack :: Color
brightBlack  = Word8 -> Color
ISOColor Word8
8
brightRed :: Color
brightRed    = Word8 -> Color
ISOColor Word8
9
brightGreen :: Color
brightGreen  = Word8 -> Color
ISOColor Word8
10
brightYellow :: Color
brightYellow = Word8 -> Color
ISOColor Word8
11
brightBlue :: Color
brightBlue   = Word8 -> Color
ISOColor Word8
12
brightMagenta :: Color
brightMagenta= Word8 -> Color
ISOColor Word8
13
brightCyan :: Color
brightCyan   = Word8 -> Color
ISOColor Word8
14
brightWhite :: Color
brightWhite  = Word8 -> Color
ISOColor Word8
15

-- | Create a color value from RGB values in the 0..255 range inclusive.
-- No transformation of the input values is done; a color is created
-- directly from the RGB values specified, unlike the 'srgbColor' and
-- 'color240' functions.
linearColor :: Integral i => i -> i -> i -> Color
linearColor :: forall i. Integral i => i -> i -> i -> Color
linearColor i
r i
g i
b = Word8 -> Word8 -> Word8 -> Color
RGBColor Word8
r' Word8
g' Word8
b'
    where
        r' :: Word8
r' = forall a b. (Integral a, Num b) => a -> b
fromIntegral (i -> i
clamp i
r) :: Word8
        g' :: Word8
g' = forall a b. (Integral a, Num b) => a -> b
fromIntegral (i -> i
clamp i
g) :: Word8
        b' :: Word8
b' = forall a b. (Integral a, Num b) => a -> b
fromIntegral (i -> i
clamp i
b) :: Word8
        clamp :: i -> i
clamp = forall a. Ord a => a -> a -> a
min i
255 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
max i
0

-- | Given RGB values in the range 0..255 inclusive, create a color
-- using the sRGB transformation described at
--
-- https://en.wikipedia.org/wiki/SRGB#The_reverse_transformation
srgbColor :: Integral i => i -> i -> i -> Color
srgbColor :: forall i. Integral i => i -> i -> i -> Color
srgbColor i
r i
g i
b =
    -- TODO: it may be worth translating this to a lookup table, as with color240
    let shrink :: a -> Double
shrink a
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n forall a. Fractional a => a -> a -> a
/ Double
255 :: Double
        -- called gamma^-1 in wiki
        gamma :: a -> a
gamma a
u
            | a
u forall a. Ord a => a -> a -> Bool
<= a
0.04045 = a
uforall a. Fractional a => a -> a -> a
/a
12.92
            | Bool
otherwise    = ((a
u forall a. Num a => a -> a -> a
+ a
0.055) forall a. Fractional a => a -> a -> a
/ a
1.055) forall a. Floating a => a -> a -> a
** a
2.4
        -- TODO: this is a slightly inaccurate conversion. is it worth doing proterly?
        expand :: a -> b
expand a
n = forall a b. (RealFrac a, Integral b) => a -> b
round (a
255 forall a. Num a => a -> a -> a
* a
n)
        convert :: i -> Word8
convert = forall {a} {b}. (RealFrac a, Integral b) => a -> b
expand forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Ord a, Floating a) => a -> a
gamma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Integral a => a -> Double
shrink
     in Word8 -> Word8 -> Word8 -> Color
RGBColor (i -> Word8
convert i
r) (i -> Word8
convert i
g) (i -> Word8
convert i
b)

color240 :: Integral i => i -> i -> i -> Color
color240 :: forall i. Integral i => i -> i -> i -> Color
color240 i
r i
g i
b = Word8 -> Color
Color240 (forall i. Integral i => i -> i -> i -> Word8
rgbColorToColor240 i
r i
g i
b)

-- | Create a Vty 'Color' (in the 240 color set) from an RGB triple.
-- This is a synonym for 'color240'. This function is lossy in the sense
-- that we only internally support 240 colors but the #RRGGBB format
-- supports 16^3 colors.
rgbColor :: Integral i => i -> i -> i -> Color
rgbColor :: forall i. Integral i => i -> i -> i -> Color
rgbColor = forall i. Integral i => i -> i -> i -> Color
color240