{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Graphics.Color.Space.RGB.Alternative.HSI
( pattern ColorHSI
, pattern ColorHSIA
, pattern ColorH360SI
, HSI
, Color(HSI)
, module Graphics.Color.Space
) where
import Data.Coerce
import Data.Proxy
import Foreign.Storable
import qualified Graphics.Color.Model.HSI as CM
import Graphics.Color.Model.Internal
import Graphics.Color.Space
data HSI cs
newtype instance Color (HSI cs) e = HSI (Color CM.HSI e)
deriving instance Eq e => Eq (Color (HSI cs) e)
deriving instance Ord e => Ord (Color (HSI cs) e)
deriving instance Functor (Color (HSI cs))
deriving instance Applicative (Color (HSI cs))
deriving instance Foldable (Color (HSI cs))
deriving instance Traversable (Color (HSI cs))
deriving instance Storable e => Storable (Color (HSI cs) e)
instance ColorModel cs e => Show (Color (HSI cs) e) where
showsPrec _ = showsColorModel
pattern ColorHSI :: e -> e -> e -> Color (HSI cs) e
pattern ColorHSI h s i = HSI (CM.ColorHSI h s i)
{-# COMPLETE ColorHSI #-}
pattern ColorHSIA :: e -> e -> e -> e -> Color (Alpha (HSI cs)) e
pattern ColorHSIA h s i a = Alpha (HSI (CM.ColorHSI h s i)) a
{-# COMPLETE ColorHSIA #-}
pattern ColorH360SI :: Fractional e => e -> e -> e -> Color (HSI cs) e
pattern ColorH360SI h s i <- ColorHSI ((* 360) -> h) s i where
ColorH360SI h s i = ColorHSI (h / 360) s i
{-# COMPLETE ColorH360SI #-}
instance ColorModel cs e => ColorModel (HSI cs) e where
type Components (HSI cs) e = (e, e, e)
toComponents = toComponents . coerce
{-# INLINE toComponents #-}
fromComponents = coerce . fromComponents
{-# INLINE fromComponents #-}
showsColorModelName _ = ("HSI-" ++) . showsColorModelName (Proxy :: Proxy (Color cs e))
instance (ColorSpace (cs l) i e, RedGreenBlue cs i) => ColorSpace (HSI (cs l)) i e where
type BaseModel (HSI (cs l)) = CM.HSI
type BaseSpace (HSI (cs l)) = cs l
toBaseSpace = mkColorRGB . fmap fromDouble . CM.hsi2rgb . fmap toDouble . coerce
{-# INLINE toBaseSpace #-}
fromBaseSpace = coerce . fmap fromDouble . CM.rgb2hsi . fmap toDouble . unColorRGB
{-# INLINE fromBaseSpace #-}
luminance = luminance . toBaseSpace
{-# INLINE luminance #-}