module Color where import Geometry data PaletteColor = Red | Green | Blue | Yellow | Cyan | Magenta | Rose | Violet | Azure | Aquamarine | Chartreuse | Orange | White | Black deriving (Eq,Ord,Enum,Show) type RGBA = Point4 type Color = Point4 withAlpha :: Float -> RGBA -> RGBA {-# INLINE withAlpha #-} withAlpha a (V4 x y z a') = V4 x y z (a*a') red,green,blue,yellow,cyan,magenta,rose ,violet,azure,aquamarine,chartreuse,orange,white,black::Color red = V4 1 0 0 1 green = V4 0 1 0 1 blue = V4 0 0 1 1 yellow = V4 1 1 0 1 cyan = V4 0 1 1 1 magenta = V4 1 0 1 1 rose = V4 1 0 0.5 1 violet = V4 0.5 0 1 1 azure = V4 0 0.5 1 1 aquamarine= V4 0 1 0.5 1 chartreuse= V4 0.5 1 0 1 orange = V4 1 0.5 0 1 white = V4 1 1 1 1 black = V4 0 0 0 1 {-# INLINE red #-} {-# INLINE green #-} {-# INLINE blue #-} {-# INLINE yellow #-} {-# INLINE cyan #-} {-# INLINE magenta #-} {-# INLINE rose #-} {-# INLINE violet #-} {-# INLINE azure #-} {-# INLINE aquamarine #-} {-# INLINE chartreuse #-} {-# INLINE orange #-} {-# INLINE white #-} {-# INLINE black #-} paletteToColor :: PaletteColor -> Color {-# INLINE paletteToColor #-} paletteToColor pc = case pc of Red -> red Green -> green Blue -> blue Yellow -> yellow Cyan -> cyan Magenta -> magenta Rose -> rose Violet -> violet Azure -> azure Aquamarine -> aquamarine Chartreuse -> chartreuse Orange -> orange White -> white Black -> black mixColors :: Float -> Float -> Color -> Color -> Color {-# INLINE mixColors #-} mixColors rata ratb (V4 r0 g0 b0 a0) (V4 r2 g2 b2 a2) = let fullrat = rata + ratb normrata = rata / fullrat normratb = ratb / fullrat f x y = sqrt $ normrata * x^(2::Int) + normratb * y^(2::Int) in V4 (f r0 r2 ) ( f g0 g2 ) ( f b0 b2 ) ( normrata * a0 + normratb * a2) light :: Color -> Color {-# INLINE light #-} light (V4 r g b a) = V4 (r+0.2) (g+0.2) (b+0.2) a dark :: Color -> Color {-# INLINE dark #-} dark (V4 r g b a) = V4 (r-0.2) (g-0.2) (b-0.2) a dim :: Color -> Color {-# INLINE dim #-} dim (V4 r g b a) = V4 (r/1.2) (g/1.2) (b/1.2) a brightX :: Float -> Float -> Color -> Color {-# INLINE brightX #-} brightX cm am (V4 r g b a) = V4 (r*cm) (g*cm) (b*cm) (a*am) bright :: Color -> Color {-# INLINE bright #-} bright (V4 r g b a) = V4 (r*1.2) (g*1.2) (b*1.2) a greyN :: Float -> Color {-# INLINE greyN #-} greyN x = toV4 (x,x,x,1) numColor :: Int -> Color {-# INLINE numColor #-} numColor 0 = toV4 (1,0,0,1) numColor 1 = toV4 (0,1,0,1) numColor 2 = toV4 (0,0,1,1) numColor 3 = toV4 (1,1,0,1) numColor 4 = toV4 (0,1,1,1) numColor 5 = toV4 (1,0,1,1) numColor 6 = toV4 (1,0,0.5,1) numColor 7 = toV4 (0.5,0,1,1) numColor 8 = toV4 (0,0.5,1,1) numColor 9 = toV4 (0,1,0.5,1) numColor 10 = toV4 (0.5,1,0,1) numColor 11 = toV4 (1,0.5,0,1) numColor 12 = toV4 (1,1,1,1) numColor _ = toV4 (1,1,1,1)