{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# 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-2025
-- 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.List.NonEmpty
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 $mColorX :: forall {r} {e}. Color X e -> (e -> r) -> ((# #) -> r) -> r
$bColorX :: forall e. e -> Color X e
ColorX y = X y
{-# COMPLETE ColorX #-}

-- | Constructor for @X@ with alpha channel.
pattern ColorXA :: e -> e -> Color (Alpha X) e
pattern $mColorXA :: forall {r} {e}.
Color (Alpha X) e -> (e -> e -> r) -> ((# #) -> r) -> r
$bColorXA :: forall e. e -> e -> Color (Alpha X) e
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
  type ChannelCount X = 1
  channelCount :: Proxy (Color X e) -> Word8
channelCount Proxy (Color X e)
_ = Word8
1
  {-# INLINE channelCount #-}
  channelNames :: Proxy (Color X e) -> NonEmpty String
channelNames Proxy (Color X e)
_ = String
"Gray" String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| []
  channelColors :: Proxy (Color X e) -> NonEmpty (V3 Word8)
channelColors Proxy (Color X e)
_ = Word8 -> Word8 -> Word8 -> V3 Word8
forall a. a -> a -> a -> V3 a
V3 Word8
0x80 Word8
0x80 Word8
0x80 V3 Word8 -> [V3 Word8] -> NonEmpty (V3 Word8)
forall a. a -> [a] -> NonEmpty a
:| []
  toComponents :: Color X e -> Components X e
toComponents (X e
y) = e
Components X e
y
  {-# INLINE toComponents #-}
  fromComponents :: Components X e -> Color X e
fromComponents = e -> Color X e
Components X e -> Color X e
forall e. e -> Color X e
X
  {-# INLINE fromComponents #-}

-- | `X` color model
instance Functor (Color X) where
  fmap :: forall a b. (a -> b) -> Color X a -> Color X b
fmap a -> b
f (X a
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 :: forall e. e -> Color X e
pure = a -> Color X a
forall e. e -> Color X e
X
  {-# INLINE pure #-}
  (X a -> b
fy) <*> :: forall a b. Color X (a -> b) -> Color X a -> Color X b
<*> (X a
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 :: forall a b. (a -> b -> b) -> b -> Color X a -> b
foldr a -> b -> b
f !b
z (X a
y) = a -> b -> b
f a
y b
z
  {-# INLINE foldr #-}

-- | `X` color model
instance Traversable (Color X) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Color X a -> f (Color X b)
traverse a -> f b
f (X a
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 :: forall e e'.
(Elevator e', Elevator e, RealFloat e) =>
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
forall a b. Coercible a b => a -> b
coerce ((e' -> e) -> Color RGB e' -> Color RGB e
forall a b. (a -> b) -> Color RGB a -> Color RGB b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e' -> e
forall a. (Elevator a, RealFloat a) => e' -> a
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
forall a b. Coercible a b => a -> b
coerce Weights e
weights)
{-# INLINE rgb2y #-}

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