packages feed

wholepixels-1.0: src/WholePixels/Color.hs

module WholePixels.Color where

import Relude

data HSV = HSV
  { hsvHue        :: Double
  , hsvSaturation :: Double
  , hsvValue      :: Double
  } deriving (Show, Read, Eq, Ord)

data WithAlpha color = WithAlpha
  { waColor :: color
  , waAlpha :: Double
  } deriving (Show, Read, Eq, Ord)

white :: HSV
white = HSV 0 0 1

black :: HSV
black = HSV 0 0 0

red :: HSV
red = HSV 0 1 1

mediumRed :: HSV
mediumRed = HSV 0 1 0.57

darkRed :: HSV
darkRed = HSV 0 1 0.27

gold :: HSV
gold = HSV 51 1 0.5

yellow :: HSV
yellow = HSV 50 1 1

brightGreen :: HSV
brightGreen = HSV 120 1 1

green :: HSV
green = HSV 120 0.8 1

dullGreen :: HSV
dullGreen = HSV 120 1 0.5

darkBlue :: HSV
darkBlue = HSV 219 0.77 0.43

blue :: HSV
blue = HSV 220 1 1

lightBlue :: HSV
lightBlue = HSV 220 0.3 1

teal :: HSV
teal = HSV 175 0.31 0.43

sand :: HSV
sand = HSV 46 0.39 0.92

avocadoPeel :: HSV
avocadoPeel = HSV 81 0.98 0.31

avocadoInnerGreen :: HSV
avocadoInnerGreen = HSV 70 0.88 0.61

avocadoInnerYellowishGreen :: HSV
avocadoInnerYellowishGreen = HSV 60 0.98 0.71

avocadoPitBrown :: HSV
avocadoPitBrown = HSV 20 0.4 0.3

avocadoPitHighlightBrown :: HSV
avocadoPitHighlightBrown = HSV 50 0.3 0.6

avocadoPitSlotGreen :: HSV
avocadoPitSlotGreen = HSV 60 0.98 0.5

avocadoPitSlotShadowGreen :: HSV
avocadoPitSlotShadowGreen = HSV 60 0.98 0.3

purple :: HSV
purple = HSV 271 0.79 0.68

pink :: HSV
pink = HSV 300 0.97 0.69

gray :: HSV
gray = HSV 0 0 0.7

lightGray :: HSV
lightGray = HSV 0 0 0.8

darkGray :: HSV
darkGray = HSV 0 0 0.4

brown :: HSV
brown = HSV 20 0.4 0.2

orange :: HSV
orange = HSV 17 0.89 0.90

fixHue :: Double -> Double
fixHue h | h >= 0 && h < 360 = h
fixHue h | h >= 360 = fixHue $ h - 360
fixHue h = fixHue $ h + 360

complementary :: HSV -> HSV
complementary (HSV h s v) = HSV (fixHue $ h + 180) s v

splitComplementary :: HSV -> (HSV, HSV)
splitComplementary (HSV h s v) =
    (HSV (fixHue $ h + 150) s v, HSV (fixHue $ h + 210) s v)

splitTriangle :: HSV -> (HSV, HSV)
splitTriangle (HSV h s v) =
    (HSV (fixHue $ h + 120) s v, HSV (fixHue $ h + 240) s v)

analogous :: HSV -> [HSV]
analogous (HSV h s v) =
    map
        (\dh -> HSV (fixHue $ h + dh) s v)
        [0, 30 .. 360]

data Palette = Palette
    { baseColor :: !HSV
    , colors :: ![HSV]
    } deriving (Show, Eq)