{-# OPTIONS_HADDOCK hide #-}
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
black, red, green, yellow, blue, magenta, cyan, white :: Color
black = ColorCode ANSI.Black
red = ColorCode ANSI.Red
green = ColorCode ANSI.Green
yellow = ColorCode ANSI.Yellow
blue = ColorCode ANSI.Blue
magenta = ColorCode ANSI.Magenta
cyan = ColorCode ANSI.Cyan
white = ColorCode ANSI.White
rgb :: Word8 -> Word8 -> Word8 -> Color
rgb r g b = ColorRGB (r, g, b)
colorAsANSI :: Color -> ANSI.Color
colorAsANSI (ColorCode c) = c
colorAsANSI (ColorRGB c) = nearestColor c ansiColorLocations
colorAsIndex256 :: Color -> Word8
colorAsIndex256 = \case
ColorCode c -> ANSI.xtermSystem ANSI.Dull c
ColorRGB c -> nearestColor c term256Locations
colorAsRGB :: Color -> Either ANSI.Color (C.Colour Float)
colorAsRGB = \case
ColorCode c -> Left c
ColorRGB (r, g, b) -> Right (C.sRGB24 r g b)
nearestColor ::
Bounded a =>
(Word8, Word8, Word8) ->
[(a, (Double, Double, Double))] ->
a
nearestColor (r, g, b) table =
case listToMaybe (sortColors $ distances table) of
Nothing -> minBound
Just (c, _) -> c
where
location :: (Double, Double, Double)
location = C.cieXYZView (C.sRGB24 r g b)
distance :: (Double, Double, Double) -> (Double, Double, Double) -> Double
distance (x1, y1, z1) (x2, y2, z2) = sqrt ((x ** 2) + (y ** 2) + (z ** 2))
where
x = x1 - x2
y = y1 - y2
z = z1 - z2
distances :: [(a, (Double, Double, Double))] -> [(a, Double)]
distances = map (second (distance location))
sortColors :: [(a, Double)] -> [(a, Double)]
sortColors = sortBy (comparing snd)
ansiColorLocations :: [(ANSI.Color, (Double, Double, Double))]
ansiColorLocations =
[ (ANSI.Black, (0.0, 0.0, 0.0)),
(ANSI.Red, (0.2518, 0.1298, 0.0118)),
(ANSI.Green, (0.2183, 0.4366, 0.0728)),
(ANSI.Yellow, (0.4701, 0.5664, 0.0846)),
(ANSI.Blue, (0.1543, 0.0617, 0.8126)),
(ANSI.Magenta, (0.3619, 0.1739, 0.592)),
(ANSI.Cyan, (0.3285, 0.4807, 0.653)),
(ANSI.White, (0.7447, 0.7835, 0.8532))
]
term256Locations :: [(Word8, (Double, Double, Double))]
term256Locations = zipWith (\c i -> (i, C.cieXYZView c)) colors [16 ..]
where
colors :: [C.Colour Double]
colors =
C.sRGB
<$> [0.0, 0.2 .. 1.0]
<*> [0.0, 0.2 .. 1.0]
<*> [0.0, 0.2 .. 1.0]