Tuesday, September 9, 2014

color space conversion

Between RGB and HSL.
hsl :: (Int, Int, Int) -> (Double, Double, Double)

hsl (r',g',b') = r' == g' && g' == b' ? ((0,0,l), (h,s,l))
 where
  [r,g,b] = map ((/ 255) . fromIntegral) [r',g',b']
  cmin    = minimum [r,g,b]
  cmax    = maximum [r,g,b]
  d       = cmax - cmin
  l       = (cmin + cmax) / 2
  s       = l > 0.5 ? (d / (2 - cmax - cmin), d / (cmax + cmin))
  h       = h' < 0 ? (h' + 1, h')
  h'      | r' == maximum [r',g',b'] = dB - dG
          | g' == maximum [r',g',b'] = (1 / 3) + dR - dB
          | otherwise                = (2 / 3) + dG - dR
   where
    dR = (((cmax - r) / 6) + (d / 2)) / d
    dG = (((cmax - g) / 6) + (d / 2)) / d
    dB = (((cmax - b) / 6) + (d / 2)) / d

-----------------------------------------------------------------

rgb :: (Double, Double, Double) -> (Int, Int, Int)

rgb (h,s,l)
  | abs (0 - s) < 0.001 = f l l l
  | otherwise           = f r g b
 where
  q       = l < 0.5 ? (l * (1 + s), l + s - l*s)
  p       = 2*l - q
  r       = hueToRgb p q $ h + 1/3
  g       = hueToRgb p q h
  b       = hueToRgb p q $ h - 1/3
  f x y z = (round $ x*255, round $ y*255, round $ z*255)

hueToRgb p q h''
  | h < 1/6   = p + (q - p) * 6 * h
  | h < 1/2   = q
  | h < 2/3   = p + (q - p) * 6 * (2/3 - h)
  | otherwise = p
 where
  h' = h'' < 0 ? (h'' + 1, h'')
  h  = h'  > 1 ? (h'  - 1, h' )

-----------------------------------------------------------------

p ? (a,b) = if p then a else b; infix 2 ?

No comments:

Post a Comment