146 lines
3.5 KiB
Haskell
146 lines
3.5 KiB
Haskell
module Color (
|
|
module Color,
|
|
module Color.Data,
|
|
) where
|
|
|
|
import Color.Data
|
|
import Geometry
|
|
import Control.Lens
|
|
|
|
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
|
|
|
|
normalizeColor :: Color -> Color
|
|
{-# INLINE normalizeColor #-}
|
|
normalizeColor (V4 r g b a) = V4 (f r) (f g) (f b) (f a)
|
|
where
|
|
f = min 1 . max 0
|
|
|
|
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)
|
|
|
|
mixColorsLinear :: Float -> Float -> Color -> Color -> Color
|
|
{-# INLINE mixColorsLinear #-}
|
|
mixColorsLinear 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 = normrata * x + normratb * y
|
|
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)
|
|
|
|
lightx4 :: Color -> Color
|
|
lightx4 = light . light . light . light
|
|
|
|
toColor8 :: Color -> Color8
|
|
toColor8 = over each floor . (255 *) . normalizeColor
|