module Graphics.ColorSpace.HSI (
HSI(..), HSIA(..), Pixel(..)
) where
import Control.Applicative
import Data.Foldable
import Data.Typeable (Typeable)
import Foreign.Ptr
import Foreign.Storable
import Graphics.ColorSpace.Internal
import Prelude hiding (map)
data HSI = HueHSI
| SatHSI
| IntHSI
deriving (Eq, Enum, Show, Bounded, Typeable)
data instance Pixel HSI e = PixelHSI !e !e !e deriving (Eq, Ord)
instance Show e => Show (Pixel HSI e) where
show (PixelHSI h s i) = "<HSI:("++show h++"|"++show s++"|"++show i++")>"
instance Elevator e => ColorSpace HSI e where
type Components HSI e = (e, e, e)
toComponents (PixelHSI h s i) = (h, s, i)
fromComponents !(h, s, i) = PixelHSI h s i
promote = pure
getPxC (PixelHSI h _ _) HueHSI = h
getPxC (PixelHSI _ s _) SatHSI = s
getPxC (PixelHSI _ _ i) IntHSI = i
setPxC (PixelHSI _ s i) HueHSI h = PixelHSI h s i
setPxC (PixelHSI h _ i) SatHSI s = PixelHSI h s i
setPxC (PixelHSI h s _) IntHSI i = PixelHSI h s i
mapPxC f (PixelHSI h s i) = PixelHSI (f HueHSI h) (f SatHSI s) (f IntHSI i)
liftPx = fmap
liftPx2 = liftA2
foldlPx = foldl'
foldlPx2 f !z (PixelHSI h1 s1 i1) (PixelHSI h2 s2 i2) =
f (f (f z h1 h2) s1 s2) i1 i2
instance Functor (Pixel HSI) where
fmap f (PixelHSI h s i) = PixelHSI (f h) (f s) (f i)
instance Applicative (Pixel HSI) where
pure !e = PixelHSI e e e
(PixelHSI fh fs fi) <*> (PixelHSI h s i) = PixelHSI (fh h) (fs s) (fi i)
instance Foldable (Pixel HSI) where
foldr f !z (PixelHSI h s i) = f h (f s (f i z))
instance Storable e => Storable (Pixel HSI e) where
sizeOf _ = 3 * sizeOf (undefined :: e)
alignment _ = alignment (undefined :: e)
peek !p = do
q <- return $ castPtr p
r <- peek q
g <- peekElemOff q 1
b <- peekElemOff q 2
return (PixelHSI r g b)
poke !p (PixelHSI r g b) = do
q <- return $ castPtr p
poke q r
pokeElemOff q 1 g
pokeElemOff q 2 b
data HSIA = HueHSIA
| SatHSIA
| IntHSIA
| AlphaHSIA
deriving (Eq, Enum, Show, Bounded, Typeable)
data instance Pixel HSIA e = PixelHSIA !e !e !e !e deriving (Eq, Ord)
instance Show e => Show (Pixel HSIA e) where
show (PixelHSIA h s i a) = "<HSIA:("++show h++"|"++show s++"|"++show i++"|"++show a++")>"
instance Elevator e => ColorSpace HSIA e where
type Components HSIA e = (e, e, e, e)
toComponents (PixelHSIA h s i a) = (h, s, i, a)
fromComponents !(h, s, i, a) = PixelHSIA h s i a
promote = pure
getPxC (PixelHSIA h _ _ _) HueHSIA = h
getPxC (PixelHSIA _ s _ _) SatHSIA = s
getPxC (PixelHSIA _ _ i _) IntHSIA = i
getPxC (PixelHSIA _ _ _ a) AlphaHSIA = a
setPxC (PixelHSIA _ s i a) HueHSIA h = PixelHSIA h s i a
setPxC (PixelHSIA h _ i a) SatHSIA s = PixelHSIA h s i a
setPxC (PixelHSIA h s _ a) IntHSIA i = PixelHSIA h s i a
setPxC (PixelHSIA h s i _) AlphaHSIA a = PixelHSIA h s i a
mapPxC f (PixelHSIA h s i a) =
PixelHSIA (f HueHSIA h) (f SatHSIA s) (f IntHSIA i) (f AlphaHSIA a)
liftPx = fmap
liftPx2 = liftA2
foldlPx = foldl'
foldlPx2 f !z (PixelHSIA h1 s1 i1 a1) (PixelHSIA h2 s2 i2 a2) =
f (f (f (f z h1 h2) s1 s2) i1 i2) a1 a2
instance Elevator e => AlphaSpace HSIA e where
type Opaque HSIA = HSI
getAlpha (PixelHSIA _ _ _ a) = a
addAlpha !a (PixelHSI h s i) = PixelHSIA h s i a
dropAlpha (PixelHSIA h s i _) = PixelHSI h s i
instance Functor (Pixel HSIA) where
fmap f (PixelHSIA h s i a) = PixelHSIA (f h) (f s) (f i) (f a)
instance Applicative (Pixel HSIA) where
pure !e = PixelHSIA e e e e
(PixelHSIA fh fs fi fa) <*> (PixelHSIA h s i a) = PixelHSIA (fh h) (fs s) (fi i) (fa a)
instance Foldable (Pixel HSIA) where
foldr f !z (PixelHSIA h s i a) = f h (f s (f i (f a z)))
instance Storable e => Storable (Pixel HSIA e) where
sizeOf _ = 4 * sizeOf (undefined :: e)
alignment _ = alignment (undefined :: e)
peek !p = do
q <- return $ castPtr p
h <- peek q
s <- peekElemOff q 1
i <- peekElemOff q 2
a <- peekElemOff q 3
return (PixelHSIA h s i a)
poke !p (PixelHSIA h s i a) = do
q <- return $ castPtr p
poke q h
pokeElemOff q 1 s
pokeElemOff q 2 i
pokeElemOff q 3 a