Move from store to flat
This commit is contained in:
+110
-79
@@ -1,76 +1,110 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Color where
|
||||
import GHC.Generics
|
||||
|
||||
import Flat
|
||||
import Data.Aeson
|
||||
import Data.Store
|
||||
import GHC.Generics
|
||||
import Geometry
|
||||
import LinearHelp
|
||||
import TH.Derive
|
||||
import Data.Store
|
||||
|
||||
data PaletteColor = RED | GREEN | BLUE | YELLOW | CYAN
|
||||
| MAGENTA | ROSE | VIOLET | AZURE | AQUAMARINE | CHARTREUSE | ORANGE | WHITE | BLACK
|
||||
deriving (Eq,Ord,Enum,Show,Read,Generic)
|
||||
data PaletteColor
|
||||
= RED
|
||||
| GREEN
|
||||
| BLUE
|
||||
| YELLOW
|
||||
| CYAN
|
||||
| MAGENTA
|
||||
| ROSE
|
||||
| VIOLET
|
||||
| AZURE
|
||||
| AQUAMARINE
|
||||
| CHARTREUSE
|
||||
| ORANGE
|
||||
| WHITE
|
||||
| BLACK
|
||||
deriving (Eq, Ord, Enum, Show, Read, Generic, Flat)
|
||||
|
||||
instance ToJSON PaletteColor where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
instance FromJSON PaletteColor
|
||||
|
||||
type RGBA = Point4
|
||||
instance FromJSON PaletteColor
|
||||
|
||||
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')
|
||||
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 #-}
|
||||
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 #-}
|
||||
{-# 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
|
||||
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 #-}
|
||||
@@ -80,65 +114,62 @@ normalizeColor (V4 r g b a) = V4 (f r) (f g) (f b) (f a)
|
||||
|
||||
mixColors :: Float -> Float -> Color -> Color -> Color
|
||||
{-# INLINE mixColors #-}
|
||||
mixColors rata ratb (V4 r0 g0 b0 a0) (V4 r2 g2 b2 a2) =
|
||||
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)
|
||||
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) =
|
||||
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)
|
||||
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
|
||||
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
|
||||
|
||||
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
|
||||
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)
|
||||
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
|
||||
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)
|
||||
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)
|
||||
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)
|
||||
|
||||
light4 :: Color -> Color
|
||||
light4 = light . light . light . light
|
||||
|
||||
$($(derive [d| instance Deriving (Store PaletteColor) |]))
|
||||
-- $($(derive [d| instance Deriving (Store ProximityRequirement) |]))
|
||||
|
||||
Reference in New Issue
Block a user