module Graphics.ColorSpace.Internal
( Pixel
, ColorSpace(..)
, AlphaSpace(..)
, module Graphics.ColorSpace.Elevator
) where
import Control.DeepSeq (NFData (rnf), deepseq)
import Control.Monad (liftM)
import Data.Default
import Data.Foldable
import Data.Maybe (fromMaybe)
import Data.Typeable
import qualified Data.Vector.Generic as V
import qualified Data.Vector.Generic.Mutable as VM
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU
import Graphics.ColorSpace.Elevator
data family Pixel cs e :: *
class (Eq cs, Enum cs, Show cs, Bounded cs, Typeable cs,
Eq (Pixel cs e), VU.Unbox (Components cs e), VS.Storable (Pixel cs e), Elevator e)
=> ColorSpace cs e where
type Components cs e
toComponents :: Pixel cs e -> Components cs e
fromComponents :: Components cs e -> Pixel cs e
promote :: e -> Pixel cs e
getPxC :: Pixel cs e -> cs -> e
setPxC :: Pixel cs e -> cs -> e -> Pixel cs e
mapPxC :: (cs -> e -> e) -> Pixel cs e -> Pixel cs e
liftPx :: (e -> e) -> Pixel cs e -> Pixel cs e
liftPx2 :: (e -> e -> e) -> Pixel cs e -> Pixel cs e -> Pixel cs e
foldlPx2 :: (b -> e -> e -> b) -> b -> Pixel cs e -> Pixel cs e -> b
foldrPx :: (e -> b -> b) -> b -> Pixel cs e -> b
foldrPx f !z0 !xs = foldlPx f' id xs z0
where f' k x !z = k $! f x z
foldlPx :: (b -> e -> b) -> b -> Pixel cs e -> b
foldlPx f !z0 !xs = foldrPx f' id xs z0
where f' x k !z = k $! f z x
foldl1Px :: (e -> e -> e) -> Pixel cs e -> e
foldl1Px f !xs = fromMaybe (error "foldl1Px: empty Pixel")
(foldlPx mf Nothing xs)
where
mf m !y = Just (case m of
Nothing -> y
Just x -> f x y)
toListPx :: Pixel cs e -> [e]
toListPx !px = foldr' f [] (enumFrom (toEnum 0))
where f !cs !ls = getPxC px cs:ls
class (ColorSpace (Opaque cs) e, ColorSpace cs e) => AlphaSpace cs e where
type Opaque cs
getAlpha :: Pixel cs e -> e
addAlpha :: e -> Pixel (Opaque cs) e -> Pixel cs e
dropAlpha :: Pixel cs e -> Pixel (Opaque cs) e
instance ColorSpace cs e => Default (Pixel cs e) where
def = promote 0
instance ColorSpace cs e => Num (Pixel cs e) where
(+) = liftPx2 (+)
() = liftPx2 ()
(*) = liftPx2 (*)
abs = liftPx abs
signum = liftPx signum
fromInteger = promote . fromInteger
instance (ColorSpace cs e, Fractional e) => Fractional (Pixel cs e) where
(/) = liftPx2 (/)
recip = liftPx recip
fromRational = promote . fromRational
instance (ColorSpace cs e, Floating e) => Floating (Pixel cs e) where
pi = promote pi
exp = liftPx exp
log = liftPx log
sin = liftPx sin
cos = liftPx cos
asin = liftPx asin
atan = liftPx atan
acos = liftPx acos
sinh = liftPx sinh
cosh = liftPx cosh
asinh = liftPx asinh
atanh = liftPx atanh
acosh = liftPx acosh
instance (ColorSpace cs e, Bounded e) => Bounded (Pixel cs e) where
maxBound = promote maxBound
minBound = promote minBound
instance (ColorSpace cs e, NFData e) => NFData (Pixel cs e) where
rnf = foldrPx deepseq ()
instance ColorSpace cs e => VU.Unbox (Pixel cs e)
newtype instance VU.MVector s (Pixel cs e) = MV_Pixel (VU.MVector s (Components cs e))
instance ColorSpace cs e => VM.MVector VU.MVector (Pixel cs e) where
basicLength (MV_Pixel mvec) = VM.basicLength mvec
basicUnsafeSlice idx len (MV_Pixel mvec) = MV_Pixel (VM.basicUnsafeSlice idx len mvec)
basicOverlaps (MV_Pixel mvec) (MV_Pixel mvec') = VM.basicOverlaps mvec mvec'
basicUnsafeNew len = MV_Pixel `liftM` VM.basicUnsafeNew len
basicUnsafeReplicate len val = MV_Pixel `liftM` VM.basicUnsafeReplicate len (toComponents val)
basicUnsafeRead (MV_Pixel mvec) idx = fromComponents `liftM` VM.basicUnsafeRead mvec idx
basicUnsafeWrite (MV_Pixel mvec) idx val = VM.basicUnsafeWrite mvec idx (toComponents val)
basicClear (MV_Pixel mvec) = VM.basicClear mvec
basicSet (MV_Pixel mvec) val = VM.basicSet mvec (toComponents val)
basicUnsafeCopy (MV_Pixel mvec) (MV_Pixel mvec') = VM.basicUnsafeCopy mvec mvec'
basicUnsafeMove (MV_Pixel mvec) (MV_Pixel mvec') = VM.basicUnsafeMove mvec mvec'
basicUnsafeGrow (MV_Pixel mvec) len = MV_Pixel `liftM` VM.basicUnsafeGrow mvec len
#if MIN_VERSION_vector(0,11,0)
basicInitialize (MV_Pixel mvec) = VM.basicInitialize mvec
#endif
newtype instance VU.Vector (Pixel cs e) = V_Pixel (VU.Vector (Components cs e))
instance (ColorSpace cs e) => V.Vector VU.Vector (Pixel cs e) where
basicUnsafeFreeze (MV_Pixel mvec) = V_Pixel `liftM` V.basicUnsafeFreeze mvec
basicUnsafeThaw (V_Pixel vec) = MV_Pixel `liftM` V.basicUnsafeThaw vec
basicLength (V_Pixel vec) = V.basicLength vec
basicUnsafeSlice idx len (V_Pixel vec) = V_Pixel (V.basicUnsafeSlice idx len vec)
basicUnsafeIndexM (V_Pixel vec) idx = fromComponents `liftM` V.basicUnsafeIndexM vec idx
basicUnsafeCopy (MV_Pixel mvec) (V_Pixel vec) = V.basicUnsafeCopy mvec vec
elemseq (V_Pixel vec) val = V.elemseq vec (toComponents val)