{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK hide, not-home #-}
-- |
-- Module      : Graphics.Pixel.Internal
-- Copyright   : (c) Alexey Kuleshevich 2019-2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Graphics.Pixel.Internal
  ( Pixel(..)
  , liftPixel
  , toPixel8
  , toPixel16
  , toPixel32
  , toPixel64
  , toPixelF
  , toPixelD
  , VU.MVector(MV_Pixel)
  , VU.Vector(V_Pixel)
  , module Graphics.Color.Model.Internal
  ) where

import Data.Coerce
import Control.DeepSeq (NFData)
import Graphics.Color.Model.Internal
import Foreign.Storable
import qualified Data.Vector.Generic as V
import qualified Data.Vector.Generic.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import Data.Default.Class (Default)

-- | Digital imaging is one of the most common places for a color to be used in. The
-- smallest element in any image is a pixel, which is defined by its color.
--
-- @since 0.1.0
newtype Pixel cs e = Pixel
  { Pixel cs e -> Color cs e
pixelColor :: Color cs e
  -- ^ Get to the underlying `Color`
  --
  -- @since 0.1.4
  }

deriving instance Eq (Color cs e) => Eq (Pixel cs e)
deriving instance Ord (Color cs e) => Ord (Pixel cs e)
deriving instance Num (Color cs e) => Num (Pixel cs e)
deriving instance Bounded (Color cs e) => Bounded (Pixel cs e)
deriving instance NFData (Color cs e) => NFData (Pixel cs e)
deriving instance Floating (Color cs e) => Floating (Pixel cs e)
deriving instance Fractional (Color cs e) => Fractional (Pixel cs e)
deriving instance Functor (Color cs) => Functor (Pixel cs)
deriving instance Applicative (Color cs) => Applicative (Pixel cs)
deriving instance Foldable (Color cs) => Foldable (Pixel cs)
deriving instance Traversable (Color cs) => Traversable (Pixel cs)
deriving instance Storable (Color cs e) => Storable (Pixel cs e)
deriving instance Default (Color cs e) => Default (Pixel cs e)
instance Show (Color cs e) => Show (Pixel cs e) where
  show :: Pixel cs e -> String
show = Color cs e -> String
forall a. Show a => a -> String
show (Color cs e -> String)
-> (Pixel cs e -> Color cs e) -> Pixel cs e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pixel cs e -> Color cs e
forall cs e. Pixel cs e -> Color cs e
pixelColor

-- | Unboxing of a `Pixel`.
instance ColorModel cs e => VU.Unbox (Pixel cs e)

newtype instance VU.MVector s (Pixel cs e) = MV_Pixel (VU.MVector s (Components cs e))

instance ColorModel cs e => VM.MVector VU.MVector (Pixel cs e) where
  basicLength :: MVector s (Pixel cs e) -> Int
basicLength (MV_Pixel mvec) = MVector s (Components cs e) -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VM.basicLength MVector s (Components cs e)
mvec
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: Int -> Int -> MVector s (Pixel cs e) -> MVector s (Pixel cs e)
basicUnsafeSlice Int
idx Int
len (MV_Pixel mvec) = MVector s (Components cs e) -> MVector s (Pixel cs e)
forall s cs e.
MVector s (Components cs e) -> MVector s (Pixel cs e)
MV_Pixel (Int
-> Int
-> MVector s (Components cs e)
-> MVector s (Components cs e)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VM.basicUnsafeSlice Int
idx Int
len MVector s (Components cs e)
mvec)
  {-# INLINE basicUnsafeSlice #-}
  basicOverlaps :: MVector s (Pixel cs e) -> MVector s (Pixel cs e) -> Bool
basicOverlaps (MV_Pixel mvec) (MV_Pixel mvec') = MVector s (Components cs e) -> MVector s (Components cs e) -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
VM.basicOverlaps MVector s (Components cs e)
mvec MVector s (Components cs e)
mvec'
  {-# INLINE basicOverlaps #-}
  basicUnsafeNew :: Int -> m (MVector (PrimState m) (Pixel cs e))
basicUnsafeNew Int
len = MVector (PrimState m) (Components cs e)
-> MVector (PrimState m) (Pixel cs e)
forall s cs e.
MVector s (Components cs e) -> MVector s (Pixel cs e)
MV_Pixel (MVector (PrimState m) (Components cs e)
 -> MVector (PrimState m) (Pixel cs e))
-> m (MVector (PrimState m) (Components cs e))
-> m (MVector (PrimState m) (Pixel cs e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) (Components cs e))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
VM.basicUnsafeNew Int
len
  {-# INLINE basicUnsafeNew #-}
  basicUnsafeReplicate :: Int -> Pixel cs e -> m (MVector (PrimState m) (Pixel cs e))
basicUnsafeReplicate Int
len Pixel cs e
val =
    MVector (PrimState m) (Components cs e)
-> MVector (PrimState m) (Pixel cs e)
forall s cs e.
MVector s (Components cs e) -> MVector s (Pixel cs e)
MV_Pixel (MVector (PrimState m) (Components cs e)
 -> MVector (PrimState m) (Pixel cs e))
-> m (MVector (PrimState m) (Components cs e))
-> m (MVector (PrimState m) (Pixel cs e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> Components cs e -> m (MVector (PrimState m) (Components cs e))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
VM.basicUnsafeReplicate Int
len (Color cs e -> Components cs e
forall cs e. ColorModel cs e => Color cs e -> Components cs e
toComponents (Pixel cs e -> Color cs e
coerce Pixel cs e
val))
  {-# INLINE basicUnsafeReplicate #-}
  basicUnsafeRead :: MVector (PrimState m) (Pixel cs e) -> Int -> m (Pixel cs e)
basicUnsafeRead (MV_Pixel mvec) Int
idx = Color cs e -> Pixel cs e
coerce (Color cs e -> Pixel cs e)
-> (Components cs e -> Color cs e) -> Components cs e -> Pixel cs e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Components cs e -> Color cs e
forall cs e. ColorModel cs e => Components cs e -> Color cs e
fromComponents (Components cs e -> Pixel cs e)
-> m (Components cs e) -> m (Pixel cs e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) (Components cs e)
-> Int -> m (Components cs e)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
VM.basicUnsafeRead MVector (PrimState m) (Components cs e)
mvec Int
idx
  {-# INLINE basicUnsafeRead #-}
  basicUnsafeWrite :: MVector (PrimState m) (Pixel cs e) -> Int -> Pixel cs e -> m ()
basicUnsafeWrite (MV_Pixel mvec) Int
idx Pixel cs e
val = MVector (PrimState m) (Components cs e)
-> Int -> Components cs e -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
VM.basicUnsafeWrite MVector (PrimState m) (Components cs e)
mvec Int
idx (Color cs e -> Components cs e
forall cs e. ColorModel cs e => Color cs e -> Components cs e
toComponents (Pixel cs e -> Color cs e
coerce Pixel cs e
val))
  {-# INLINE basicUnsafeWrite #-}
  basicClear :: MVector (PrimState m) (Pixel cs e) -> m ()
basicClear (MV_Pixel mvec) = MVector (PrimState m) (Components cs e) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VM.basicClear MVector (PrimState m) (Components cs e)
mvec
  {-# INLINE basicClear #-}
  basicSet :: MVector (PrimState m) (Pixel cs e) -> Pixel cs e -> m ()
basicSet (MV_Pixel mvec) Pixel cs e
val = MVector (PrimState m) (Components cs e) -> Components cs e -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
VM.basicSet MVector (PrimState m) (Components cs e)
mvec (Color cs e -> Components cs e
forall cs e. ColorModel cs e => Color cs e -> Components cs e
toComponents (Pixel cs e -> Color cs e
coerce Pixel cs e
val))
  {-# INLINE basicSet #-}
  basicUnsafeCopy :: MVector (PrimState m) (Pixel cs e)
-> MVector (PrimState m) (Pixel cs e) -> m ()
basicUnsafeCopy (MV_Pixel mvec) (MV_Pixel mvec') = MVector (PrimState m) (Components cs e)
-> MVector (PrimState m) (Components cs e) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
VM.basicUnsafeCopy MVector (PrimState m) (Components cs e)
mvec MVector (PrimState m) (Components cs e)
mvec'
  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeMove :: MVector (PrimState m) (Pixel cs e)
-> MVector (PrimState m) (Pixel cs e) -> m ()
basicUnsafeMove (MV_Pixel mvec) (MV_Pixel mvec') = MVector (PrimState m) (Components cs e)
-> MVector (PrimState m) (Components cs e) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
VM.basicUnsafeMove MVector (PrimState m) (Components cs e)
mvec MVector (PrimState m) (Components cs e)
mvec'
  {-# INLINE basicUnsafeMove #-}
  basicUnsafeGrow :: MVector (PrimState m) (Pixel cs e)
-> Int -> m (MVector (PrimState m) (Pixel cs e))
basicUnsafeGrow (MV_Pixel mvec) Int
len = MVector (PrimState m) (Components cs e)
-> MVector (PrimState m) (Pixel cs e)
forall s cs e.
MVector s (Components cs e) -> MVector s (Pixel cs e)
MV_Pixel (MVector (PrimState m) (Components cs e)
 -> MVector (PrimState m) (Pixel cs e))
-> m (MVector (PrimState m) (Components cs e))
-> m (MVector (PrimState m) (Pixel cs e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) (Components cs e)
-> Int -> m (MVector (PrimState m) (Components cs e))
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
VM.basicUnsafeGrow MVector (PrimState m) (Components cs e)
mvec Int
len
  {-# INLINE basicUnsafeGrow #-}
  basicInitialize :: MVector (PrimState m) (Pixel cs e) -> m ()
basicInitialize (MV_Pixel mvec) = MVector (PrimState m) (Components cs e) -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VM.basicInitialize MVector (PrimState m) (Components cs e)
mvec
  {-# INLINE basicInitialize #-}


newtype instance VU.Vector (Pixel cs e) = V_Pixel (VU.Vector (Components cs e))

instance (ColorModel cs e) => V.Vector VU.Vector (Pixel cs e) where
  basicUnsafeFreeze :: Mutable Vector (PrimState m) (Pixel cs e)
-> m (Vector (Pixel cs e))
basicUnsafeFreeze (MV_Pixel mvec) = Vector (Components cs e) -> Vector (Pixel cs e)
forall cs e. Vector (Components cs e) -> Vector (Pixel cs e)
V_Pixel (Vector (Components cs e) -> Vector (Pixel cs e))
-> m (Vector (Components cs e)) -> m (Vector (Pixel cs e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) (Components cs e)
-> m (Vector (Components cs e))
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
V.basicUnsafeFreeze MVector (PrimState m) (Components cs e)
Mutable Vector (PrimState m) (Components cs e)
mvec
  {-# INLINE basicUnsafeFreeze #-}
  basicUnsafeThaw :: Vector (Pixel cs e)
-> m (Mutable Vector (PrimState m) (Pixel cs e))
basicUnsafeThaw (V_Pixel vec) = MVector (PrimState m) (Components cs e)
-> MVector (PrimState m) (Pixel cs e)
forall s cs e.
MVector s (Components cs e) -> MVector s (Pixel cs e)
MV_Pixel (MVector (PrimState m) (Components cs e)
 -> MVector (PrimState m) (Pixel cs e))
-> m (MVector (PrimState m) (Components cs e))
-> m (MVector (PrimState m) (Pixel cs e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Components cs e)
-> m (Mutable Vector (PrimState m) (Components cs e))
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
V.basicUnsafeThaw Vector (Components cs e)
vec
  {-# INLINE basicUnsafeThaw #-}
  basicLength :: Vector (Pixel cs e) -> Int
basicLength (V_Pixel vec) = Vector (Components cs e) -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
V.basicLength Vector (Components cs e)
vec
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: Int -> Int -> Vector (Pixel cs e) -> Vector (Pixel cs e)
basicUnsafeSlice Int
idx Int
len (V_Pixel vec) = Vector (Components cs e) -> Vector (Pixel cs e)
forall cs e. Vector (Components cs e) -> Vector (Pixel cs e)
V_Pixel (Int -> Int -> Vector (Components cs e) -> Vector (Components cs e)
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
V.basicUnsafeSlice Int
idx Int
len Vector (Components cs e)
vec)
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeIndexM :: Vector (Pixel cs e) -> Int -> m (Pixel cs e)
basicUnsafeIndexM (V_Pixel vec) Int
idx = Color cs e -> Pixel cs e
coerce (Color cs e -> Pixel cs e)
-> (Components cs e -> Color cs e) -> Components cs e -> Pixel cs e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Components cs e -> Color cs e
forall cs e. ColorModel cs e => Components cs e -> Color cs e
fromComponents (Components cs e -> Pixel cs e)
-> m (Components cs e) -> m (Pixel cs e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Components cs e) -> Int -> m (Components cs e)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
V.basicUnsafeIndexM Vector (Components cs e)
vec Int
idx
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeCopy :: Mutable Vector (PrimState m) (Pixel cs e)
-> Vector (Pixel cs e) -> m ()
basicUnsafeCopy (MV_Pixel mvec) (V_Pixel vec) = Mutable Vector (PrimState m) (Components cs e)
-> Vector (Components cs e) -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
V.basicUnsafeCopy MVector (PrimState m) (Components cs e)
Mutable Vector (PrimState m) (Components cs e)
mvec Vector (Components cs e)
vec
  {-# INLINE basicUnsafeCopy #-}
  elemseq :: Vector (Pixel cs e) -> Pixel cs e -> b -> b
elemseq (V_Pixel vec) Pixel cs e
val = Vector (Components cs e) -> Components cs e -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
V.elemseq Vector (Components cs e)
vec (Color cs e -> Components cs e
forall cs e. ColorModel cs e => Color cs e -> Components cs e
toComponents (Pixel cs e -> Color cs e
coerce Pixel cs e
val))
  {-# INLINE elemseq #-}

-- | Apply a function to `Pixel`'s `Color`
--
-- @since 0.1.0
liftPixel :: (Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel :: (Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel Color cs e -> Color cs' e'
f = Color cs' e' -> Pixel cs' e'
coerce (Color cs' e' -> Pixel cs' e')
-> (Pixel cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color cs e -> Color cs' e'
f (Color cs e -> Color cs' e')
-> (Pixel cs e -> Color cs e) -> Pixel cs e -> Color cs' e'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pixel cs e -> Color cs e
coerce
{-# INLINE liftPixel #-}



-- Elevation

-- | Convert all channels of a pixel to 8bits each, while doing appropriate scaling. See
-- `Elevator`.
--
-- @since 0.1.0
toPixel8 :: ColorModel cs e => Pixel cs e -> Pixel cs Word8
toPixel8 :: Pixel cs e -> Pixel cs Word8
toPixel8 = (Color cs e -> Color cs Word8) -> Pixel cs e -> Pixel cs Word8
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel ((e -> Word8) -> Color cs e -> Color cs Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Word8
forall e. Elevator e => e -> Word8
toWord8)
{-# INLINE toPixel8 #-}

-- | Convert all channels of a pixel to 16bits each, while appropriate scaling. See
-- `Elevator`.
--
-- @since 0.1.0
toPixel16 :: ColorModel cs e => Pixel cs e -> Pixel cs Word16
toPixel16 :: Pixel cs e -> Pixel cs Word16
toPixel16 = (Color cs e -> Color cs Word16) -> Pixel cs e -> Pixel cs Word16
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel ((e -> Word16) -> Color cs e -> Color cs Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Word16
forall e. Elevator e => e -> Word16
toWord16)
{-# INLINE toPixel16 #-}


-- | Convert all channels of a pixel to 32bits each, while doing appropriate scaling. See
-- `Elevator`.
--
-- @since 0.1.0
toPixel32 :: ColorModel cs e => Pixel cs e -> Pixel cs Word32
toPixel32 :: Pixel cs e -> Pixel cs Word32
toPixel32 = (Color cs e -> Color cs Word32) -> Pixel cs e -> Pixel cs Word32
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel ((e -> Word32) -> Color cs e -> Color cs Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Word32
forall e. Elevator e => e -> Word32
toWord32)
{-# INLINE toPixel32 #-}


-- | Convert all channels of a pixel to 64bits each, while doing appropriate scaling. See
-- `Elevator`.
--
-- @since 0.1.0
toPixel64 :: ColorModel cs e => Pixel cs e -> Pixel cs Word64
toPixel64 :: Pixel cs e -> Pixel cs Word64
toPixel64 = (Color cs e -> Color cs Word64) -> Pixel cs e -> Pixel cs Word64
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel ((e -> Word64) -> Color cs e -> Color cs Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Word64
forall e. Elevator e => e -> Word64
toWord64)
{-# INLINE toPixel64 #-}


-- | Convert all channels of a pixel to 32bit floating point numers each, while doing
-- appropriate scaling. See `Elevator`.
--
-- @since 0.1.0
toPixelF :: ColorModel cs e => Pixel cs e -> Pixel cs Float
toPixelF :: Pixel cs e -> Pixel cs Float
toPixelF = (Color cs e -> Color cs Float) -> Pixel cs e -> Pixel cs Float
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel ((e -> Float) -> Color cs e -> Color cs Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Float
forall e. Elevator e => e -> Float
toFloat)
{-# INLINE toPixelF #-}

-- | Convert all channels of a pixel to 64bit floating point numers each, while doing
-- appropriate scaling. See `Elevator`.
--
-- @since 0.1.0
toPixelD :: ColorModel cs e => Pixel cs e -> Pixel cs Double
toPixelD :: Pixel cs e -> Pixel cs Double
toPixelD = (Color cs e -> Color cs Double) -> Pixel cs e -> Pixel cs Double
forall cs e cs' e'.
(Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel ((e -> Double) -> Color cs e -> Color cs Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Double
forall e. Elevator e => e -> Double
toDouble)
{-# INLINE toPixelD #-}