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