{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Postscript.CMYK
-- Copyright   :  (c) 2014 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Support for CMYK color attributes in the Postscript backend.
--
-----------------------------------------------------------------------------

module Diagrams.Backend.Postscript.CMYK (
  -- * CMYK
  -- $color

    CMYK(..)

  -- ** Line color
  , LineColorCMYK, getLineColorCMYK, mkLineColorCMYK, styleLineColorCMYK, lineColorCMYK, lineColorCMYKA, lcCMYK

  -- ** Fill color
  , FillColorCMYK, getFillColorCMYK, mkFillColorCMYK, styleFillColorCMYK, recommendFillColorCMYK
  , fillColorCMYK, fcCMYK

  ) where

import           Control.Lens          (Setter', sets, (.~))
import           Data.Default.Class
import           Data.Maybe            (fromMaybe)
import           Data.Monoid.Recommend
import           Data.Semigroup
import           Data.Typeable

import           Diagrams.Core
import           Graphics.Rendering.Postscript(CMYK(..))

------------------------------------------------------------
--  Color  -------------------------------------------------
------------------------------------------------------------

-- $color
-- CMYK colors are represented with four values from 0.0 to 1.0.


-- | The color with which lines (strokes) are drawn.  Note that child
--   colors always override parent colors; that is, @'lineColorCMYK' c1
--   . 'lineColorCMYK' c2 $ d@ is equivalent to @'lineColorCMYK' c2 $ d@.
--   More precisely, the semigroup structure on line color attributes
--   is that of 'Last'.
newtype LineColorCMYK = LineColorCMYK (Last CMYK)
  deriving (Typeable, b -> LineColorCMYK -> LineColorCMYK
NonEmpty LineColorCMYK -> LineColorCMYK
LineColorCMYK -> LineColorCMYK -> LineColorCMYK
(LineColorCMYK -> LineColorCMYK -> LineColorCMYK)
-> (NonEmpty LineColorCMYK -> LineColorCMYK)
-> (forall b. Integral b => b -> LineColorCMYK -> LineColorCMYK)
-> Semigroup LineColorCMYK
forall b. Integral b => b -> LineColorCMYK -> LineColorCMYK
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> LineColorCMYK -> LineColorCMYK
$cstimes :: forall b. Integral b => b -> LineColorCMYK -> LineColorCMYK
sconcat :: NonEmpty LineColorCMYK -> LineColorCMYK
$csconcat :: NonEmpty LineColorCMYK -> LineColorCMYK
<> :: LineColorCMYK -> LineColorCMYK -> LineColorCMYK
$c<> :: LineColorCMYK -> LineColorCMYK -> LineColorCMYK
Semigroup)
instance AttributeClass LineColorCMYK

instance Default LineColorCMYK where
    def :: LineColorCMYK
def = Last CMYK -> LineColorCMYK
LineColorCMYK (CMYK -> Last CMYK
forall a. a -> Last a
Last (Double -> Double -> Double -> Double -> CMYK
CMYK Double
0 Double
0 Double
0 Double
1))

getLineColorCMYK :: LineColorCMYK -> CMYK
getLineColorCMYK :: LineColorCMYK -> CMYK
getLineColorCMYK (LineColorCMYK (Last CMYK
c)) = CMYK
c

mkLineColorCMYK :: CMYK -> LineColorCMYK
mkLineColorCMYK :: CMYK -> LineColorCMYK
mkLineColorCMYK = Last CMYK -> LineColorCMYK
LineColorCMYK (Last CMYK -> LineColorCMYK)
-> (CMYK -> Last CMYK) -> CMYK -> LineColorCMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> Last CMYK
forall a. a -> Last a
Last

setAttr :: AttributeClass a => a -> Style v n -> Style v n
setAttr :: a -> Style v n -> Style v n
setAttr a
a = (Maybe a -> Identity (Maybe a))
-> Style v n -> Identity (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe a -> Identity (Maybe a))
 -> Style v n -> Identity (Style v n))
-> Maybe a -> Style v n -> Style v n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ a -> Maybe a
forall a. a -> Maybe a
Just a
a

styleLineColorCMYK :: Setter' (Style v Double ) CMYK
styleLineColorCMYK :: (CMYK -> f CMYK) -> Style v Double -> f (Style v Double)
styleLineColorCMYK = ((CMYK -> CMYK) -> Style v Double -> Style v Double)
-> (CMYK -> f CMYK) -> Style v Double -> f (Style v Double)
forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets (CMYK -> CMYK) -> Style v Double -> Style v Double
forall (v :: * -> *) n. (CMYK -> CMYK) -> Style v n -> Style v n
modifyLineColorCMYK
  where
    modifyLineColorCMYK :: (CMYK -> CMYK) -> Style v n -> Style v n
modifyLineColorCMYK CMYK -> CMYK
f Style v n
s
      = (LineColorCMYK -> Style v n -> Style v n)
-> Style v n -> LineColorCMYK -> Style v n
forall a b c. (a -> b -> c) -> b -> a -> c
flip LineColorCMYK -> Style v n -> Style v n
forall a (v :: * -> *) n.
AttributeClass a =>
a -> Style v n -> Style v n
setAttr Style v n
s
      (LineColorCMYK -> Style v n)
-> (Style v n -> LineColorCMYK) -> Style v n -> Style v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> LineColorCMYK
mkLineColorCMYK
      (CMYK -> LineColorCMYK)
-> (Style v n -> CMYK) -> Style v n -> LineColorCMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> CMYK
f
      (CMYK -> CMYK) -> (Style v n -> CMYK) -> Style v n -> CMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineColorCMYK -> CMYK
getLineColorCMYK
      (LineColorCMYK -> CMYK)
-> (Style v n -> LineColorCMYK) -> Style v n -> CMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineColorCMYK -> Maybe LineColorCMYK -> LineColorCMYK
forall a. a -> Maybe a -> a
fromMaybe LineColorCMYK
forall a. Default a => a
def (Maybe LineColorCMYK -> LineColorCMYK)
-> (Style v n -> Maybe LineColorCMYK) -> Style v n -> LineColorCMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style v n -> Maybe LineColorCMYK
forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
getAttr
      (Style v n -> Style v n) -> Style v n -> Style v n
forall a b. (a -> b) -> a -> b
$ Style v n
s

-- | Set the line (stroke) color.
lineColorCMYK :: HasStyle a => CMYK -> a -> a
lineColorCMYK :: CMYK -> a -> a
lineColorCMYK = LineColorCMYK -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (LineColorCMYK -> a -> a)
-> (CMYK -> LineColorCMYK) -> CMYK -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> LineColorCMYK
mkLineColorCMYK

-- | Apply a 'lineColorCMYK' attribute.
lineColorCMYKA :: HasStyle a => LineColorCMYK -> a -> a
lineColorCMYKA :: LineColorCMYK -> a -> a
lineColorCMYKA = LineColorCMYK -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr

-- | A synonym for 'lineColorCMYK'.
lcCMYK :: HasStyle a => CMYK -> a -> a
lcCMYK :: CMYK -> a -> a
lcCMYK = CMYK -> a -> a
forall a. HasStyle a => CMYK -> a -> a
lineColorCMYK

-- | The color with which shapes are filled. Note that child
--   colors always override parent colors; that is, @'fillColorCMYK' c1
--   . 'fillColorCMYK' c2 $ d@ is equivalent to @'lineColorCMYK' c2 $ d@.
--   More precisely, the semigroup structure on fill color attributes
--   is that of 'Last'.
newtype FillColorCMYK = FillColorCMYK (Recommend (Last CMYK))
  deriving (Typeable, b -> FillColorCMYK -> FillColorCMYK
NonEmpty FillColorCMYK -> FillColorCMYK
FillColorCMYK -> FillColorCMYK -> FillColorCMYK
(FillColorCMYK -> FillColorCMYK -> FillColorCMYK)
-> (NonEmpty FillColorCMYK -> FillColorCMYK)
-> (forall b. Integral b => b -> FillColorCMYK -> FillColorCMYK)
-> Semigroup FillColorCMYK
forall b. Integral b => b -> FillColorCMYK -> FillColorCMYK
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> FillColorCMYK -> FillColorCMYK
$cstimes :: forall b. Integral b => b -> FillColorCMYK -> FillColorCMYK
sconcat :: NonEmpty FillColorCMYK -> FillColorCMYK
$csconcat :: NonEmpty FillColorCMYK -> FillColorCMYK
<> :: FillColorCMYK -> FillColorCMYK -> FillColorCMYK
$c<> :: FillColorCMYK -> FillColorCMYK -> FillColorCMYK
Semigroup)
instance AttributeClass FillColorCMYK

instance Default FillColorCMYK where
  def :: FillColorCMYK
def = Recommend (Last CMYK) -> FillColorCMYK
FillColorCMYK (Last CMYK -> Recommend (Last CMYK)
forall a. a -> Recommend a
Recommend (CMYK -> Last CMYK
forall a. a -> Last a
Last (Double -> Double -> Double -> Double -> CMYK
CMYK Double
0 Double
0 Double
0 Double
0)))

mkFillColorCMYK :: CMYK -> FillColorCMYK
mkFillColorCMYK :: CMYK -> FillColorCMYK
mkFillColorCMYK = Recommend (Last CMYK) -> FillColorCMYK
FillColorCMYK (Recommend (Last CMYK) -> FillColorCMYK)
-> (CMYK -> Recommend (Last CMYK)) -> CMYK -> FillColorCMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last CMYK -> Recommend (Last CMYK)
forall a. a -> Recommend a
Commit (Last CMYK -> Recommend (Last CMYK))
-> (CMYK -> Last CMYK) -> CMYK -> Recommend (Last CMYK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> Last CMYK
forall a. a -> Last a
Last

styleFillColorCMYK :: Setter' (Style v Double) CMYK
styleFillColorCMYK :: (CMYK -> f CMYK) -> Style v Double -> f (Style v Double)
styleFillColorCMYK = ((CMYK -> CMYK) -> Style v Double -> Style v Double)
-> (CMYK -> f CMYK) -> Style v Double -> f (Style v Double)
forall (p :: * -> * -> *) (q :: * -> * -> *) (f :: * -> *) a b s t.
(Profunctor p, Profunctor q, Settable f) =>
(p a b -> q s t) -> Optical p q f s t a b
sets (CMYK -> CMYK) -> Style v Double -> Style v Double
forall (v :: * -> *) n. (CMYK -> CMYK) -> Style v n -> Style v n
modifyFillColorCMYK
  where
    modifyFillColorCMYK :: (CMYK -> CMYK) -> Style v n -> Style v n
modifyFillColorCMYK CMYK -> CMYK
f Style v n
s
      = (FillColorCMYK -> Style v n -> Style v n)
-> Style v n -> FillColorCMYK -> Style v n
forall a b c. (a -> b -> c) -> b -> a -> c
flip FillColorCMYK -> Style v n -> Style v n
forall a (v :: * -> *) n.
AttributeClass a =>
a -> Style v n -> Style v n
setAttr Style v n
s
      (FillColorCMYK -> Style v n)
-> (Style v n -> FillColorCMYK) -> Style v n -> Style v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> FillColorCMYK
mkFillColorCMYK
      (CMYK -> FillColorCMYK)
-> (Style v n -> CMYK) -> Style v n -> FillColorCMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> CMYK
f
      (CMYK -> CMYK) -> (Style v n -> CMYK) -> Style v n -> CMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FillColorCMYK -> CMYK
getFillColorCMYK
      (FillColorCMYK -> CMYK)
-> (Style v n -> FillColorCMYK) -> Style v n -> CMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FillColorCMYK -> Maybe FillColorCMYK -> FillColorCMYK
forall a. a -> Maybe a -> a
fromMaybe FillColorCMYK
forall a. Default a => a
def (Maybe FillColorCMYK -> FillColorCMYK)
-> (Style v n -> Maybe FillColorCMYK) -> Style v n -> FillColorCMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style v n -> Maybe FillColorCMYK
forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
getAttr
      (Style v n -> Style v n) -> Style v n -> Style v n
forall a b. (a -> b) -> a -> b
$ Style v n
s

-- | Set the fill color.
fillColorCMYK :: HasStyle a => CMYK -> a -> a
fillColorCMYK :: CMYK -> a -> a
fillColorCMYK = FillColorCMYK -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (FillColorCMYK -> a -> a)
-> (CMYK -> FillColorCMYK) -> CMYK -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> FillColorCMYK
mkFillColorCMYK

-- | Set a \"recommended\" fill color, to be used only if no explicit
--   calls to 'fillColor' (or 'fc', or 'fcA') are used.
recommendFillColorCMYK :: HasStyle a => CMYK -> a -> a
recommendFillColorCMYK :: CMYK -> a -> a
recommendFillColorCMYK = FillColorCMYK -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (FillColorCMYK -> a -> a)
-> (CMYK -> FillColorCMYK) -> CMYK -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recommend (Last CMYK) -> FillColorCMYK
FillColorCMYK (Recommend (Last CMYK) -> FillColorCMYK)
-> (CMYK -> Recommend (Last CMYK)) -> CMYK -> FillColorCMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last CMYK -> Recommend (Last CMYK)
forall a. a -> Recommend a
Recommend (Last CMYK -> Recommend (Last CMYK))
-> (CMYK -> Last CMYK) -> CMYK -> Recommend (Last CMYK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> Last CMYK
forall a. a -> Last a
Last

getFillColorCMYK :: FillColorCMYK -> CMYK
getFillColorCMYK :: FillColorCMYK -> CMYK
getFillColorCMYK (FillColorCMYK Recommend (Last CMYK)
c) = Last CMYK -> CMYK
forall a. Last a -> a
getLast (Last CMYK -> CMYK)
-> (Recommend (Last CMYK) -> Last CMYK)
-> Recommend (Last CMYK)
-> CMYK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recommend (Last CMYK) -> Last CMYK
forall a. Recommend a -> a
getRecommend (Recommend (Last CMYK) -> CMYK) -> Recommend (Last CMYK) -> CMYK
forall a b. (a -> b) -> a -> b
$ Recommend (Last CMYK)
c

-- | A synonym for 'fillColorCMYK'
fcCMYK :: HasStyle a => CMYK -> a -> a
fcCMYK :: CMYK -> a -> a
fcCMYK = CMYK -> a -> a
forall a. HasStyle a => CMYK -> a -> a
fillColorCMYK