module Draw.Color.Schemes.Internal.Common (
      RGB(..)
    , rgbFF
    , toColor
    , clamped
    , cyclic
    , discreteCyclic
) where



import           Data.Ord.Extended
import           Data.Vector       (Vector, (!))
import qualified Data.Vector       as V

import Draw.Color
import Numerics.Interpolation



data RGB = RGB !Double !Double !Double
    deriving (RGB -> RGB -> Bool
(RGB -> RGB -> Bool) -> (RGB -> RGB -> Bool) -> Eq RGB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RGB -> RGB -> Bool
== :: RGB -> RGB -> Bool
$c/= :: RGB -> RGB -> Bool
/= :: RGB -> RGB -> Bool
Eq, Eq RGB
Eq RGB
-> (RGB -> RGB -> Ordering)
-> (RGB -> RGB -> Bool)
-> (RGB -> RGB -> Bool)
-> (RGB -> RGB -> Bool)
-> (RGB -> RGB -> Bool)
-> (RGB -> RGB -> RGB)
-> (RGB -> RGB -> RGB)
-> Ord RGB
RGB -> RGB -> Bool
RGB -> RGB -> Ordering
RGB -> RGB -> RGB
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
$ccompare :: RGB -> RGB -> Ordering
compare :: RGB -> RGB -> Ordering
$c< :: RGB -> RGB -> Bool
< :: RGB -> RGB -> Bool
$c<= :: RGB -> RGB -> Bool
<= :: RGB -> RGB -> Bool
$c> :: RGB -> RGB -> Bool
> :: RGB -> RGB -> Bool
$c>= :: RGB -> RGB -> Bool
>= :: RGB -> RGB -> Bool
$cmax :: RGB -> RGB -> RGB
max :: RGB -> RGB -> RGB
$cmin :: RGB -> RGB -> RGB
min :: RGB -> RGB -> RGB
Ord, Int -> RGB -> ShowS
[RGB] -> ShowS
RGB -> String
(Int -> RGB -> ShowS)
-> (RGB -> String) -> ([RGB] -> ShowS) -> Show RGB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RGB -> ShowS
showsPrec :: Int -> RGB -> ShowS
$cshow :: RGB -> String
show :: RGB -> String
$cshowList :: [RGB] -> ShowS
showList :: [RGB] -> ShowS
Show)

toColor :: RGB -> Color Double
toColor :: RGB -> Color Double
toColor (RGB Double
r Double
g Double
b) = Double -> Double -> Double -> Color Double
rgb Double
r Double
g Double
b

-- | Simple way to enter hex-based RGB codes.
--
-- @'rgbFF' 0xab 0xcd 0xef@ is equivalent to @#0xabcdef@.
rgbFF :: Int -> Int -> Int -> RGB
rgbFF :: Int -> Int -> Int -> RGB
rgbFF Int
r Int
g Int
b = Double -> Double -> Double -> RGB
RGB (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
255) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
255) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
255)

-- | Pick a color from a continuous set, stopping at the beginning or end when the
-- query is out of bounds. When picking colors between the scheme’s values,
-- interpolate between them.
clamped :: Vector RGB -> Double -> RGB
clamped :: Vector RGB -> Double -> RGB
clamped = (Int -> Int -> Int) -> Vector RGB -> Double -> RGB
linearColorInterpolation (\Int
nColors Int
ix -> (Int, Int) -> Int -> Int
forall a. Ord a => (a, a) -> a -> a
clamp (Int
0,Int
nColorsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
ix)

-- | Pick a color from a continuous set, starting from the beginning again once
-- reaching the end. When picking colors between the scheme’s values, interpolate
-- between them.
cyclic :: Vector RGB -> Double -> RGB
cyclic :: Vector RGB -> Double -> RGB
cyclic = (Int -> Int -> Int) -> Vector RGB -> Double -> RGB
linearColorInterpolation (\Int
nColors Int
ix -> Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
ix Int
nColors)

-- | Pick a color from a discrete set, starting from the beginning again once reaching the end.
discreteCyclic :: Vector RGB -> Int -> RGB
discreteCyclic :: Vector RGB -> Int -> RGB
discreteCyclic Vector RGB
xs Int
i = Vector RGB
xs Vector RGB -> Int -> RGB
forall a. Vector a -> Int -> a
! Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
i (Vector RGB -> Int
forall a. Vector a -> Int
V.length Vector RGB
xs)

-- | Pick a color from a list of colors, interpolating linearly between neighbours
-- of we hit the color between two others.
linearColorInterpolation
    :: (Int -> Int -> Int) -- ^ Given an index and the number of colors, which actual
                           --   vector index should be used? See e.g. 'clamped'.
    -> Vector RGB          -- ^ Color data
    -> Double              -- ^ Value to pick color for
    -> RGB
linearColorInterpolation :: (Int -> Int -> Int) -> Vector RGB -> Double -> RGB
linearColorInterpolation Int -> Int -> Int
picker Vector RGB
xs = \Double
query ->
    let nColors :: Int
nColors = Vector RGB -> Int
forall a. Vector a -> Int
V.length Vector RGB
xs

        indexContinuous :: Double
indexContinuous = (Double, Double) -> (Double, Double) -> Double -> Double
forall vec.
VectorSpace vec =>
(Double, Double) -> (vec, vec) -> Double -> vec
lerp (Double
0,Double
1) (Double
0, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nColors Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double
query
        indexLo :: Int
indexLo = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
indexContinuous
        indexHi :: Int
indexHi = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
indexContinuous

        RGB Double
rLo Double
gLo Double
bLo = Vector RGB
xs Vector RGB -> Int -> RGB
forall a. Vector a -> Int -> a
! Int -> Int -> Int
picker Int
nColors Int
indexLo
        RGB Double
rHi Double
gHi Double
bHi = Vector RGB
xs Vector RGB -> Int -> RGB
forall a. Vector a -> Int -> a
! Int -> Int -> Int
picker Int
nColors Int
indexHi

        [Double
r,Double
g,Double
b] = do
            (Double
channelLo, Double
channelHi) <- [(Double
rLo, Double
rHi), (Double
gLo, Double
gHi), (Double
bLo, Double
bHi)]
            Double -> [Double]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> [Double]) -> Double -> [Double]
forall a b. (a -> b) -> a -> b
$ case Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
channelLo Double
channelHi of
                Ordering
EQ -> Double
channelLo
                Ordering
_  -> (Double, Double) -> (Double, Double) -> Double -> Double
forall vec.
VectorSpace vec =>
(Double, Double) -> (vec, vec) -> Double -> vec
lerp
                    (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
indexLo, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
indexHi)
                    (Double
channelLo, Double
channelHi)
                    Double
indexContinuous
    in Double -> Double -> Double -> RGB
RGB Double
r Double
g Double
b