content: {-# LANGUAGE PackageImports #-}
  {-# LANGUAGE PatternSynonyms #-}
  {-# LANGUAGE RebindableSyntax #-}
  {-# LANGUAGE ViewPatterns #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  
  {-
    Copyright 2020 The CodeWorld Authors. All rights reserved.
  
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.
    You may obtain a copy of the License at
  
        http://www.apache.org/licenses/LICENSE-2.0
  
    Unless required by applicable law or agreed to in writing, software
    distributed under the License is distributed on an "AS IS" BASIS,
    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    See the License for the specific language governing permissions and
    limitations under the License.
  -}
  module Internal.Color where
  
  import qualified "codeworld-api" CodeWorld as CW
  import Internal.Num
  import Internal.Truth
  import qualified "base" Prelude as P
  import "base" Prelude ((.))
  
  -- | A color.
  --
  -- Colors can be described in several ways:
  --
  -- 1. Using common color names: 'red', 'blue', 'yellow', 'green',
  --    'orange', 'purple', 'pink', 'black', 'white', 'brown', and
  --    'gray'.
  -- 2. Transforming other colors with functions such as 'light',
  --    'dark', 'bright', 'dull', 'translucent', and 'mixed'.
  -- 3. Constructing colors from coordinates in a color space, such
  --    as 'RGB', 'RGBA', or 'HSL'.
  --
  -- Note that transparency is included in a color.  Common color
  -- names and the 'RGB' and 'HSL' constructors only produce opaque
  -- colors, but 'RGBA' and the 'translucent' function work with
  -- transparency.
  newtype Color = Color {toCWColor :: CW.Color} deriving (P.Eq)
  
  -- | A synonym for 'Color', using the non-US spelling.
  type Colour = Color
  
  {-# RULES
  "equality/color" forall (x :: Color). (==) x = (P.==) x
    #-}
  
  pattern RGBA :: (Number, Number, Number, Number) -> Color
  pattern RGBA components <-
    (toRGBA -> components)
    where
      RGBA components =
        let (r, g, b, a) = components
         in Color
              ( CW.RGBA
                  (toDouble r)
                  (toDouble g)
                  (toDouble b)
                  (toDouble a)
              )
  
  -- Utility function for RGB pattern synonym.
  toRGBA :: Color -> (Number, Number, Number, Number)
  toRGBA (Color (CW.RGBA r g b a)) =
    (fromDouble r, fromDouble g, fromDouble b, fromDouble a)
  
  pattern RGB :: (Number, Number, Number) -> Color
  pattern RGB components <-
    (toRGB -> P.Just components)
    where
      RGB components =
        let (r, g, b) = components
         in Color
              ( CW.RGBA
                  (toDouble r)
                  (toDouble g)
                  (toDouble b)
                  (toDouble 1)
              )
  
  -- Utility function for RGB pattern synonym.
  toRGB :: Color -> P.Maybe (Number, Number, Number)
  toRGB (Color (CW.RGBA r g b (fromDouble -> 1))) =
    P.Just (fromDouble r, fromDouble g, fromDouble b)
  toRGB _ = P.Nothing
  
  pattern HSL :: (Number, Number, Number) -> Color
  pattern HSL components <-
    (toHSL -> P.Just components)
    where
      HSL components = fromHSL components
  
  -- Utility functions for HSL pattern synonym.
  toHSL :: Color -> P.Maybe (Number, Number, Number)
  toHSL c@(RGBA (_, _, _, 1)) = P.Just (hue c, saturation c, luminosity c)
  toHSL _ = P.Nothing
  
  fromHSL :: (Number, Number, Number) -> Color
  fromHSL (h, s, l) =
    Color (CW.HSL (toDouble (pi * h / 180)) (toDouble s) (toDouble l))
  
  -- | Produces a color by mixing other colors in equal proportion.
  --
  -- The order of colors is unimportant.  Colors may be mixed in uneven
  -- proportions by listing a color more than once, such as
  -- @mixed([red, red, orange])@.
  mixed :: [Color] -> Color
  mixed = Color . CW.mixed . P.map toCWColor
  
  -- | Increases the luminosity of a color by the given amount.
  --
  -- The amount should be between -1 and 1, where:
  --
  -- * @lighter(c, 1)@ is always white, regardless of @c@.
  -- * @lighter(c, 0)@ is the same as @c@.
  -- * @lighter(c, -1)@ is always black, regardless of @c@.
  lighter :: (Color, Number) -> Color
  lighter (c, d) = Color (CW.lighter (toDouble d) (toCWColor c))
  
  -- | Produces a lighter shade of the given color.
  --
  -- This function may be nested more than once to produce an even
  -- lighter shade, as in @light(light(blue))@.
  light :: Color -> Color
  light = Color . CW.light . toCWColor
  
  -- | Decreases the luminosity of a color by the given amount.
  --
  -- The amount should be between -1 and 1, where:
  --
  -- * @darker(c, 1)@ is always black, regardless of @c@.
  -- * @darker(c, 0)@ is the same as @c@.
  -- * @darker(c, -1)@ is always white, regardless of @c@.
  darker :: (Color, Number) -> Color
  darker (c, d) = Color (CW.darker (toDouble d) (toCWColor c))
  
  -- | Produces a darker shade of the given color.
  --
  -- This function may be nested more than once to produce an even
  -- darker shade, as in @dark(dark(green))@.
  dark :: Color -> Color
  dark = Color . CW.dark . toCWColor
  
  -- | Increases the saturation of a color by the given amount.
  --
  -- The amount should be between -1 and 1, where:
  --
  -- * @brighter(c, 1)@ is a fully saturated version of @c@.
  -- * @brighter(c, 0)@ is the same as @c@.
  -- * @brighter(c, -1)@ is just a shade of gray with no color.
  brighter :: (Color, Number) -> Color
  brighter (c, d) = Color (CW.brighter (toDouble d) (toCWColor c))
  
  -- | Produces a brighter shade of the given color; that is, less
  -- gray and more colorful.
  --
  -- This function may be nested more than once to produce an even
  -- brighter shade, as in @bright(bright(yellow))@.
  bright :: Color -> Color
  bright = Color . CW.bright . toCWColor
  
  -- | Decreases the saturation of a color by the given amount.
  --
  -- The amount should be between -1 and 1, where:
  --
  -- * @duller(c, 1)@ is just a shade of gray with no color.
  -- * @duller(c, 0)@ is the same as @c@.
  -- * @duller(c, -1)@ is a fully saturated version of @c@.
  duller :: (Color, Number) -> Color
  duller (c, d) = Color (CW.duller (toDouble d) (toCWColor c))
  
  -- | Produces a duller shade of the given color; that is, more
  -- gray and less colorful.
  --
  -- This function may be nested more than once to produce an even
  -- duller shade, as in @dull(dull(purple))@.
  dull :: Color -> Color
  dull = Color . CW.dull . toCWColor
  
  -- | Produces a partially transparent color.
  --
  -- This function may be nested more than once to produce an even
  -- more transparent color, as in @translucent(translucent(brown))@.
  translucent :: Color -> Color
  translucent = Color . CW.translucent . toCWColor
  
  -- | An infinite list of various colors.
  --
  -- The list is chosen to contain a variety of different hues as
  -- spread out as possible to create colorful effects.
  assortedColors :: [Color]
  assortedColors = P.map Color CW.assortedColors
  
  hue, saturation, luminosity, alpha :: Color -> Number
  hue = (180 *) . (/ pi) . fromDouble . CW.hue . toCWColor
  saturation = fromDouble . CW.saturation . toCWColor
  luminosity = fromDouble . CW.luminosity . toCWColor
  alpha = fromDouble . CW.alpha . toCWColor
  
  -- New style colors
  
  -- | The color white
  white :: Color
  white = Color CW.white
  
  -- | The color black
  black :: Color
  black = Color CW.black
  
  -- | The color gray
  gray :: Color
  gray = Color CW.gray
  
  -- | The color grey
  --
  -- This is the same color as 'gray', but with a non-US
  -- spelling.
  grey :: Color
  grey = Color CW.grey
  
  -- | The color red
  red :: Color
  red = Color CW.red
  
  -- | The color orange
  orange :: Color
  orange = Color CW.orange
  
  -- | The color yellow
  yellow :: Color
  yellow = Color CW.yellow
  
  -- | The color green
  green :: Color
  green = Color CW.green
  
  -- | The color blue
  blue :: Color
  blue = Color CW.blue
  
  -- | The color purple
  purple :: Color
  purple = Color CW.purple
  
  -- | The color pink
  pink :: Color
  pink = Color CW.pink
  
  -- | The color brown
  brown :: Color
  brown = Color CW.brown
  