{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
-- |
-- Module      : Graphics.Color.Model.X
-- Copyright   : (c) Alexey Kuleshevich 2018-2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Graphics.Color.Model.X
  ( X
  -- * Constructors for X color model.
  , pattern ColorX
  , pattern ColorXA
  , Color(X)
  , Weights(..)
  , rgb2y
  ) where

import Data.Coerce
import Foreign.Storable
import Graphics.Color.Model.Internal
import Graphics.Color.Model.RGB

-------------
--- X ---
-------------

-- | A color with a single channel, most likely luminance
data X

-- | A single channel color `X`
newtype instance Color X e = X e

-- | Constructor for @X@
pattern ColorX :: e -> Color X e
pattern $bColorX :: e -> Color X e
$mColorX :: forall r e. Color X e -> (e -> r) -> (Void# -> r) -> r
ColorX y = X y
{-# COMPLETE ColorX #-}

-- | Constructor for @X@ with alpha channel.
pattern ColorXA :: e -> e -> Color (Alpha X) e
pattern $bColorXA :: e -> e -> Color (Alpha X) e
$mColorXA :: forall r e. Color (Alpha X) e -> (e -> e -> r) -> (Void# -> r) -> r
ColorXA y a = Alpha (X y) a
{-# COMPLETE ColorXA #-}

-- | `X` color model
deriving instance Eq e => Eq (Color X e)
-- | `X` color model
deriving instance Ord e => Ord (Color X e)
-- | `X` color model
deriving instance Storable e => Storable (Color X e)


-- | `X` color model
instance Elevator e => Show (Color X e) where
  showsPrec :: Int -> Color X e -> ShowS
showsPrec Int
_ = Color X e -> ShowS
forall cs e. ColorModel cs e => Color cs e -> ShowS
showsColorModel

-- | `X` color model
instance Elevator e => ColorModel X e where
  type Components X e = e
  toComponents :: Color X e -> Components X e
toComponents (X y) = e
Components X e
y
  {-# INLINE toComponents #-}
  fromComponents :: Components X e -> Color X e
fromComponents = Components X e -> Color X e
forall e. e -> Color X e
X
  {-# INLINE fromComponents #-}

-- | `X` color model
instance Functor (Color X) where
  fmap :: (a -> b) -> Color X a -> Color X b
fmap a -> b
f (X y) = b -> Color X b
forall e. e -> Color X e
X (a -> b
f a
y)
  {-# INLINE fmap #-}

-- | `X` color model
instance Applicative (Color X) where
  pure :: a -> Color X a
pure = a -> Color X a
forall e. e -> Color X e
X
  {-# INLINE pure #-}
  (X fy) <*> :: Color X (a -> b) -> Color X a -> Color X b
<*> (X y) = b -> Color X b
forall e. e -> Color X e
X (a -> b
fy a
y)
  {-# INLINE (<*>) #-}

-- | `X` color model
instance Foldable (Color X) where
  foldr :: (a -> b -> b) -> b -> Color X a -> b
foldr a -> b -> b
f !b
z (X y) = a -> b -> b
f a
y b
z
  {-# INLINE foldr #-}

-- | `X` color model
instance Traversable (Color X) where
  traverse :: (a -> f b) -> Color X a -> f (Color X b)
traverse a -> f b
f (X y) = b -> Color X b
forall e. e -> Color X e
X (b -> Color X b) -> f b -> f (Color X b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
y
  {-# INLINE traverse #-}

-- | Convert an RGB color model to a single channel by using the supplied weights
--
-- @since 0.1.0
rgb2y ::
     forall e e'. (Elevator e', Elevator e, RealFloat e)
  => Color RGB e'
  -> Weights e
  -> Color X e
rgb2y :: Color RGB e' -> Weights e -> Color X e
rgb2y Color RGB e'
rgb Weights e
weights =
  e -> Color X e
forall e. e -> Color X e
X (Color RGB e -> V3 e
coerce ((e' -> e) -> Color RGB e' -> Color RGB e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e' -> e
forall e a. (Elevator e, Elevator a, RealFloat a) => e -> a
toRealFloat Color RGB e'
rgb :: Color RGB e) V3 e -> V3 e -> e
forall a. Num a => V3 a -> V3 a -> a
`dotProduct` Weights e -> V3 e
coerce Weights e
weights)
{-# INLINE rgb2y #-}

-- | Weights imposed on individual channels of a 3-component color
--
-- @since 0.1.0
newtype Weights e = Weights
  { Weights e -> V3 e
unWeights :: V3 e
  } deriving (Weights e -> Weights e -> Bool
(Weights e -> Weights e -> Bool)
-> (Weights e -> Weights e -> Bool) -> Eq (Weights e)
forall e. Eq e => Weights e -> Weights e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Weights e -> Weights e -> Bool
$c/= :: forall e. Eq e => Weights e -> Weights e -> Bool
== :: Weights e -> Weights e -> Bool
$c== :: forall e. Eq e => Weights e -> Weights e -> Bool
Eq, Integer -> Weights e
Weights e -> Weights e
Weights e -> Weights e -> Weights e
(Weights e -> Weights e -> Weights e)
-> (Weights e -> Weights e -> Weights e)
-> (Weights e -> Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Integer -> Weights e)
-> Num (Weights e)
forall e. Num e => Integer -> Weights e
forall e. Num e => Weights e -> Weights e
forall e. Num e => Weights e -> Weights e -> Weights e
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Weights e
$cfromInteger :: forall e. Num e => Integer -> Weights e
signum :: Weights e -> Weights e
$csignum :: forall e. Num e => Weights e -> Weights e
abs :: Weights e -> Weights e
$cabs :: forall e. Num e => Weights e -> Weights e
negate :: Weights e -> Weights e
$cnegate :: forall e. Num e => Weights e -> Weights e
* :: Weights e -> Weights e -> Weights e
$c* :: forall e. Num e => Weights e -> Weights e -> Weights e
- :: Weights e -> Weights e -> Weights e
$c- :: forall e. Num e => Weights e -> Weights e -> Weights e
+ :: Weights e -> Weights e -> Weights e
$c+ :: forall e. Num e => Weights e -> Weights e -> Weights e
Num, Int -> Weights e -> ShowS
[Weights e] -> ShowS
Weights e -> String
(Int -> Weights e -> ShowS)
-> (Weights e -> String)
-> ([Weights e] -> ShowS)
-> Show (Weights e)
forall e. Elevator e => Int -> Weights e -> ShowS
forall e. Elevator e => [Weights e] -> ShowS
forall e. Elevator e => Weights e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Weights e] -> ShowS
$cshowList :: forall e. Elevator e => [Weights e] -> ShowS
show :: Weights e -> String
$cshow :: forall e. Elevator e => Weights e -> String
showsPrec :: Int -> Weights e -> ShowS
$cshowsPrec :: forall e. Elevator e => Int -> Weights e -> ShowS
Show, Num (Weights e)
Num (Weights e)
-> (Weights e -> Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Rational -> Weights e)
-> Fractional (Weights e)
Rational -> Weights e
Weights e -> Weights e
Weights e -> Weights e -> Weights e
forall e. Fractional e => Num (Weights e)
forall e. Fractional e => Rational -> Weights e
forall e. Fractional e => Weights e -> Weights e
forall e. Fractional e => Weights e -> Weights e -> Weights e
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Weights e
$cfromRational :: forall e. Fractional e => Rational -> Weights e
recip :: Weights e -> Weights e
$crecip :: forall e. Fractional e => Weights e -> Weights e
/ :: Weights e -> Weights e -> Weights e
$c/ :: forall e. Fractional e => Weights e -> Weights e -> Weights e
$cp1Fractional :: forall e. Fractional e => Num (Weights e)
Fractional, Fractional (Weights e)
Weights e
Fractional (Weights e)
-> Weights e
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e -> Weights e)
-> (Weights e -> Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> (Weights e -> Weights e)
-> Floating (Weights e)
Weights e -> Weights e
Weights e -> Weights e -> Weights e
forall e. Floating e => Fractional (Weights e)
forall e. Floating e => Weights e
forall e. Floating e => Weights e -> Weights e
forall e. Floating e => Weights e -> Weights e -> Weights e
forall a.
Fractional a
-> a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
log1mexp :: Weights e -> Weights e
$clog1mexp :: forall e. Floating e => Weights e -> Weights e
log1pexp :: Weights e -> Weights e
$clog1pexp :: forall e. Floating e => Weights e -> Weights e
expm1 :: Weights e -> Weights e
$cexpm1 :: forall e. Floating e => Weights e -> Weights e
log1p :: Weights e -> Weights e
$clog1p :: forall e. Floating e => Weights e -> Weights e
atanh :: Weights e -> Weights e
$catanh :: forall e. Floating e => Weights e -> Weights e
acosh :: Weights e -> Weights e
$cacosh :: forall e. Floating e => Weights e -> Weights e
asinh :: Weights e -> Weights e
$casinh :: forall e. Floating e => Weights e -> Weights e
tanh :: Weights e -> Weights e
$ctanh :: forall e. Floating e => Weights e -> Weights e
cosh :: Weights e -> Weights e
$ccosh :: forall e. Floating e => Weights e -> Weights e
sinh :: Weights e -> Weights e
$csinh :: forall e. Floating e => Weights e -> Weights e
atan :: Weights e -> Weights e
$catan :: forall e. Floating e => Weights e -> Weights e
acos :: Weights e -> Weights e
$cacos :: forall e. Floating e => Weights e -> Weights e
asin :: Weights e -> Weights e
$casin :: forall e. Floating e => Weights e -> Weights e
tan :: Weights e -> Weights e
$ctan :: forall e. Floating e => Weights e -> Weights e
cos :: Weights e -> Weights e
$ccos :: forall e. Floating e => Weights e -> Weights e
sin :: Weights e -> Weights e
$csin :: forall e. Floating e => Weights e -> Weights e
logBase :: Weights e -> Weights e -> Weights e
$clogBase :: forall e. Floating e => Weights e -> Weights e -> Weights e
** :: Weights e -> Weights e -> Weights e
$c** :: forall e. Floating e => Weights e -> Weights e -> Weights e
sqrt :: Weights e -> Weights e
$csqrt :: forall e. Floating e => Weights e -> Weights e
log :: Weights e -> Weights e
$clog :: forall e. Floating e => Weights e -> Weights e
exp :: Weights e -> Weights e
$cexp :: forall e. Floating e => Weights e -> Weights e
pi :: Weights e
$cpi :: forall e. Floating e => Weights e
$cp1Floating :: forall e. Floating e => Fractional (Weights e)
Floating, a -> Weights b -> Weights a
(a -> b) -> Weights a -> Weights b
(forall a b. (a -> b) -> Weights a -> Weights b)
-> (forall a b. a -> Weights b -> Weights a) -> Functor Weights
forall a b. a -> Weights b -> Weights a
forall a b. (a -> b) -> Weights a -> Weights b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Weights b -> Weights a
$c<$ :: forall a b. a -> Weights b -> Weights a
fmap :: (a -> b) -> Weights a -> Weights b
$cfmap :: forall a b. (a -> b) -> Weights a -> Weights b
Functor)