{-# OPTIONS_HADDOCK hide #-}

-- |
--
-- Copyright:
--   This file is part of the package byline. It is subject to the
--   license terms in the LICENSE file found in the top-level
--   directory of this distribution and at:
--
--     https://github.com/pjones/byline
--
--   No part of this package, including this file, may be copied,
--   modified, propagated, or distributed except according to the
--   terms contained in the LICENSE file.
--
-- License: BSD-2-Clause
module Byline.Internal.Color
  ( Color (..),
    black,
    red,
    green,
    yellow,
    blue,
    magenta,
    cyan,
    white,
    rgb,
    colorAsANSI,
    colorAsIndex256,
    colorAsRGB,
    nearestColor,
    term256Locations,
  )
where

import Byline.Internal.Types
import qualified Data.Colour.CIE as C
import qualified Data.Colour.SRGB as C
import qualified System.Console.ANSI as ANSI

-- | Standard ANSI color by name.
--
-- @since 1.0.0.0
black, red, green, yellow, blue, magenta, cyan, white :: Color
black :: Color
black = Color -> Color
ColorCode Color
ANSI.Black
red :: Color
red = Color -> Color
ColorCode Color
ANSI.Red
green :: Color
green = Color -> Color
ColorCode Color
ANSI.Green
yellow :: Color
yellow = Color -> Color
ColorCode Color
ANSI.Yellow
blue :: Color
blue = Color -> Color
ColorCode Color
ANSI.Blue
magenta :: Color
magenta = Color -> Color
ColorCode Color
ANSI.Magenta
cyan :: Color
cyan = Color -> Color
ColorCode Color
ANSI.Cyan
white :: Color
white = Color -> Color
ColorCode Color
ANSI.White

-- | Specify a color using a RGB triplet where each component is in
-- the range @[0 .. 255]@.  The actual rendered color will depend on
-- the terminal.
--
-- If the terminal advertises that it supports 256 colors, the color
-- given to this function will be converted to the nearest color in
-- the 216-color pallet supported by the terminal.  (216 colors
-- because the first 16 are the standard colors and the last 24 are
-- grayscale entries.)
--
-- However, if the terminal doesn't support extra colors, or doesn't
-- have a @TERMINFO@ entry (e.g., Windows) then the nearest standard
-- color will be chosen.
--
-- Nearest colors are calculated using their CIE distance from one
-- another.
--
-- See also:
--
--   * <http://en.wikipedia.org/wiki/ANSI_escape_code>
--   * <http://en.wikipedia.org/wiki/Color_difference>
--
-- @since 1.0.0.0
rgb :: Word8 -> Word8 -> Word8 -> Color
rgb :: Word8 -> Word8 -> Word8 -> Color
rgb Word8
r Word8
g Word8
b = (Word8, Word8, Word8) -> Color
ColorRGB (Word8
r, Word8
g, Word8
b)

-- | Convert a Byline color to an ANSI color.
--
-- @since 1.0.0.0
colorAsANSI :: Color -> ANSI.Color
colorAsANSI :: Color -> Color
colorAsANSI (ColorCode Color
c) = Color
c
colorAsANSI (ColorRGB (Word8, Word8, Word8)
c) = (Word8, Word8, Word8)
-> [(Color, (Double, Double, Double))] -> Color
forall a.
Bounded a =>
(Word8, Word8, Word8) -> [(a, (Double, Double, Double))] -> a
nearestColor (Word8, Word8, Word8)
c [(Color, (Double, Double, Double))]
ansiColorLocations

-- | Convert a Byline color to an index into a terminal 256-color palette.
--
-- @since 1.0.0.0
colorAsIndex256 :: Color -> Word8
colorAsIndex256 :: Color -> Word8
colorAsIndex256 = \case
  ColorCode Color
c -> ColorIntensity -> Color -> Word8
ANSI.xtermSystem ColorIntensity
ANSI.Dull Color
c
  ColorRGB (Word8, Word8, Word8)
c -> (Word8, Word8, Word8)
-> [(Word8, (Double, Double, Double))] -> Word8
forall a.
Bounded a =>
(Word8, Word8, Word8) -> [(a, (Double, Double, Double))] -> a
nearestColor (Word8, Word8, Word8)
c [(Word8, (Double, Double, Double))]
term256Locations

-- | Convert a Byline color to a 'C.Colour'.  If the color is
-- specified using an ANSI color name then return that color code
-- instead.  This allows the terminal to pick the color on its own.
--
-- @since 1.0.0.0
colorAsRGB :: Color -> Either ANSI.Color (C.Colour Float)
colorAsRGB :: Color -> Either Color (Colour Float)
colorAsRGB = \case
  ColorCode Color
c -> Color -> Either Color (Colour Float)
forall a b. a -> Either a b
Left Color
c
  ColorRGB (Word8
r, Word8
g, Word8
b) -> Colour Float -> Either Color (Colour Float)
forall a b. b -> Either a b
Right (Word8 -> Word8 -> Word8 -> Colour Float
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
C.sRGB24 Word8
r Word8
g Word8
b)

-- | Find the nearest color given a full RGB color.
--
-- @since 1.0.0.0
nearestColor ::
  Bounded a =>
  -- | Original color.
  (Word8, Word8, Word8) ->
  -- | List of colors and locations.
  [(a, (Double, Double, Double))] ->
  -- | Destination color.
  a
nearestColor :: (Word8, Word8, Word8) -> [(a, (Double, Double, Double))] -> a
nearestColor (Word8
r, Word8
g, Word8
b) [(a, (Double, Double, Double))]
table =
  case [(a, Double)] -> Maybe (a, Double)
forall a. [a] -> Maybe a
listToMaybe ([(a, Double)] -> [(a, Double)]
forall a. [(a, Double)] -> [(a, Double)]
sortColors ([(a, Double)] -> [(a, Double)]) -> [(a, Double)] -> [(a, Double)]
forall a b. (a -> b) -> a -> b
$ [(a, (Double, Double, Double))] -> [(a, Double)]
forall a. [(a, (Double, Double, Double))] -> [(a, Double)]
distances [(a, (Double, Double, Double))]
table) of
    Maybe (a, Double)
Nothing -> a
forall a. Bounded a => a
minBound -- Should never happen.
    Just (a
c, Double
_) -> a
c
  where
    location :: (Double, Double, Double)
    location :: (Double, Double, Double)
location = Colour Double -> (Double, Double, Double)
forall a. Fractional a => Colour a -> (a, a, a)
C.cieXYZView (Word8 -> Word8 -> Word8 -> Colour Double
forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
C.sRGB24 Word8
r Word8
g Word8
b)
    distance :: (Double, Double, Double) -> (Double, Double, Double) -> Double
    distance :: (Double, Double, Double) -> (Double, Double, Double) -> Double
distance (Double
x1, Double
y1, Double
z1) (Double
x2, Double
y2, Double
z2) = Double -> Double
forall a. Floating a => a -> a
sqrt ((Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
y Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
z Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2))
      where
        x :: Double
x = Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x2
        y :: Double
y = Double
y1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y2
        z :: Double
z = Double
z1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
z2
    distances :: [(a, (Double, Double, Double))] -> [(a, Double)]
    distances :: [(a, (Double, Double, Double))] -> [(a, Double)]
distances = ((a, (Double, Double, Double)) -> (a, Double))
-> [(a, (Double, Double, Double))] -> [(a, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (((Double, Double, Double) -> Double)
-> (a, (Double, Double, Double)) -> (a, Double)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Double, Double, Double) -> (Double, Double, Double) -> Double
distance (Double, Double, Double)
location))
    sortColors :: [(a, Double)] -> [(a, Double)]
    sortColors :: [(a, Double)] -> [(a, Double)]
sortColors = ((a, Double) -> (a, Double) -> Ordering)
-> [(a, Double)] -> [(a, Double)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((a, Double) -> Double) -> (a, Double) -> (a, Double) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, Double) -> Double
forall a b. (a, b) -> b
snd)

-- | Get the CIE locations for the standard ANSI colors.
--
-- Locations are based on the default xterm colors.  See also:
--
--  * <http://en.wikipedia.org/wiki/ANSI_escape_code>
--  * <http://en.wikipedia.org/wiki/Color_difference>
--
-- @since 1.0.0.0
ansiColorLocations :: [(ANSI.Color, (Double, Double, Double))]
ansiColorLocations :: [(Color, (Double, Double, Double))]
ansiColorLocations =
  [ (Color
ANSI.Black, (Double
0.0, Double
0.0, Double
0.0)),
    (Color
ANSI.Red, (Double
0.2518, Double
0.1298, Double
0.0118)),
    (Color
ANSI.Green, (Double
0.2183, Double
0.4366, Double
0.0728)),
    (Color
ANSI.Yellow, (Double
0.4701, Double
0.5664, Double
0.0846)),
    (Color
ANSI.Blue, (Double
0.1543, Double
0.0617, Double
0.8126)),
    (Color
ANSI.Magenta, (Double
0.3619, Double
0.1739, Double
0.592)),
    (Color
ANSI.Cyan, (Double
0.3285, Double
0.4807, Double
0.653)),
    (Color
ANSI.White, (Double
0.7447, Double
0.7835, Double
0.8532))
  ]

-- | All of the allowed colors for 256 color terminals.
--
-- @since 1.0.0.0
term256Locations :: [(Word8, (Double, Double, Double))]
term256Locations :: [(Word8, (Double, Double, Double))]
term256Locations = (Colour Double -> Word8 -> (Word8, (Double, Double, Double)))
-> [Colour Double]
-> [Word8]
-> [(Word8, (Double, Double, Double))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Colour Double
c Word8
i -> (Word8
i, Colour Double -> (Double, Double, Double)
forall a. Fractional a => Colour a -> (a, a, a)
C.cieXYZView Colour Double
c)) [Colour Double]
colors [Word8
16 ..]
  where
    colors :: [C.Colour Double]
    colors :: [Colour Double]
colors =
      Double -> Double -> Double -> Colour Double
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
C.sRGB
        (Double -> Double -> Double -> Colour Double)
-> [Double] -> [Double -> Double -> Colour Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0.0, Double
0.2 .. Double
1.0]
        [Double -> Double -> Colour Double]
-> [Double] -> [Double -> Colour Double]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Double
0.0, Double
0.2 .. Double
1.0]
        [Double -> Colour Double] -> [Double] -> [Colour Double]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Double
0.0, Double
0.2 .. Double
1.0]