Util.hs

-----------------------------------------------------------------------------
--
-- Module      :  Data.Color.Util
-- Copyright   :  (c) 2012-16 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <consult@brianwbush.info>
-- Stability   :  Stable
-- Portability :  Portable
--
-- | Functions for manipulating colors.
--
-----------------------------------------------------------------------------


{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Safe          #-}


module Data.Color.Util (
-- * Types
  RGB(..)
-- * Functions
, hsvToRgb
, rgbToHsv
, byteColor
) where


import Data.Word (Word8)
import GHC.Generics (Generic)


-- | A color triplet of red, green, and blue intensity.
data RGB = RGB
  {
    red   :: !Word8
  , green :: !Word8
  , blue  :: !Word8
  }
    deriving (Eq, Generic, Ord, Read, Show)


-- | Convert a hue, saturation, value triplet to a red, green, blue one.  Source: <http://www.cs.rit.edu/~ncs/color/t_convert.html>.
hsvToRgb :: (Double, Double, Double) -> RGB
hsvToRgb (h, s, v) =
  let
    scale = floor . (255 *)
    rgb r g b = RGB (scale r) (scale g) (scale b)
  in
    if s == 0
      then
        rgb v v v
      else
        let
          h' = h / 60
          i :: Int
          i = floor h'
          f = h' - fromIntegral i
          p = v * (1 - s)
          q = v * (1 - s * f)
          t = v * (1 - s * (1 - f))
        in
          case i of
            0 -> rgb v t p
            1 -> rgb q v p
            2 -> rgb p v t
            3 -> rgb p q v
            4 -> rgb t p v
            5 -> rgb v p q
            _ -> undefined


-- | Convert a red, green, blue triplet to a hue, saturation, value one.  Source: <http://www.cs.rit.edu/~ncs/color/t_convert.html>.
rgbToHsv :: RGB -> (Double, Double, Double)
rgbToHsv (RGB r g b) =
  let
    r' = fromIntegral r :: Double
    g' = fromIntegral g :: Double
    b' = fromIntegral b :: Double
    min' = minimum [r', g', b']
    max' = maximum [r', g', b']
    v = max'
    delta = max' - min'
  in
    if max' == 0
      then (0, 0, 0)
      else
        let
          s = delta / max'
          h = 60 *
            if r' == max'
              then (g' - b') / delta
              else
                if g' == max'
                  then 2 + (b' - r') / delta
                  else 4 + (r' - g') / delta
          h' =
            if h < 0
              then h + 360
              else h
        in
          (h', s, v)


-- | Scale a colour to a byte.
byteColor ::
     Double  -- ^ The color intensity, in the range [0, 1].
  -> Word8   -- ^ The color intensity, in the range [0, 255].
byteColor = floor . (255 *)