{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK hide, not-home #-}
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)
newtype Pixel cs e = Pixel
{ forall cs e. Pixel cs e -> Color cs e
pixelColor :: Color cs e
}
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
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 :: forall s. MVector s (Pixel cs e) -> Int
basicLength (MV_Pixel MVector s (Components cs e)
mvec) = MVector s (Components cs e) -> Int
forall s. 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 :: forall s.
Int -> Int -> MVector s (Pixel cs e) -> MVector s (Pixel cs e)
basicUnsafeSlice Int
idx Int
len (MV_Pixel MVector s (Components cs e)
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 s.
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 :: forall s. MVector s (Pixel cs e) -> MVector s (Pixel cs e) -> Bool
basicOverlaps (MV_Pixel MVector s (Components cs e)
mvec) (MV_Pixel MVector s (Components cs e)
mvec') = MVector s (Components cs e) -> MVector s (Components cs e) -> Bool
forall s.
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 :: forall s. Int -> ST s (MVector s (Pixel cs e))
basicUnsafeNew Int
len = 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 (MVector s (Components cs e) -> MVector s (Pixel cs e))
-> ST s (MVector s (Components cs e))
-> ST s (MVector s (Pixel cs e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (MVector s (Components cs e))
forall s. Int -> ST s (MVector s (Components cs e))
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
VM.basicUnsafeNew Int
len
{-# INLINE basicUnsafeNew #-}
basicUnsafeReplicate :: forall s. Int -> Pixel cs e -> ST s (MVector s (Pixel cs e))
basicUnsafeReplicate Int
len Pixel cs e
val =
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 (MVector s (Components cs e) -> MVector s (Pixel cs e))
-> ST s (MVector s (Components cs e))
-> ST s (MVector s (Pixel cs e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Components cs e -> ST s (MVector s (Components cs e))
forall s.
Int -> Components cs e -> ST s (MVector s (Components cs e))
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s 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
forall a b. Coercible a b => a -> b
coerce Pixel cs e
val))
{-# INLINE basicUnsafeReplicate #-}
basicUnsafeRead :: forall s. MVector s (Pixel cs e) -> Int -> ST s (Pixel cs e)
basicUnsafeRead (MV_Pixel MVector s (Components cs e)
mvec) Int
idx = Color cs e -> Pixel cs e
forall a b. Coercible a b => a -> b
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)
-> ST s (Components cs e) -> ST s (Pixel cs e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s (Components cs e) -> Int -> ST s (Components cs e)
forall s.
MVector s (Components cs e) -> Int -> ST s (Components cs e)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
VM.basicUnsafeRead MVector s (Components cs e)
mvec Int
idx
{-# INLINE basicUnsafeRead #-}
basicUnsafeWrite :: forall s. MVector s (Pixel cs e) -> Int -> Pixel cs e -> ST s ()
basicUnsafeWrite (MV_Pixel MVector s (Components cs e)
mvec) Int
idx Pixel cs e
val = MVector s (Components cs e) -> Int -> Components cs e -> ST s ()
forall s.
MVector s (Components cs e) -> Int -> Components cs e -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
VM.basicUnsafeWrite MVector s (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
forall a b. Coercible a b => a -> b
coerce Pixel cs e
val))
{-# INLINE basicUnsafeWrite #-}
basicClear :: forall s. MVector s (Pixel cs e) -> ST s ()
basicClear (MV_Pixel MVector s (Components cs e)
mvec) = MVector s (Components cs e) -> ST s ()
forall s. MVector s (Components cs e) -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
VM.basicClear MVector s (Components cs e)
mvec
{-# INLINE basicClear #-}
basicSet :: forall s. MVector s (Pixel cs e) -> Pixel cs e -> ST s ()
basicSet (MV_Pixel MVector s (Components cs e)
mvec) Pixel cs e
val = MVector s (Components cs e) -> Components cs e -> ST s ()
forall s. MVector s (Components cs e) -> Components cs e -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
VM.basicSet MVector s (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
forall a b. Coercible a b => a -> b
coerce Pixel cs e
val))
{-# INLINE basicSet #-}
basicUnsafeCopy :: forall s.
MVector s (Pixel cs e) -> MVector s (Pixel cs e) -> ST s ()
basicUnsafeCopy (MV_Pixel MVector s (Components cs e)
mvec) (MV_Pixel MVector s (Components cs e)
mvec') = MVector s (Components cs e)
-> MVector s (Components cs e) -> ST s ()
forall s.
MVector s (Components cs e)
-> MVector s (Components cs e) -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
VM.basicUnsafeCopy MVector s (Components cs e)
mvec MVector s (Components cs e)
mvec'
{-# INLINE basicUnsafeCopy #-}
basicUnsafeMove :: forall s.
MVector s (Pixel cs e) -> MVector s (Pixel cs e) -> ST s ()
basicUnsafeMove (MV_Pixel MVector s (Components cs e)
mvec) (MV_Pixel MVector s (Components cs e)
mvec') = MVector s (Components cs e)
-> MVector s (Components cs e) -> ST s ()
forall s.
MVector s (Components cs e)
-> MVector s (Components cs e) -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
VM.basicUnsafeMove MVector s (Components cs e)
mvec MVector s (Components cs e)
mvec'
{-# INLINE basicUnsafeMove #-}
basicUnsafeGrow :: forall s.
MVector s (Pixel cs e) -> Int -> ST s (MVector s (Pixel cs e))
basicUnsafeGrow (MV_Pixel MVector s (Components cs e)
mvec) Int
len = 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 (MVector s (Components cs e) -> MVector s (Pixel cs e))
-> ST s (MVector s (Components cs e))
-> ST s (MVector s (Pixel cs e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s (Components cs e)
-> Int -> ST s (MVector s (Components cs e))
forall s.
MVector s (Components cs e)
-> Int -> ST s (MVector s (Components cs e))
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
VM.basicUnsafeGrow MVector s (Components cs e)
mvec Int
len
{-# INLINE basicUnsafeGrow #-}
basicInitialize :: forall s. MVector s (Pixel cs e) -> ST s ()
basicInitialize (MV_Pixel MVector s (Components cs e)
mvec) = MVector s (Components cs e) -> ST s ()
forall s. MVector s (Components cs e) -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
VM.basicInitialize MVector s (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 :: forall s.
Mutable Vector s (Pixel cs e) -> ST s (Vector (Pixel cs e))
basicUnsafeFreeze (MV_Pixel MVector s (Components cs e)
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))
-> ST s (Vector (Components cs e)) -> ST s (Vector (Pixel cs e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector s (Components cs e)
-> ST s (Vector (Components cs e))
forall s.
Mutable Vector s (Components cs e)
-> ST s (Vector (Components cs e))
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
V.basicUnsafeFreeze Mutable Vector s (Components cs e)
MVector s (Components cs e)
mvec
{-# INLINE basicUnsafeFreeze #-}
basicUnsafeThaw :: forall s.
Vector (Pixel cs e) -> ST s (Mutable Vector s (Pixel cs e))
basicUnsafeThaw (V_Pixel Vector (Components cs e)
vec) = 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 (MVector s (Components cs e) -> MVector s (Pixel cs e))
-> ST s (MVector s (Components cs e))
-> ST s (MVector s (Pixel cs e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Components cs e)
-> ST s (Mutable Vector s (Components cs e))
forall s.
Vector (Components cs e)
-> ST s (Mutable Vector s (Components cs e))
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
V.basicUnsafeThaw Vector (Components cs e)
vec
{-# INLINE basicUnsafeThaw #-}
basicLength :: Vector (Pixel cs e) -> Int
basicLength (V_Pixel Vector (Components cs e)
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 Vector (Components cs e)
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 -> Box (Pixel cs e)
basicUnsafeIndexM (V_Pixel Vector (Components cs e)
vec) Int
idx = Color cs e -> Pixel cs e
forall a b. Coercible a b => a -> b
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)
-> Box (Components cs e) -> Box (Pixel cs e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (Components cs e) -> Int -> Box (Components cs e)
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
V.basicUnsafeIndexM Vector (Components cs e)
vec Int
idx
{-# INLINE basicUnsafeIndexM #-}
basicUnsafeCopy :: forall s.
Mutable Vector s (Pixel cs e) -> Vector (Pixel cs e) -> ST s ()
basicUnsafeCopy (MV_Pixel MVector s (Components cs e)
mvec) (V_Pixel Vector (Components cs e)
vec) = Mutable Vector s (Components cs e)
-> Vector (Components cs e) -> ST s ()
forall s.
Mutable Vector s (Components cs e)
-> Vector (Components cs e) -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
V.basicUnsafeCopy Mutable Vector s (Components cs e)
MVector s (Components cs e)
mvec Vector (Components cs e)
vec
{-# INLINE basicUnsafeCopy #-}
elemseq :: forall b. Vector (Pixel cs e) -> Pixel cs e -> b -> b
elemseq (V_Pixel Vector (Components cs e)
vec) Pixel cs e
val = Vector (Components cs e) -> Components cs e -> b -> b
forall b. 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
forall a b. Coercible a b => a -> b
coerce Pixel cs e
val))
{-# INLINE elemseq #-}
liftPixel :: (Color cs e -> Color cs' e') -> Pixel cs e -> Pixel cs' e'
liftPixel :: forall cs e cs' e'.
(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'
forall a b. Coercible a b => a -> b
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
forall a b. Coercible a b => a -> b
coerce
{-# INLINE liftPixel #-}
toPixel8 :: ColorModel cs e => Pixel cs e -> Pixel cs Word8
toPixel8 :: forall cs e. ColorModel cs e => 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 a b. (a -> b) -> Color cs a -> Color cs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Word8
forall e. Elevator e => e -> Word8
toWord8)
{-# INLINE toPixel8 #-}
toPixel16 :: ColorModel cs e => Pixel cs e -> Pixel cs Word16
toPixel16 :: forall cs e. ColorModel cs e => 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 a b. (a -> b) -> Color cs a -> Color cs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Word16
forall e. Elevator e => e -> Word16
toWord16)
{-# INLINE toPixel16 #-}
toPixel32 :: ColorModel cs e => Pixel cs e -> Pixel cs Word32
toPixel32 :: forall cs e. ColorModel cs e => 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 a b. (a -> b) -> Color cs a -> Color cs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Word32
forall e. Elevator e => e -> Word32
toWord32)
{-# INLINE toPixel32 #-}
toPixel64 :: ColorModel cs e => Pixel cs e -> Pixel cs Word64
toPixel64 :: forall cs e. ColorModel cs e => 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 a b. (a -> b) -> Color cs a -> Color cs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Word64
forall e. Elevator e => e -> Word64
toWord64)
{-# INLINE toPixel64 #-}
toPixelF :: ColorModel cs e => Pixel cs e -> Pixel cs Float
toPixelF :: forall cs e. ColorModel cs e => 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 a b. (a -> b) -> Color cs a -> Color cs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Float
forall e. Elevator e => e -> Float
toFloat)
{-# INLINE toPixelF #-}
toPixelD :: ColorModel cs e => Pixel cs e -> Pixel cs Double
toPixelD :: forall cs e. ColorModel cs e => 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 a b. (a -> b) -> Color cs a -> Color cs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> Double
forall e. Elevator e => e -> Double
toDouble)
{-# INLINE toPixelD #-}