113 lines
3.2 KiB
Haskell
113 lines
3.2 KiB
Haskell
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)
|