diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2011-2013: +Copyright 2011-2014: Ryan Yates diff --git a/diagrams-postscript.cabal b/diagrams-postscript.cabal --- a/diagrams-postscript.cabal +++ b/diagrams-postscript.cabal @@ -1,5 +1,5 @@ Name: diagrams-postscript -Version: 1.0.2.3 +Version: 1.0.2.4 Synopsis: Postscript backend for diagrams drawing EDSL Description: This package provides a modular backend for rendering diagrams created with the diagrams EDSL using Postscript. @@ -20,28 +20,29 @@ Category: Graphics Build-type: Simple Cabal-version: >=1.10 -Tested-with: GHC == 7.4.2, GHC == 7.6.1 +Tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1 Source-repository head type: git location: https://github.com/diagrams/diagrams-postscript.git Library Exposed-modules: Diagrams.Backend.Postscript + Diagrams.Backend.Postscript.CMYK Diagrams.Backend.Postscript.CmdLine Graphics.Rendering.Postscript Hs-source-dirs: src Build-depends: base >= 4.2 && < 4.8, mtl >= 2.0 && < 2.2, filepath, - dlist >= 0.5 && < 0.7, + dlist >= 0.5 && < 0.8, vector-space >= 0.7.7 && < 0.9, - diagrams-core >= 1.0 && < 1.1, - diagrams-lib >= 1.0.1 && < 1.1, + diagrams-core >= 1.0 && < 1.2, + diagrams-lib >= 1.0.1 && < 1.2, + data-default-class < 0.1, split >= 0.1.2 && < 0.3, monoid-extras >= 0.3 && < 0.4, semigroups >= 0.3.4 && < 0.14, lens >= 3.8 && < 4.2, - containers >= 0.3 && < 0.6, hashable >= 1.1 && < 1.3 if impl(ghc < 7.6) build-depends: ghc-prim diff --git a/src/Diagrams/Backend/Postscript.hs b/src/Diagrams/Backend/Postscript.hs --- a/src/Diagrams/Backend/Postscript.hs +++ b/src/Diagrams/Backend/Postscript.hs @@ -48,6 +48,7 @@ import qualified Graphics.Rendering.Postscript as C +import Diagrams.Backend.Postscript.CMYK import Diagrams.Prelude hiding (view) @@ -180,6 +181,7 @@ , handle fWeight , handle fSize , handle fColor + , handle fColorCMYK , handle lFillRule ] where @@ -191,6 +193,7 @@ fSlant = assign (C.drawState . C.font . C.slant) .fromFontSlant <$> getFontSlant fWeight = assign (C.drawState . C.font . C.weight) . fromFontWeight <$> getFontWeight fColor c = C.fillColor (getFillColor c) + fColorCMYK c = C.fillColorCMYK (getFillColorCMYK c) lFillRule = assign (C.drawState . C.fillRule) . getFillRule fromFontSlant :: FontSlant -> C.FontSlant @@ -205,7 +208,9 @@ postscriptStyle :: Style v -> C.Render () postscriptStyle s = sequence_ -- foldr (>>) (return ()) . catMaybes $ [ handle fColor + , handle fColorCMYK , handle lColor + , handle lColorCMYK , handle lWidth , handle lJoin , handle lMiter @@ -215,7 +220,9 @@ where handle :: (AttributeClass a) => (a -> C.Render ()) -> Maybe (C.Render ()) handle f = f `fmap` getAttr s lColor = C.strokeColor . getLineColor + lColorCMYK = C.strokeColorCMYK . getLineColorCMYK fColor c = C.fillColor (getFillColor c) >> C.fillPreserve + fColorCMYK c = C.fillColorCMYK (getFillColorCMYK c) >> C.fillPreserve lWidth = C.lineWidth . getLineWidth lCap = C.lineCap . getLineCap lJoin = C.lineJoin . getLineJoin diff --git a/src/Diagrams/Backend/Postscript/CMYK.hs b/src/Diagrams/Backend/Postscript/CMYK.hs new file mode 100644 --- /dev/null +++ b/src/Diagrams/Backend/Postscript/CMYK.hs @@ -0,0 +1,132 @@ +{-# 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 Diagrams.Core.Style (setAttr) +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, Semigroup) +instance AttributeClass LineColorCMYK + +instance Default LineColorCMYK where + def = LineColorCMYK (Last (CMYK 0 0 0 1)) + +getLineColorCMYK :: LineColorCMYK -> CMYK +getLineColorCMYK (LineColorCMYK (Last c)) = c + +mkLineColorCMYK :: CMYK -> LineColorCMYK +mkLineColorCMYK = LineColorCMYK . Last + +styleLineColorCMYK :: Setter' (Style v) CMYK +styleLineColorCMYK = sets modifyLineColorCMYK + where + modifyLineColorCMYK f s + = flip setAttr s + . mkLineColorCMYK + . f + . getLineColorCMYK + . fromMaybe def . getAttr + $ s + +-- | Set the line (stroke) color. +lineColorCMYK :: HasStyle a => CMYK -> a -> a +lineColorCMYK = applyAttr . mkLineColorCMYK + +-- | Apply a 'lineColorCMYK' attribute. +lineColorCMYKA :: HasStyle a => LineColorCMYK -> a -> a +lineColorCMYKA = applyAttr + +-- | A synonym for 'lineColorCMYK'. +lcCMYK :: HasStyle a => CMYK -> a -> a +lcCMYK = 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, Semigroup) +instance AttributeClass FillColorCMYK + +instance Default FillColorCMYK where + def = FillColorCMYK (Recommend (Last (CMYK 0 0 0 0))) + +mkFillColorCMYK :: CMYK -> FillColorCMYK +mkFillColorCMYK = FillColorCMYK . Commit . Last + +styleFillColorCMYK :: Setter' (Style v) CMYK +styleFillColorCMYK = sets modifyFillColorCMYK + where + modifyFillColorCMYK f s + = flip setAttr s + . mkFillColorCMYK + . f + . getFillColorCMYK + . fromMaybe def . getAttr + $ s + +-- | Set the fill color. +fillColorCMYK :: HasStyle a => CMYK -> a -> a +fillColorCMYK = applyAttr . 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 = applyAttr . FillColorCMYK . Recommend . Last + +getFillColorCMYK :: FillColorCMYK -> CMYK +getFillColorCMYK (FillColorCMYK c) = getLast . getRecommend $ c + +-- | A synonym for 'fillColorCMYK' +fcCMYK :: HasStyle a => CMYK -> a -> a +fcCMYK = fillColorCMYK + + diff --git a/src/Graphics/Rendering/Postscript.hs b/src/Graphics/Rendering/Postscript.hs --- a/src/Graphics/Rendering/Postscript.hs +++ b/src/Graphics/Rendering/Postscript.hs @@ -49,7 +49,9 @@ , scale , rotate , strokeColor + , strokeColorCMYK , fillColor + , fillColorCMYK , lineWidth , lineCap , lineJoin @@ -66,6 +68,8 @@ , face, slant, weight, size , fillRule, ignoreFill, font + + , CMYK(..), cyan, magenta, yellow, blacK ) where import Diagrams.Attributes(Color(..),LineCap(..),LineJoin(..),colorToSRGBA) @@ -73,13 +77,23 @@ import Control.Applicative import Control.Monad.Writer import Control.Monad.State -import Control.Lens hiding (transform, moveTo) +import Control.Lens (makeLenses, use, (%=), (.=)) import Data.List(intersperse) import Data.DList(DList,toList,fromList) import Data.Char(ord,isPrint) import Numeric(showIntAtBase) import System.IO (openFile, hPutStr, IOMode(..), hClose) +data CMYK = CMYK + { _cyan :: Double + , _magenta :: Double + , _yellow :: Double + , _blacK :: Double + } + deriving (Show, Eq) + +makeLenses ''CMYK + data FontSlant = FontSlantNormal | FontSlantItalic | FontSlantOblique @@ -339,6 +353,7 @@ restoreMatrix :: Render () restoreMatrix = renderPS "setmatrix" +-- RGB colors colorPS :: Color c => c -> [Double] colorPS c = [ r, g, b ] where (r,g,b,_) = colorToSRGBA c @@ -350,6 +365,18 @@ -- | Set the color of the fill. fillColor :: (Color c) => c -> Render () fillColor c = mkPSCall "setrgbcolor" (colorPS c) + +-- CMYK colors +colorCMYK :: CMYK -> [Double] +colorCMYK (CMYK c m y k) = [c,m,y,k] + +-- | Set the color of the stroke. +strokeColorCMYK :: CMYK -> Render () +strokeColorCMYK c = mkPSCall "setcmykcolor" (colorCMYK c) + +-- | Set the color of the fill. +fillColorCMYK :: CMYK -> Render () +fillColorCMYK c = mkPSCall "setcmykcolor" (colorCMYK c) -- | Set the line width. lineWidth :: Double -> Render ()