{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Wumpus.Core.Colour
-- Copyright   :  (c) Stephen Tetley 2009-2010
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC with TypeFamilies and more
--
--
-- RGB, HSB, Gray colour types, and conversions between them.
--
-- Internally Wumpus uses @RGB3 Double@ with range [0.0, 1..0] 
-- as the colour type. All colour values in the generated SVG or 
-- PostScript files will be RGB.
--
-- Colour have Num instances for convenience, though the 
-- operations of @Data.VectorSpace@ (instances also defined) 
-- seem more approriate.
--
--------------------------------------------------------------------------------


module Wumpus.Core.Colour 
  (
  -- * Colour types
    RGB3(..)
  , DRGB
  , HSB3(..)
  , DHSB
  , Gray(..)
  , DGray

  -- * Utility constructor
  , iRGB3
  , iHSB3
  , iGray
  
  -- * Operations
  , rgb2hsb
  , hsb2rgb

  , rgb2gray
  , gray2rgb

  , hsb2gray
  , gray2hsb
  
  -- * Predefined colours
  , black
  , white
  , red
  , green
  , blue

  ) where

import Wumpus.Core.Utils


import Data.VectorSpace

-- | Red-Green-Blue - no alpha.
--
data RGB3 a = RGB3 !a !a !a
  deriving (Eq,Show)

-- | RGB representated by Double - values should be in the range
-- 0.0 to 1.0. 
-- 
-- 1.0 represents full saturation, for instance red is 
-- 1.0, 0.0, 0.0.
--
type DRGB = RGB3 Double


-- | Hue-Saturation-Brightness.
--
data HSB3 a = HSB3 !a !a !a 
  deriving (Eq,Show)

-- | HSB represented by Double - values should be in the range
-- 0.0 to 1.0.
--
type DHSB = HSB3 Double 

-- | Gray scale.
-- 
newtype Gray a = Gray a
  deriving (Eq,Num,Fractional,Ord,Show)

-- | Gray represented by a Double - values should be in the range
-- 0.0 (black) to 1.0 (white).
type DGray = Gray Double


--------------------------------------------------------------------------------
-- Num instances

instance Num a => Num (RGB3 a) where
  (+) (RGB3 a b c) (RGB3 x y z) = RGB3 (a+x) (b+y) (c+z)
  (-) (RGB3 a b c) (RGB3 x y z) = RGB3 (a-x) (b-y) (c-z)
  (*) (RGB3 a b c) (RGB3 x y z) = RGB3 (a*x) (b*y) (c*z)
  abs (RGB3 a b c)            = RGB3 (abs a) (abs b) (abs c)
  negate (RGB3 a b c)         = RGB3 (negate a) (negate b) (negate c)
  signum (RGB3 a b c)         = RGB3 (signum a) (signum b) (signum c)
  fromInteger i = RGB3 (fromInteger i) (fromInteger i) (fromInteger i)


instance Num a => Num (HSB3 a) where
  (+) (HSB3 a b c) (HSB3 x y z) = HSB3 (a+x) (b+y) (c+z)
  (-) (HSB3 a b c) (HSB3 x y z) = HSB3 (a-x) (b-y) (c-z)
  (*) (HSB3 a b c) (HSB3 x y z) = HSB3 (a*x) (b*y) (c*z)
  abs (HSB3 a b c)            = HSB3 (abs a) (abs b) (abs c)
  negate (HSB3 a b c)         = HSB3 (negate a) (negate b) (negate c)
  signum (HSB3 a b c)         = HSB3 (signum a) (signum b) (signum c)
  fromInteger i = HSB3 (fromInteger i) (fromInteger i) (fromInteger i)

-- Num (Gray a) derived


instance Fractional a => Fractional (RGB3 a) where
  (/) (RGB3 a b c) (RGB3 x y z) = RGB3 (a/x) (b/y) (c/z)
  recip (RGB3 a b c)            = RGB3 (recip a) (recip b) (recip c)
  fromRational a = RGB3 (fromRational a) (fromRational a) (fromRational a)

instance Fractional a => Fractional (HSB3 a) where
  (/) (HSB3 a b c) (HSB3 x y z) = HSB3 (a/x) (b/y) (c/z)
  recip (HSB3 a b c)            = HSB3 (recip a) (recip b) (recip c)
  fromRational a = HSB3 (fromRational a) (fromRational a) (fromRational a)


-- Fractional (Gray a) derived

--------------------------------------------------------------------------------
-- Instances for VectorSpace

 
instance Num a => AdditiveGroup (RGB3 a) where
  zeroV = RGB3 0 0 0
  (^+^) = (+)
  negateV = negate
 
instance Num a => AdditiveGroup (HSB3 a) where
  zeroV = HSB3 0 0 0
  (^+^) = (+)
  negateV = negate

instance Num a => AdditiveGroup (Gray a) where
  zeroV = Gray 0                -- black
  (^+^) = (+)
  negateV = negate


instance Num a => VectorSpace (RGB3 a) where
  type Scalar (RGB3 a) = a
  s *^ (RGB3 a b c) = RGB3 (s*a) (s*b) (s*c)

instance Num a => VectorSpace (HSB3 a) where
  type Scalar (HSB3 a) = a
  s *^ (HSB3 a b c) = HSB3 (s*a) (s*b) (s*c)

instance Num a => VectorSpace (Gray a) where
  type Scalar (Gray a) = a
  s *^ (Gray a) = Gray (s*a)


--------------------------------------------------------------------------------
-- Utility constructors

-- | 'iRGB3' : @ red -> green -> blue -> rgb @
-- 
-- Create an RGB colour with intergers in the range [0..255].
-- 
-- 255 represents full sturation so red will be @ 255 0 0 @.
--
-- Integer values above 255 will be clamped to 255, similarly
-- values below 0 will be clamped to 0.
-- 
iRGB3 :: (Fractional a, Ord a) => Int -> Int -> Int -> RGB3 a
iRGB3 r g b = RGB3 (rescaleZeroOne r) (rescaleZeroOne g) (rescaleZeroOne b)

iHSB3 :: (Fractional a, Ord a) => Int -> Int -> Int -> HSB3 a
iHSB3 h s b = HSB3 (rescaleZeroOne h) (rescaleZeroOne s) (rescaleZeroOne b)

iGray :: (Fractional a, Ord a) => Int -> Gray a
iGray i = Gray $ rescaleZeroOne i

rescaleZeroOne :: (Fractional a, Ord a) => Int -> a
rescaleZeroOne a = rescale (0,255.0) (0,1.0) (clamp 0 255 $ fromIntegral a)

--------------------------------------------------------------------------------
-- Operations


vE :: DRGB
vE = RGB3 1 1 1

-- Acknowledgment - the conversion functions are derived from
-- the documentation to Dr. Uwe Kern's xcolor LaTeX package


-- | Covert RGB \[0,1\] to HSB \[0,1\].
rgb2hsb :: DRGB -> DHSB
rgb2hsb (RGB3 r g b) = HSB3 hue sat bri
  where
    x     = max3 r g b
    y     = med3 r g b
    z     = min3 r g b

    bri   = x

    (sat,hue) = if x==z then (0,0) else ((x-z)/x, f $ (x-y)/(x-z))
    
    f n | r >= g && g >= b    = (1/6) * (1-n) 
        | g >= r && r >= b    = (1/6) * (1+n)
        | g >= b && b >= r    = (1/6) * (3-n)
        | b >= g && g >= r    = (1/6) * (3+n)
        | b >= r && r >= g    = (1/6) * (5-n)
        | otherwise           = (1/6) * (5+n)


-- | Covert HSB \[0,1\] to RGB \[0,1\].
hsb2rgb :: DHSB -> DRGB
hsb2rgb (HSB3 hue sat bri) = bri *^ (vE - (sat *^ fV))
  where
    i     :: Int
    i     = floor $ (6 * hue)
    f     = (6 * hue) - fromIntegral i
    fV    | i == 0    = RGB3  0     (1-f) 1 
          | i == 1    = RGB3  f     0     1
          | i == 2    = RGB3  1     0     (1-f)
          | i == 3    = RGB3  1     f     0
          | i == 4    = RGB3  (1-f) 1     0
          | i == 5    = RGB3  0     1     f
          | otherwise = RGB3  0     1     1
          
-- | Covert RGB \[0,1\] to Gray \[0,1\].
rgb2gray :: DRGB -> DGray
rgb2gray (RGB3 r g b) = Gray $ 0.3 * r + 0.59 * g + 0.11 * b 


-- | Covert Gray \[0,1\] to RGB \[0,1\].
gray2rgb :: DGray -> DRGB
gray2rgb (Gray a) = a *^ vE


-- | Covert HSB \[0,1\] to Gray \[0,1\].
hsb2gray :: DHSB -> DGray
hsb2gray (HSB3 _ _ b) = Gray b 


-- | Covert Gray \[0,1\] to HSB \[0,1\].
gray2hsb :: DGray -> DHSB
gray2hsb (Gray a) = HSB3 0 0 a




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

-- Some colours

-- There will be name clashes with the X11Colours / SVGColours.

-- | Black - 0.0, 0.0, 0.0.
--
black :: DRGB
black = RGB3 0 0 0

-- | White - 1.0, 1.0, 1.0.
--
white :: DRGB
white = RGB3 1 1 1

-- | Red - 1.0, 0.0, 0.0.
--
red :: DRGB
red = RGB3 1 0 0

-- | Green - 0.0, 1.0, 0.0.
--
green :: DRGB 
green = RGB3 0 1 0

-- | Blue - 0.0, 0.0, 1.0.
--
blue :: DRGB
blue = RGB3 0 0 1