75 lines
2.0 KiB
Haskell
75 lines
2.0 KiB
Haskell
module Color
|
|
where
|
|
import Geometry
|
|
|
|
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 #-}
|
|
|
|
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)
|