jort-1.0.0: Colors.hs

module Colors where

import Basics 

liftColor2 op (Color r1 g1 b1) (Color r2 g2 b2) = Color (op r1 r2) (op g1 g2) (op b1 b2)
liftColor1 op (Color r1 g1 b1) = Color (op r1) (op g1) (op b1)

instance Num Color where
    (+) = liftColor2 (+)
    (-) = liftColor2 (-)
    (*) = liftColor2 (*)
    negate = liftColor1 negate
    abs = liftColor1 abs
    fromInteger i = grayTint $ fromInteger i
    signum = error "signum not defined for colors"

grayTint frac = Color frac frac frac

f `weight` Color r g b = Color (f*r) (f*g) (f*b)


rgb = Color

-- Hue: The trigonometric method.
-- hue :: Scal -> Color
-- hue h = Color r g b -- hue in rad
--     where r = f h
-- 	  g = f (h+2*pi/3)
-- 	  b = f (h-2*pi/3)
-- 	  f h' = (1+cos h')/2

--Hue: The linear method.
hsi h s i = result
    where h1 = h*3/pi -- h1 cycle length is 6
	  h2 = floor h1
	  h3 = fromIntegral h2
	  p = i * (1 - s)
	  q = i * (1 - s * (h1-h3))
	  t = i * (1 - s * (1-h1+h3))
	  result = case h2 `mod` 6 of
	     0 -> Color i t p
	     1 -> Color q i p
	     2 -> Color p i t
	     3 -> Color p q i
	     4 -> Color t p i
	     5 -> Color i p q

hue h = hsi h 1 1	   

-- For future reference:
-- (1) from RGB to HIS
-- I = Max. (R,G,B)
-- 1) I = 0 ; S = 0, H= indeterminate

-- S = (I-i)/I , where i = min. {R, G, B}
-- Let r = (I-R) / (I-i), g = (I-G) / (I-i), b = (I-B) / (I-i), then
-- if R = I H = (b-g) / 3
-- if G = I H = (2+r-b) / 3
-- if B = I H = (4+g-r) / 3


normalizeAngle a = a - fromIntegral cycleOffset * 2 * pi
    where cycleOffset = round (a / (2*pi))
    

blackColor = grayTint 0
whiteColor = grayTint 1

intensity (Color r g b) = max r $ max g $ b