{-# OPTIONS_HADDOCK hide #-}
module Byline.Internal.Color
( Color (..),
black,
red,
green,
yellow,
blue,
magenta,
cyan,
white,
vivid,
dull,
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 :: Color
black = ColorIntensity -> Color -> Color
ColorCode ColorIntensity
ANSI.Dull Color
ANSI.Black
red :: Color
red = ColorIntensity -> Color -> Color
ColorCode ColorIntensity
ANSI.Dull Color
ANSI.Red
green :: Color
green = ColorIntensity -> Color -> Color
ColorCode ColorIntensity
ANSI.Dull Color
ANSI.Green
yellow :: Color
yellow = ColorIntensity -> Color -> Color
ColorCode ColorIntensity
ANSI.Dull Color
ANSI.Yellow
blue :: Color
blue = ColorIntensity -> Color -> Color
ColorCode ColorIntensity
ANSI.Dull Color
ANSI.Blue
magenta :: Color
magenta = ColorIntensity -> Color -> Color
ColorCode ColorIntensity
ANSI.Dull Color
ANSI.Magenta
cyan :: Color
cyan = ColorIntensity -> Color -> Color
ColorCode ColorIntensity
ANSI.Dull Color
ANSI.Cyan
white :: Color
white = ColorIntensity -> Color -> Color
ColorCode ColorIntensity
ANSI.Dull Color
ANSI.White
vivid :: Color -> Color
vivid :: Color -> Color
vivid (ColorCode ColorIntensity
_ Color
c) = ColorIntensity -> Color -> Color
ColorCode ColorIntensity
ANSI.Vivid Color
c
vivid Color
c = Color
c
dull :: Color -> Color
dull :: Color -> Color
dull (ColorCode ColorIntensity
_ Color
c) = ColorIntensity -> Color -> Color
ColorCode ColorIntensity
ANSI.Dull Color
c
dull Color
c = Color
c
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)
colorAsANSI :: Color -> ANSI.Color
colorAsANSI :: Color -> Color
colorAsANSI (ColorCode ColorIntensity
_ Color
c) = Color
c
colorAsANSI (ColorRGB (Word8, Word8, Word8)
c) = forall a.
Bounded a =>
(Word8, Word8, Word8) -> [(a, (Double, Double, Double))] -> a
nearestColor (Word8, Word8, Word8)
c [(Color, (Double, Double, Double))]
ansiColorLocations
colorAsIndex256 :: Color -> Word8
colorAsIndex256 :: Color -> Word8
colorAsIndex256 = \case
ColorCode ColorIntensity
i Color
c -> ColorIntensity -> Color -> Word8
ANSI.xtermSystem ColorIntensity
i Color
c
ColorRGB (Word8, Word8, Word8)
c -> forall a.
Bounded a =>
(Word8, Word8, Word8) -> [(a, (Double, Double, Double))] -> a
nearestColor (Word8, Word8, Word8)
c [(Word8, (Double, Double, Double))]
term256Locations
colorAsRGB :: Color -> Either (ANSI.ColorIntensity, ANSI.Color) (C.Colour Float)
colorAsRGB :: Color -> Either (ColorIntensity, Color) (Colour Float)
colorAsRGB = \case
ColorCode ColorIntensity
i Color
c -> forall a b. a -> Either a b
Left (ColorIntensity
i,Color
c)
ColorRGB (Word8
r, Word8
g, Word8
b) -> forall a b. b -> Either a b
Right (forall b.
(Ord b, Floating b) =>
Word8 -> Word8 -> Word8 -> Colour b
C.sRGB24 Word8
r Word8
g Word8
b)
nearestColor ::
Bounded a =>
(Word8, Word8, Word8) ->
[(a, (Double, Double, Double))] ->
a
nearestColor :: forall a.
Bounded a =>
(Word8, Word8, Word8) -> [(a, (Double, Double, Double))] -> a
nearestColor (Word8
r, Word8
g, Word8
b) [(a, (Double, Double, Double))]
table =
case forall a. [a] -> Maybe a
listToMaybe (forall a. [(a, Double)] -> [(a, Double)]
sortColors forall a b. (a -> b) -> a -> b
$ forall a. [(a, (Double, Double, Double))] -> [(a, Double)]
distances [(a, (Double, Double, Double))]
table) of
Maybe (a, Double)
Nothing -> forall a. Bounded a => a
minBound
Just (a
c, Double
_) -> a
c
where
location :: (Double, Double, Double)
location :: (Double, Double, Double)
location = forall a. Fractional a => Colour a -> (a, a, a)
C.cieXYZView (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) = forall a. Floating a => a -> a
sqrt ((Double
x forall a. Floating a => a -> a -> a
** Double
2) forall a. Num a => a -> a -> a
+ (Double
y forall a. Floating a => a -> a -> a
** Double
2) forall a. Num a => a -> a -> a
+ (Double
z forall a. Floating a => a -> a -> a
** Double
2))
where
x :: Double
x = Double
x1 forall a. Num a => a -> a -> a
- Double
x2
y :: Double
y = Double
y1 forall a. Num a => a -> a -> a
- Double
y2
z :: Double
z = Double
z1 forall a. Num a => a -> a -> a
- Double
z2
distances :: [(a, (Double, Double, Double))] -> [(a, Double)]
distances :: forall a. [(a, (Double, Double, Double))] -> [(a, Double)]
distances = forall a b. (a -> b) -> [a] -> [b]
map (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 :: forall a. [(a, Double)] -> [(a, Double)]
sortColors = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> b
snd)
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))
]
term256Locations :: [(Word8, (Double, Double, Double))]
term256Locations :: [(Word8, (Double, Double, Double))]
term256Locations = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Colour Double
c Word8
i -> (Word8
i, 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 =
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
C.sRGB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0.0, Double
0.2 .. Double
1.0]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Double
0.0, Double
0.2 .. Double
1.0]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Double
0.0, Double
0.2 .. Double
1.0]