Color.hs

{-# LANGUAGE TypeSynonymInstances #-}

-- |
-- Module: Graphics.Chalkboard.Color
-- Copyright: (c) 2009 Andy Gill
-- License: BSD3
--
-- Maintainer: Andy Gill <andygill@ku.edu>
-- Stability: unstable
-- Portability: ghc
--
-- Simple RGB colors.

module Graphics.Chalkboard.Color 
	( Gray,
	  RGB(..),
	  red, green, blue, white, black, cyan, purple, yellow
        ) where

import Graphics.Chalkboard.Types

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

-- | 'Gray' is just a value between 0 and 1, inclusive.
type Gray = UI


instance Over Gray where
  over r _ = r

------------------------------------------------------------------------------
-- Simple colors

-- | 'RGB' is our color, with values between 0 and 1, inclusive.
data RGB  = RGB !UI !UI !UI deriving Show

instance Over RGB where
  -- simple overwriting
  over x _y = x

instance Lerp RGB where
  lerp (RGB r g b) (RGB r' g' b') s 
	 = RGB (lerp r r' s) 
	       (lerp g g' s)
	       (lerp b b' s)

instance Scale RGB where
  scale s (RGB r g b)
	 = RGB (scale s r) 
	       (scale s g)
	       (scale s b) 

instance Average RGB where
  average cs = RGB (average reds) (average greens) (average blues)
     where
	reds   = [ r | RGB r _ _ <- cs ]
	greens = [ g | RGB _ g _ <- cs ]
	blues  = [ b | RGB _ _ b <- cs ]


red    :: RGB
red    = RGB 1.0 0.0 0.0
green  :: RGB
green  = RGB 0.0 1.0 0.0
blue   :: RGB
blue   = RGB 0.0 0.0 1.0
white  :: RGB
white  = RGB 1.0 1.0 1.0
black  :: RGB
black  = RGB 0.0 0.0 0.0
cyan   :: RGB
cyan   = RGB 0.0 1.0 1.0
purple :: RGB
purple = RGB 1.0 0.0 1.0
yellow :: RGB
yellow = RGB 1.0 1.0 0.0