diagrams-postscript 1.0.1.2 → 1.0.2
raw patch · 5 files changed
+175/−7 lines, 5 filesdep +data-default-classdep ~diagrams-coredep ~diagrams-libdep ~lens
Dependencies added: data-default-class
Dependency ranges changed: diagrams-core, diagrams-lib, lens
Files
- LICENSE +1/−1
- diagrams-postscript.cabal +7/−5
- src/Diagrams/Backend/Postscript.hs +7/−0
- src/Diagrams/Backend/Postscript/CMYK.hs +132/−0
- src/Graphics/Rendering/Postscript.hs +28/−1
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2011-2013:+Copyright 2011-2014: Ryan Yates <fryguybob@gmail.com>
diagrams-postscript.cabal view
@@ -1,5 +1,5 @@ Name: diagrams-postscript-Version: 1.0.1.2+Version: 1.0.2 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,13 +20,14 @@ 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@@ -35,12 +36,13 @@ filepath, dlist >= 0.5 && < 0.7, 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.13,- lens >= 3.8 && < 4,+ lens >= 3.8 && < 4.1, hashable >= 1.1 && < 1.3 if impl(ghc < 7.6) build-depends: ghc-prim
src/Diagrams/Backend/Postscript.hs view
@@ -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
+ src/Diagrams/Backend/Postscript/CMYK.hs view
@@ -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++
src/Graphics/Rendering/Postscript.hs view
@@ -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 ()