---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- PDF Patterns
---------------------------------------------------------

module Graphics.PDF.Pattern(
   -- * Pattern
    TilingType(..)
  , PDFColoredPattern
  , PDFUncoloredPattern
  , createColoredTiling
  , createUncoloredTiling
  , setColoredFillPattern
  , setColoredStrokePattern
  , setUncoloredFillPattern
  , setUncoloredStrokePattern
 ) where

import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Draw
import Graphics.PDF.Resources
import qualified Data.Map.Strict as M
import Graphics.PDF.Pages(recordBound,createContent)
import Control.Monad.State
import Control.Monad.Writer
import Graphics.PDF.LowLevel.Serializer

data PaintType = ColoredTiling
               | UncoloredTiling
               deriving(PaintType -> PaintType -> Bool
(PaintType -> PaintType -> Bool)
-> (PaintType -> PaintType -> Bool) -> Eq PaintType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PaintType -> PaintType -> Bool
$c/= :: PaintType -> PaintType -> Bool
== :: PaintType -> PaintType -> Bool
$c== :: PaintType -> PaintType -> Bool
Eq,Int -> PaintType
PaintType -> Int
PaintType -> [PaintType]
PaintType -> PaintType
PaintType -> PaintType -> [PaintType]
PaintType -> PaintType -> PaintType -> [PaintType]
(PaintType -> PaintType)
-> (PaintType -> PaintType)
-> (Int -> PaintType)
-> (PaintType -> Int)
-> (PaintType -> [PaintType])
-> (PaintType -> PaintType -> [PaintType])
-> (PaintType -> PaintType -> [PaintType])
-> (PaintType -> PaintType -> PaintType -> [PaintType])
-> Enum PaintType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PaintType -> PaintType -> PaintType -> [PaintType]
$cenumFromThenTo :: PaintType -> PaintType -> PaintType -> [PaintType]
enumFromTo :: PaintType -> PaintType -> [PaintType]
$cenumFromTo :: PaintType -> PaintType -> [PaintType]
enumFromThen :: PaintType -> PaintType -> [PaintType]
$cenumFromThen :: PaintType -> PaintType -> [PaintType]
enumFrom :: PaintType -> [PaintType]
$cenumFrom :: PaintType -> [PaintType]
fromEnum :: PaintType -> Int
$cfromEnum :: PaintType -> Int
toEnum :: Int -> PaintType
$ctoEnum :: Int -> PaintType
pred :: PaintType -> PaintType
$cpred :: PaintType -> PaintType
succ :: PaintType -> PaintType
$csucc :: PaintType -> PaintType
Enum)
               
-- | Tiling type
data TilingType = ConstantSpacing
                | NoDistortion
                | ConstantSpacingAndFaster
                deriving(TilingType -> TilingType -> Bool
(TilingType -> TilingType -> Bool)
-> (TilingType -> TilingType -> Bool) -> Eq TilingType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TilingType -> TilingType -> Bool
$c/= :: TilingType -> TilingType -> Bool
== :: TilingType -> TilingType -> Bool
$c== :: TilingType -> TilingType -> Bool
Eq,Int -> TilingType
TilingType -> Int
TilingType -> [TilingType]
TilingType -> TilingType
TilingType -> TilingType -> [TilingType]
TilingType -> TilingType -> TilingType -> [TilingType]
(TilingType -> TilingType)
-> (TilingType -> TilingType)
-> (Int -> TilingType)
-> (TilingType -> Int)
-> (TilingType -> [TilingType])
-> (TilingType -> TilingType -> [TilingType])
-> (TilingType -> TilingType -> [TilingType])
-> (TilingType -> TilingType -> TilingType -> [TilingType])
-> Enum TilingType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TilingType -> TilingType -> TilingType -> [TilingType]
$cenumFromThenTo :: TilingType -> TilingType -> TilingType -> [TilingType]
enumFromTo :: TilingType -> TilingType -> [TilingType]
$cenumFromTo :: TilingType -> TilingType -> [TilingType]
enumFromThen :: TilingType -> TilingType -> [TilingType]
$cenumFromThen :: TilingType -> TilingType -> [TilingType]
enumFrom :: TilingType -> [TilingType]
$cenumFrom :: TilingType -> [TilingType]
fromEnum :: TilingType -> Int
$cfromEnum :: TilingType -> Int
toEnum :: Int -> TilingType
$ctoEnum :: Int -> TilingType
pred :: TilingType -> TilingType
$cpred :: TilingType -> TilingType
succ :: TilingType -> TilingType
$csucc :: TilingType -> TilingType
Enum)
  
-- | Create a colored tiling pattern
createColoredTiling :: PDFFloat -- ^ Left
                    -> PDFFloat -- ^ Bottom
                    -> PDFFloat -- ^ Right
                    -> PDFFloat -- ^ Top
                    -> PDFFloat -- ^ Horizontal step
                    -> PDFFloat -- ^ Vertical step
                    -> TilingType
                    -> Draw a -- ^ Drawing commands
                    -> PDF (PDFReference PDFColoredPattern)
createColoredTiling :: PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> TilingType
-> Draw a
-> PDF (PDFReference PDFColoredPattern)
createColoredTiling  PDFFloat
xa PDFFloat
ya PDFFloat
xb PDFFloat
yb PDFFloat
hstep PDFFloat
vstep  TilingType
tt Draw a
d =  PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PaintType
-> TilingType
-> Draw a
-> PDF Int
forall a.
PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PaintType
-> TilingType
-> Draw a
-> PDF Int
createTilingPattern PDFFloat
xa PDFFloat
ya PDFFloat
xb PDFFloat
yb PDFFloat
hstep PDFFloat
vstep PaintType
ColoredTiling TilingType
tt Draw a
d  PDF Int
-> (Int -> PDF (PDFReference PDFColoredPattern))
-> PDF (PDFReference PDFColoredPattern)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PDFReference PDFColoredPattern
-> PDF (PDFReference PDFColoredPattern)
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFReference PDFColoredPattern
 -> PDF (PDFReference PDFColoredPattern))
-> (Int -> PDFReference PDFColoredPattern)
-> Int
-> PDF (PDFReference PDFColoredPattern)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFReference PDFColoredPattern
forall s. Int -> PDFReference s
PDFReference
 
-- | Create an uncolored tiling pattern
createUncoloredTiling :: PDFFloat -- ^ Left
                      -> PDFFloat -- ^ Bottom
                      -> PDFFloat -- ^ Right
                      -> PDFFloat -- ^ Top
                      -> PDFFloat -- ^ Horizontal step
                      -> PDFFloat -- ^ Vertical step
                      -> TilingType
                      -> Draw a -- ^ Drawing commands
                      -> PDF (PDFReference PDFUncoloredPattern)
createUncoloredTiling :: PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> TilingType
-> Draw a
-> PDF (PDFReference PDFUncoloredPattern)
createUncoloredTiling  PDFFloat
xa PDFFloat
ya PDFFloat
xb PDFFloat
yb PDFFloat
hstep PDFFloat
vstep  TilingType
tt Draw a
d =  PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PaintType
-> TilingType
-> Draw a
-> PDF Int
forall a.
PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PaintType
-> TilingType
-> Draw a
-> PDF Int
createTilingPattern PDFFloat
xa PDFFloat
ya PDFFloat
xb PDFFloat
yb PDFFloat
hstep PDFFloat
vstep PaintType
UncoloredTiling TilingType
tt Draw a
d PDF Int
-> (Int -> PDF (PDFReference PDFUncoloredPattern))
-> PDF (PDFReference PDFUncoloredPattern)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PDFReference PDFUncoloredPattern
-> PDF (PDFReference PDFUncoloredPattern)
forall (m :: * -> *) a. Monad m => a -> m a
return (PDFReference PDFUncoloredPattern
 -> PDF (PDFReference PDFUncoloredPattern))
-> (Int -> PDFReference PDFUncoloredPattern)
-> Int
-> PDF (PDFReference PDFUncoloredPattern)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFReference PDFUncoloredPattern
forall s. Int -> PDFReference s
PDFReference  

-- | Create a PDF tiling pattern
createTilingPattern :: PDFFloat -- ^ Left
                    -> PDFFloat -- ^ Bottom
                    -> PDFFloat -- ^ Right
                    -> PDFFloat -- ^ Top
                    -> PDFFloat -- ^ Horizontal step
                    -> PDFFloat -- ^ Vertical step
                    -> PaintType
                    -> TilingType
                    -> Draw a -- ^ Drawing commands
                    -> PDF Int
createTilingPattern :: PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PaintType
-> TilingType
-> Draw a
-> PDF Int
createTilingPattern PDFFloat
xa PDFFloat
ya PDFFloat
xb PDFFloat
yb PDFFloat
hstep PDFFloat
vstep PaintType
pt TilingType
tt Draw a
d = 
    let a' :: Draw a
a' = do (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s  {otherRsrcs :: PDFDictionary
otherRsrcs = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary(Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ 
                                             [ (String -> PDFName
PDFName String
"Type",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ String
"Pattern")
                                             , (String -> PDFName
PDFName String
"PatternType",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> AnyPdfObject) -> Int -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ Int
1)
                                             , (String -> PDFName
PDFName String
"PaintType",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> AnyPdfObject) -> Int -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ (PaintType -> Int
forall a. Enum a => a -> Int
fromEnum PaintType
pt) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                                             , (String -> PDFName
PDFName String
"TilingType",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> AnyPdfObject) -> Int -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ (TilingType -> Int
forall a. Enum a => a -> Int
fromEnum TilingType
tt) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                                             , (String -> PDFName
PDFName String
"Matrix",[AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject)
-> ([Int] -> [AnyPdfObject]) -> [Int] -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> AnyPdfObject) -> [Int] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map (PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger)) ([Int] -> AnyPdfObject) -> [Int] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ [Int
1,Int
0,Int
0,Int
1,Int
0,Int
0])
                                             , (String -> PDFName
PDFName String
"BBox",[AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([AnyPdfObject] -> AnyPdfObject)
-> ([PDFFloat] -> [AnyPdfObject]) -> [PDFFloat] -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PDFFloat -> AnyPdfObject) -> [PDFFloat] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject  ([PDFFloat] -> AnyPdfObject) -> [PDFFloat] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ [PDFFloat
xa,PDFFloat
ya,PDFFloat
xb,PDFFloat
yb])
                                             , (String -> PDFName
PDFName String
"XStep",PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
hstep)
                                             , (String -> PDFName
PDFName String
"YStep",PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
vstep)
                                             ]
                                         }
                Draw a
d
   in do
       PDFReference Int
s <- Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
forall a.
Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
createContent Draw a
a' Maybe (PDFReference PDFPage)
forall a. Maybe a
Nothing  
       Int -> PDFFloat -> PDFFloat -> PDF ()
recordBound Int
s (PDFFloat
xbPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
-PDFFloat
xa) (PDFFloat
ybPDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
-PDFFloat
ya)
       Int -> PDF Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
s
      
       
-- | Set the fill pattern
setColoredFillPattern :: PDFReference PDFColoredPattern -> Draw ()
setColoredFillPattern :: PDFReference PDFColoredPattern -> Draw ()
setColoredFillPattern (PDFReference Int
a) = do
     Map (PDFReference AnyPdfPattern) String
patternMap <- (DrawState -> Map (PDFReference AnyPdfPattern) String)
-> Draw (Map (PDFReference AnyPdfPattern) String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map (PDFReference AnyPdfPattern) String
patterns
     (String
newName,Map (PDFReference AnyPdfPattern) String
newMap) <- String
-> PDFReference AnyPdfPattern
-> Map (PDFReference AnyPdfPattern) String
-> Draw (String, Map (PDFReference AnyPdfPattern) String)
forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"Pattern" (Int -> PDFReference AnyPdfPattern
forall s. Int -> PDFReference s
PDFReference Int
a) Map (PDFReference AnyPdfPattern) String
patternMap
     (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { patterns :: Map (PDFReference AnyPdfPattern) String
patterns = Map (PDFReference AnyPdfPattern) String
newMap }
     Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ()) -> (String -> Builder) -> String -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String -> Draw ()) -> String -> Draw ()
forall a b. (a -> b) -> a -> b
$ (String
"\n/Pattern cs")
     Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ())
-> ([Builder] -> Builder) -> [Builder] -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Draw ()) -> [Builder] -> Draw ()
forall a b. (a -> b) -> a -> b
$[ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n/" 
                     , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
newName
                     , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" scn"
                     ]
     
-- | Set the stroke pattern
setColoredStrokePattern :: PDFReference PDFColoredPattern -> Draw ()
setColoredStrokePattern :: PDFReference PDFColoredPattern -> Draw ()
setColoredStrokePattern (PDFReference Int
a) = do
  Map (PDFReference AnyPdfPattern) String
patternMap <- (DrawState -> Map (PDFReference AnyPdfPattern) String)
-> Draw (Map (PDFReference AnyPdfPattern) String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map (PDFReference AnyPdfPattern) String
patterns
  (String
newName,Map (PDFReference AnyPdfPattern) String
newMap) <- String
-> PDFReference AnyPdfPattern
-> Map (PDFReference AnyPdfPattern) String
-> Draw (String, Map (PDFReference AnyPdfPattern) String)
forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"Pattern" (Int -> PDFReference AnyPdfPattern
forall s. Int -> PDFReference s
PDFReference Int
a) Map (PDFReference AnyPdfPattern) String
patternMap
  (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { patterns :: Map (PDFReference AnyPdfPattern) String
patterns = Map (PDFReference AnyPdfPattern) String
newMap }
  Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ()) -> (String -> Builder) -> String -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
forall s a. SerializeValue s a => a -> s
serialize (String -> Draw ()) -> String -> Draw ()
forall a b. (a -> b) -> a -> b
$ (String
"\n/Pattern CS")
  Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ())
-> ([Builder] -> Builder) -> [Builder] -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Draw ()) -> [Builder] -> Draw ()
forall a b. (a -> b) -> a -> b
$[ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n/" 
                  , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
newName
                  , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" SCN"
                  ]
  
  

-- | Set the fill pattern
setUncoloredFillPattern :: PDFReference PDFUncoloredPattern -> Color -> Draw ()
setUncoloredFillPattern :: PDFReference PDFUncoloredPattern -> Color -> Draw ()
setUncoloredFillPattern (PDFReference Int
a) Color
col = do
       let (PDFFloat
r,PDFFloat
g,PDFFloat
b) = Color -> (PDFFloat, PDFFloat, PDFFloat)
getRgbColor Color
col
       Map PDFColorSpace String
colorMap <- (DrawState -> Map PDFColorSpace String)
-> Draw (Map PDFColorSpace String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map PDFColorSpace String
colorSpaces
       (String
newColorName,Map PDFColorSpace String
_) <- String
-> PDFColorSpace
-> Map PDFColorSpace String
-> Draw (String, Map PDFColorSpace String)
forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"ColorSpace" PDFColorSpace
PatternRGB Map PDFColorSpace String
colorMap
       Map (PDFReference AnyPdfPattern) String
patternMap <- (DrawState -> Map (PDFReference AnyPdfPattern) String)
-> Draw (Map (PDFReference AnyPdfPattern) String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map (PDFReference AnyPdfPattern) String
patterns
       (String
newName,Map (PDFReference AnyPdfPattern) String
newMap) <- String
-> PDFReference AnyPdfPattern
-> Map (PDFReference AnyPdfPattern) String
-> Draw (String, Map (PDFReference AnyPdfPattern) String)
forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"Pattern" (Int -> PDFReference AnyPdfPattern
forall s. Int -> PDFReference s
PDFReference Int
a) Map (PDFReference AnyPdfPattern) String
patternMap
       (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { patterns :: Map (PDFReference AnyPdfPattern) String
patterns = Map (PDFReference AnyPdfPattern) String
newMap }
       Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ())
-> ([Builder] -> Builder) -> [Builder] -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Draw ()) -> [Builder] -> Draw ()
forall a b. (a -> b) -> a -> b
$[ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n/" 
                       , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
newColorName
                       , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" cs"
                       ]
       Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ())
-> ([Builder] -> Builder) -> [Builder] -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Draw ()) -> [Builder] -> Draw ()
forall a b. (a -> b) -> a -> b
$[ Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
'\n'
                       , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
r
                       , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                       , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
g
                       , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                       , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
b
                       , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                       , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" /"
                       , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
newName
                       , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" scn"
                       ]

-- | Set the stroke pattern
setUncoloredStrokePattern :: PDFReference PDFUncoloredPattern -> Color -> Draw ()
setUncoloredStrokePattern :: PDFReference PDFUncoloredPattern -> Color -> Draw ()
setUncoloredStrokePattern (PDFReference Int
a) Color
col = do
    let (PDFFloat
r,PDFFloat
g,PDFFloat
b) = Color -> (PDFFloat, PDFFloat, PDFFloat)
getRgbColor Color
col
    Map PDFColorSpace String
colorMap <- (DrawState -> Map PDFColorSpace String)
-> Draw (Map PDFColorSpace String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map PDFColorSpace String
colorSpaces
    (String
newColorName,Map PDFColorSpace String
_) <- String
-> PDFColorSpace
-> Map PDFColorSpace String
-> Draw (String, Map PDFColorSpace String)
forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"ColorSpace" PDFColorSpace
PatternRGB Map PDFColorSpace String
colorMap
    Map (PDFReference AnyPdfPattern) String
patternMap <- (DrawState -> Map (PDFReference AnyPdfPattern) String)
-> Draw (Map (PDFReference AnyPdfPattern) String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map (PDFReference AnyPdfPattern) String
patterns
    (String
newName,Map (PDFReference AnyPdfPattern) String
newMap) <- String
-> PDFReference AnyPdfPattern
-> Map (PDFReference AnyPdfPattern) String
-> Draw (String, Map (PDFReference AnyPdfPattern) String)
forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"Pattern" (Int -> PDFReference AnyPdfPattern
forall s. Int -> PDFReference s
PDFReference Int
a) Map (PDFReference AnyPdfPattern) String
patternMap
    (DrawState -> DrawState) -> Draw ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict ((DrawState -> DrawState) -> Draw ())
-> (DrawState -> DrawState) -> Draw ()
forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { patterns :: Map (PDFReference AnyPdfPattern) String
patterns = Map (PDFReference AnyPdfPattern) String
newMap }
    Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ())
-> ([Builder] -> Builder) -> [Builder] -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Draw ()) -> [Builder] -> Draw ()
forall a b. (a -> b) -> a -> b
$[ String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
"\n/" 
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
newColorName
                    , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" CS"
                    ]
    Builder -> Draw ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> Draw ())
-> ([Builder] -> Builder) -> [Builder] -> Draw ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Draw ()) -> [Builder] -> Draw ()
forall a b. (a -> b) -> a -> b
$   [ Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
'\n'
                       , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
r
                       , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                       , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
g
                       , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                       , PDFFloat -> Builder
forall a. PdfObject a => a -> Builder
toPDF PDFFloat
b
                       , Char -> Builder
forall s a. SerializeValue s a => a -> s
serialize Char
' '
                       , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" /"
                       , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
newName
                       , String -> Builder
forall s a. SerializeValue s a => a -> s
serialize String
" SCN"
                       ]