{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Ipe.Color
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Data type for representing colors in ipe as well as the colors available in
-- the standard ipe stylesheet.
--
--------------------------------------------------------------------------------
module Data.Geometry.Ipe.Color where

import Data.Colour.SRGB (RGB(..))
import Data.Geometry.Ipe.Value
import Data.Text
import Data.Traversable
--------------------------------------------------------------------------------

newtype IpeColor r = IpeColor (IpeValue (RGB r)) deriving (Int -> IpeColor r -> ShowS
[IpeColor r] -> ShowS
IpeColor r -> String
(Int -> IpeColor r -> ShowS)
-> (IpeColor r -> String)
-> ([IpeColor r] -> ShowS)
-> Show (IpeColor r)
forall r. Show r => Int -> IpeColor r -> ShowS
forall r. Show r => [IpeColor r] -> ShowS
forall r. Show r => IpeColor r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpeColor r] -> ShowS
$cshowList :: forall r. Show r => [IpeColor r] -> ShowS
show :: IpeColor r -> String
$cshow :: forall r. Show r => IpeColor r -> String
showsPrec :: Int -> IpeColor r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> IpeColor r -> ShowS
Show,ReadPrec [IpeColor r]
ReadPrec (IpeColor r)
Int -> ReadS (IpeColor r)
ReadS [IpeColor r]
(Int -> ReadS (IpeColor r))
-> ReadS [IpeColor r]
-> ReadPrec (IpeColor r)
-> ReadPrec [IpeColor r]
-> Read (IpeColor r)
forall r. Read r => ReadPrec [IpeColor r]
forall r. Read r => ReadPrec (IpeColor r)
forall r. Read r => Int -> ReadS (IpeColor r)
forall r. Read r => ReadS [IpeColor r]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IpeColor r]
$creadListPrec :: forall r. Read r => ReadPrec [IpeColor r]
readPrec :: ReadPrec (IpeColor r)
$creadPrec :: forall r. Read r => ReadPrec (IpeColor r)
readList :: ReadS [IpeColor r]
$creadList :: forall r. Read r => ReadS [IpeColor r]
readsPrec :: Int -> ReadS (IpeColor r)
$creadsPrec :: forall r. Read r => Int -> ReadS (IpeColor r)
Read,IpeColor r -> IpeColor r -> Bool
(IpeColor r -> IpeColor r -> Bool)
-> (IpeColor r -> IpeColor r -> Bool) -> Eq (IpeColor r)
forall r. Eq r => IpeColor r -> IpeColor r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpeColor r -> IpeColor r -> Bool
$c/= :: forall r. Eq r => IpeColor r -> IpeColor r -> Bool
== :: IpeColor r -> IpeColor r -> Bool
$c== :: forall r. Eq r => IpeColor r -> IpeColor r -> Bool
Eq)

instance Ord r => Ord (IpeColor r) where
  (IpeColor IpeValue (RGB r)
c) compare :: IpeColor r -> IpeColor r -> Ordering
`compare` (IpeColor IpeValue (RGB r)
c') = (RGB r -> (r, r, r)) -> IpeValue (RGB r) -> IpeValue (r, r, r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RGB r -> (r, r, r)
forall c. RGB c -> (c, c, c)
f IpeValue (RGB r)
c IpeValue (r, r, r) -> IpeValue (r, r, r) -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (RGB r -> (r, r, r)) -> IpeValue (RGB r) -> IpeValue (r, r, r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RGB r -> (r, r, r)
forall c. RGB c -> (c, c, c)
f IpeValue (RGB r)
c'
    where
      f :: RGB c -> (c, c, c)
f (RGB c
r c
g c
b) = (c
r,c
g,c
b)

instance Functor IpeColor where
  fmap :: (a -> b) -> IpeColor a -> IpeColor b
fmap = (a -> b) -> IpeColor a -> IpeColor b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault
instance Foldable IpeColor where
  foldMap :: (a -> m) -> IpeColor a -> m
foldMap = (a -> m) -> IpeColor a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault
instance Traversable IpeColor where
  traverse :: (a -> f b) -> IpeColor a -> f (IpeColor b)
traverse a -> f b
f (IpeColor IpeValue (RGB a)
v) = IpeValue (RGB b) -> IpeColor b
forall r. IpeValue (RGB r) -> IpeColor r
IpeColor (IpeValue (RGB b) -> IpeColor b)
-> f (IpeValue (RGB b)) -> f (IpeColor b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RGB a -> f (RGB b)) -> IpeValue (RGB a) -> f (IpeValue (RGB b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse RGB a -> f (RGB b)
traverseRGB IpeValue (RGB a)
v
    where
      traverseRGB :: RGB a -> f (RGB b)
traverseRGB (RGB a
r a
g a
b) = b -> b -> b -> RGB b
forall a. a -> a -> a -> RGB a
RGB (b -> b -> b -> RGB b) -> f b -> f (b -> b -> RGB b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
r f (b -> b -> RGB b) -> f b -> f (b -> RGB b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
g f (b -> RGB b) -> f b -> f (RGB b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
b

-- | Creates a named color
named :: Text -> IpeColor r
named :: Text -> IpeColor r
named = IpeValue (RGB r) -> IpeColor r
forall r. IpeValue (RGB r) -> IpeColor r
IpeColor (IpeValue (RGB r) -> IpeColor r)
-> (Text -> IpeValue (RGB r)) -> Text -> IpeColor r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IpeValue (RGB r)
forall v. Text -> IpeValue v
Named

--------------------------------------------------------------------------------
-- * Basic Named colors

red :: IpeColor r
red :: IpeColor r
red = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"red"

green :: IpeColor r
green :: IpeColor r
green = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"green"

blue :: IpeColor r
blue :: IpeColor r
blue = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"blue"

yellow :: IpeColor r
yellow :: IpeColor r
yellow = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"yellow"

orange :: IpeColor r
orange :: IpeColor r
orange = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"orange"

gold :: IpeColor r
gold :: IpeColor r
gold = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"gold"

purple :: IpeColor r
purple :: IpeColor r
purple = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"purple"

gray :: IpeColor r
gray :: IpeColor r
gray = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"gray"

brown :: IpeColor r
brown :: IpeColor r
brown = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"brown"

navy :: IpeColor r
navy :: IpeColor r
navy = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"navy"

pink :: IpeColor r
pink :: IpeColor r
pink = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"pink"

seagreen :: IpeColor r
seagreen :: IpeColor r
seagreen = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"seagreen"

turquoise :: IpeColor r
turquoise :: IpeColor r
turquoise = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"turquoise"

violet :: IpeColor r
violet :: IpeColor r
violet = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"violet"

darkblue :: IpeColor r
darkblue :: IpeColor r
darkblue = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"darkblue"

darkcyan :: IpeColor r
darkcyan :: IpeColor r
darkcyan = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"darkcyan"

darkgray :: IpeColor r
darkgray :: IpeColor r
darkgray = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"darkgray"

darkgreen :: IpeColor r
darkgreen :: IpeColor r
darkgreen = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"darkgreen"

darkmagenta :: IpeColor r
darkmagenta :: IpeColor r
darkmagenta = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"darkmagenta"

darkorange :: IpeColor r
darkorange :: IpeColor r
darkorange = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"darkorange"

darkred :: IpeColor r
darkred :: IpeColor r
darkred = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"darkred"

lightblue :: IpeColor r
lightblue :: IpeColor r
lightblue = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"lightblue"

lightcyan :: IpeColor r
lightcyan :: IpeColor r
lightcyan = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"lightcyan"

lightgray :: IpeColor r
lightgray :: IpeColor r
lightgray = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"lightgray"

lightgreen :: IpeColor r
lightgreen :: IpeColor r
lightgreen = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"lightgreen"

lightyellow :: IpeColor r
lightyellow :: IpeColor r
lightyellow = Text -> IpeColor r
forall r. Text -> IpeColor r
named Text
"lightyellow"