content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DeriveTraversable #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE PatternSynonyms #-}
  {-# LANGUAGE StandaloneDeriving #-}
  {-# LANGUAGE TypeFamilies #-}
  -- |
  -- Module : Graphics.Color.Model.LCH
  module Graphics.Color.Model.LCH
    ( LCH
    -- * Constructors for an LCH color model.
    , pattern ColorLCH
    , pattern ColorLCHA
    , Color(..)
    , ColorModel(..)
    , lch2lxy
    , lxy2lch
    ) where
  
  import Data.Complex (Complex(..), polar, mkPolar)
  import Data.Fixed (mod')
  import Data.List.NonEmpty
  import Foreign.Storable
  import Graphics.Color.Model.Internal
  
  -----------
  --- LCH ---
  -----------
  
  -- | CIEL*C*H color model, representing a cylindrical reparameterization
  --   of CIEL*a*b* or CIEL*u*v*.
  data LCH
  
  -- | `LCH` color model
  newtype instance Color LCH e = LCH (V3 e)
  
  -- | Constructor for @LCH@.
  pattern ColorLCH :: e -> e -> e -> Color LCH e
  pattern ColorLCH l c h = LCH (V3 l c h)
  {-# COMPLETE ColorLCH #-}
  
  
  -- | Constructor for @LCH@ with alpha channel.
  pattern ColorLCHA :: e -> e -> e -> e -> Color (Alpha LCH) e
  pattern ColorLCHA l c h a = Alpha (ColorLCH l c h) a
  {-# COMPLETE ColorLCHA #-}
  
  -- | `LCH` color model
  deriving instance Eq e => Eq (Color LCH e)
  -- | `LCH` color model
  deriving instance Ord e => Ord (Color LCH e)
  -- | `LCH` color model
  deriving instance Functor (Color LCH)
  -- | `LCH` color model
  deriving instance Applicative (Color LCH)
  -- | `LCH` color model
  deriving instance Foldable (Color LCH)
  -- | `LCH` color model
  deriving instance Traversable (Color LCH)
  -- | `LCH` color model
  deriving instance Storable e => Storable (Color LCH e)
  
  -- | `LCH` color model
  instance Elevator e => Show (Color LCH e) where
    showsPrec _ = showsColorModel
  
  -- | `LCH` color model
  instance Elevator e => ColorModel LCH e where
    type Components LCH e = (e, e, e)
    type ChannelCount LCH = 3
    channelCount _ = 3
    {-# INLINE channelCount #-}
    channelNames _ = "Luminance" :| ["Chroma", "Hue"]
    channelColors _ = V3 0x80 0x80 0x80 :|
                    [ V3 0xff 0x00 0xff
                    , V3 0xcc 0xff 0x33
                    ]
    toComponents (ColorLCH l c h) = (l, c, h)
    {-# INLINE toComponents #-}
    fromComponents (l, c, h) = ColorLCH l c h
    {-# INLINE fromComponents #-}
  
  lch2lxy :: Color LCH Double -> Components LCH Double
  lch2lxy (ColorLCH l c h) = (l, x, y)
   where
    !h' = h * pi / 180
    (x :+ y) = mkPolar c h'
  {-# INLINE lch2lxy #-}
  
  lxy2lch :: Components LCH Double -> Color LCH Double
  lxy2lch (l, x, y) = ColorLCH l c h
   where
    (c,h') = polar (x :+ y)
    !h = (h' * 180 / pi) `mod'` 360
  {-# INLINE lxy2lch #-}
  