{-# 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, NonEmpty LineColorCMYK -> LineColorCMYK
LineColorCMYK -> LineColorCMYK -> 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 :: forall b. Integral b => 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 (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Last a
Last

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

styleLineColorCMYK :: Setter' (Style v Double ) CMYK
styleLineColorCMYK :: forall (v :: * -> *). Setter' (Style v Double) CMYK
styleLineColorCMYK = 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 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
      = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a (v :: * -> *) n.
AttributeClass a =>
a -> Style v n -> Style v n
setAttr Style v n
s
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> LineColorCMYK
mkLineColorCMYK
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> CMYK
f
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineColorCMYK -> CMYK
getLineColorCMYK
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
getAttr
      forall a b. (a -> b) -> a -> b
$ Style v n
s

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

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

-- | A synonym for 'lineColorCMYK'.
lcCMYK :: HasStyle a => CMYK -> a -> a
lcCMYK :: forall a. HasStyle a => CMYK -> a -> a
lcCMYK = 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, NonEmpty FillColorCMYK -> FillColorCMYK
FillColorCMYK -> FillColorCMYK -> 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 :: forall b. Integral b => 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 (forall a. a -> Recommend a
Recommend (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Recommend a
Commit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Last a
Last

styleFillColorCMYK :: Setter' (Style v Double) CMYK
styleFillColorCMYK :: forall (v :: * -> *). Setter' (Style v Double) CMYK
styleFillColorCMYK = 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 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
      = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a (v :: * -> *) n.
AttributeClass a =>
a -> Style v n -> Style v n
setAttr Style v n
s
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> FillColorCMYK
mkFillColorCMYK
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMYK -> CMYK
f
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. FillColorCMYK -> CMYK
getFillColorCMYK
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
getAttr
      forall a b. (a -> b) -> a -> b
$ Style v n
s

-- | Set the fill color.
fillColorCMYK :: HasStyle a => CMYK -> a -> a
fillColorCMYK :: forall a. HasStyle a => CMYK -> a -> a
fillColorCMYK = forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr 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 :: forall a. HasStyle a => CMYK -> a -> a
recommendFillColorCMYK = forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Recommend (Last CMYK) -> FillColorCMYK
FillColorCMYK forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Recommend a
Recommend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Last a
Last

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

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