module Data.Colour
(
Colour
,colourConvert
,black
,AlphaColour
,opaque, withOpacity
,transparent
,alphaColourConvert
,alphaChannel
,AffineSpace(..), blend
,ColourOps(..)
,dissolve, atop
)
where
import Data.Char
import Data.Colour.Internal
import qualified Data.Colour.SRGB.Linear
import Data.Colour.CIE.Chromaticity (app_prec, infix_prec)
instance (Fractional a, Show a) => Show (Colour a) where
showsPrec :: Int -> Colour a -> ShowS
showsPrec d :: Int
d c :: Colour a
c = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) ShowS
showStr
where
showStr :: ShowS
showStr = String -> ShowS
showString String
linearConstructorQualifiedName
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString " " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) a
r)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString " " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) a
g)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString " " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) a
b)
Data.Colour.SRGB.Linear.RGB r :: a
r g :: a
g b :: a
b = Colour a -> RGB a
forall a. Fractional a => Colour a -> RGB a
Data.Colour.SRGB.Linear.toRGB Colour a
c
instance (Fractional a, Read a) => Read (Colour a) where
readsPrec :: Int -> ReadS (Colour a)
readsPrec d :: Int
d r :: String
r = Bool -> ReadS (Colour a) -> ReadS (Colour a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec)
(\r :: String
r -> [(a -> a -> a -> Colour a
forall a. Fractional a => a -> a -> a -> Colour a
Data.Colour.SRGB.Linear.rgb a
r0 a
g0 a
b0,String
t)
|(name :: String
name,s :: String
s) <- String -> [(String, String)]
mylex String
r
,String
name String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
linearConstructorName
,String
linearConstructorQualifiedName]
,(r0 :: a
r0,s0 :: String
s0) <- Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) String
s
,(g0 :: a
g0,s1 :: String
s1) <- Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) String
s0
,(b0 :: a
b0,t :: String
t) <- Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) String
s1]) String
r
where
mylex :: String -> [(String, String)]
mylex = (String, String) -> [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return
((String, String) -> [(String, String)])
-> (String -> (String, String)) -> String -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\c :: Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "._'")
(String -> (String, String)) -> ShowS -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
linearConstructorQualifiedName :: String
linearConstructorQualifiedName = "Data.Colour.SRGB.Linear.rgb"
linearConstructorName :: String
linearConstructorName = "rgb"
instance (Fractional a, Show a, Eq a) => Show (AlphaColour a) where
showsPrec :: Int -> AlphaColour a -> ShowS
showsPrec d :: Int
d ac :: AlphaColour a
ac | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = String -> ShowS
showString "transparent"
| Bool
otherwise = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
infix_prec) ShowS
showStr
where
showStr :: ShowS
showStr = Int -> Colour a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
infix_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Colour a
c
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString " `withOpacity` "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
infix_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) a
a
a :: a
a = AlphaColour a -> a
forall a. AlphaColour a -> a
alphaChannel AlphaColour a
ac
c :: Colour a
c = AlphaColour a -> Colour a
forall a. Fractional a => AlphaColour a -> Colour a
colourChannel AlphaColour a
ac
instance (Fractional a, Read a) => Read (AlphaColour a) where
readsPrec :: Int -> ReadS (AlphaColour a)
readsPrec d :: Int
d r :: String
r = [(AlphaColour a
forall a. Num a => AlphaColour a
transparent,String
s)|("transparent",s :: String
s) <- String -> [(String, String)]
lex String
r]
[(AlphaColour a, String)]
-> [(AlphaColour a, String)] -> [(AlphaColour a, String)]
forall a. [a] -> [a] -> [a]
++ Bool -> ReadS (AlphaColour a) -> ReadS (AlphaColour a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
infix_prec)
(\r :: String
r -> [(Colour a
c Colour a -> a -> AlphaColour a
forall a. Num a => Colour a -> a -> AlphaColour a
`withOpacity` a
o,String
s)
|(c :: Colour a
c,r0 :: String
r0) <- Int -> ReadS (Colour a)
forall a. Read a => Int -> ReadS a
readsPrec (Int
infix_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) String
r
,("`",r1 :: String
r1) <- String -> [(String, String)]
lex String
r0
,("withOpacity",r2 :: String
r2) <- String -> [(String, String)]
lex String
r1
,("`",r3 :: String
r3) <- String -> [(String, String)]
lex String
r2
,(o :: a
o,s :: String
s) <- Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec (Int
infix_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) String
r3]) String
r