module Graphics.PDF.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
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]
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)
data TilingType = ConstantSpacing
| NoDistortion
| ConstantSpacingAndFaster
deriving(TilingType -> TilingType -> Bool
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]
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)
createColoredTiling :: PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> TilingType
-> Draw a
-> PDF (PDFReference PDFColoredPattern)
createColoredTiling :: forall a.
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 = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Int -> PDFReference s
PDFReference
createUncoloredTiling :: PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> TilingType
-> Draw a
-> PDF (PDFReference PDFUncoloredPattern)
createUncoloredTiling :: forall a.
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 = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Int -> PDFReference s
PDFReference
createTilingPattern :: PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PDFFloat
-> PaintType
-> TilingType
-> Draw a
-> PDF Int
createTilingPattern :: 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
pt TilingType
tt Draw a
d =
let a' :: Draw a
a' = do forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s {otherRsrcs :: PDFDictionary
otherRsrcs = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionaryforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[ (String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"Pattern")
, (String -> PDFName
PDFName String
"PatternType",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ Int
1)
, (String -> PDFName
PDFName String
"PaintType",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ (forall a. Enum a => a -> Int
fromEnum PaintType
pt) forall a. Num a => a -> a -> a
+ Int
1)
, (String -> PDFName
PDFName String
"TilingType",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ (forall a. Enum a => a -> Int
fromEnum TilingType
tt) forall a. Num a => a -> a -> a
+ Int
1)
, (String -> PDFName
PDFName String
"Matrix",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> [a] -> [b]
map (forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger)) forall a b. (a -> b) -> a -> b
$ [Int
1,Int
0,Int
0,Int
1,Int
0,Int
0])
, (String -> PDFName
PDFName String
"BBox",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ [PDFFloat
xa,PDFFloat
ya,PDFFloat
xb,PDFFloat
yb])
, (String -> PDFName
PDFName String
"XStep",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
hstep)
, (String -> PDFName
PDFName String
"YStep",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFFloat
vstep)
]
}
Draw a
d
in do
PDFReference Int
s <- forall a.
Draw a
-> Maybe (PDFReference PDFPage) -> PDF (PDFReference PDFStream)
createContent Draw a
a' forall a. Maybe a
Nothing
Int -> PDFFloat -> PDFFloat -> PDF ()
recordBound Int
s (PDFFloat
xbforall a. Num a => a -> a -> a
-PDFFloat
xa) (PDFFloat
ybforall a. Num a => a -> a -> a
-PDFFloat
ya)
forall (m :: * -> *) a. Monad m => a -> m a
return Int
s
setColoredFillPattern :: PDFReference PDFColoredPattern -> Draw ()
setColoredFillPattern :: PDFReference PDFColoredPattern -> Draw ()
setColoredFillPattern (PDFReference Int
a) = do
Map (PDFReference AnyPdfPattern) String
patternMap <- 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) <- forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"Pattern" (forall s. Int -> PDFReference s
PDFReference Int
a) Map (PDFReference AnyPdfPattern) String
patternMap
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { patterns :: Map (PDFReference AnyPdfPattern) String
patterns = Map (PDFReference AnyPdfPattern) String
newMap }
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. SerializeValue s a => a -> s
serialize forall a b. (a -> b) -> a -> b
$ (String
"\n/Pattern cs")
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [ forall s a. SerializeValue s a => a -> s
serialize String
"\n/"
, forall s a. SerializeValue s a => a -> s
serialize String
newName
, forall s a. SerializeValue s a => a -> s
serialize String
" scn"
]
setColoredStrokePattern :: PDFReference PDFColoredPattern -> Draw ()
setColoredStrokePattern :: PDFReference PDFColoredPattern -> Draw ()
setColoredStrokePattern (PDFReference Int
a) = do
Map (PDFReference AnyPdfPattern) String
patternMap <- 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) <- forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"Pattern" (forall s. Int -> PDFReference s
PDFReference Int
a) Map (PDFReference AnyPdfPattern) String
patternMap
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { patterns :: Map (PDFReference AnyPdfPattern) String
patterns = Map (PDFReference AnyPdfPattern) String
newMap }
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. SerializeValue s a => a -> s
serialize forall a b. (a -> b) -> a -> b
$ (String
"\n/Pattern CS")
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [ forall s a. SerializeValue s a => a -> s
serialize String
"\n/"
, forall s a. SerializeValue s a => a -> s
serialize String
newName
, forall s a. SerializeValue s a => a -> s
serialize String
" SCN"
]
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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map PDFColorSpace String
colorSpaces
(String
newColorName,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 <- 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) <- forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"Pattern" (forall s. Int -> PDFReference s
PDFReference Int
a) Map (PDFReference AnyPdfPattern) String
patternMap
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { patterns :: Map (PDFReference AnyPdfPattern) String
patterns = Map (PDFReference AnyPdfPattern) String
newMap }
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [ forall s a. SerializeValue s a => a -> s
serialize String
"\n/"
, forall s a. SerializeValue s a => a -> s
serialize String
newColorName
, forall s a. SerializeValue s a => a -> s
serialize String
" cs"
]
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [ forall s a. SerializeValue s a => a -> s
serialize Char
'\n'
, forall a. PdfObject a => a -> Builder
toPDF PDFFloat
r
, forall s a. SerializeValue s a => a -> s
serialize Char
' '
, forall a. PdfObject a => a -> Builder
toPDF PDFFloat
g
, forall s a. SerializeValue s a => a -> s
serialize Char
' '
, forall a. PdfObject a => a -> Builder
toPDF PDFFloat
b
, forall s a. SerializeValue s a => a -> s
serialize Char
' '
, forall s a. SerializeValue s a => a -> s
serialize String
" /"
, forall s a. SerializeValue s a => a -> s
serialize String
newName
, forall s a. SerializeValue s a => a -> s
serialize String
" scn"
]
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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DrawState -> Map PDFColorSpace String
colorSpaces
(String
newColorName,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 <- 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) <- forall a.
(Ord a, PdfResourceObject a) =>
String -> a -> Map a String -> Draw (String, Map a String)
setResource String
"Pattern" (forall s. Int -> PDFReference s
PDFReference Int
a) Map (PDFReference AnyPdfPattern) String
patternMap
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modifyStrict forall a b. (a -> b) -> a -> b
$ \DrawState
s -> DrawState
s { patterns :: Map (PDFReference AnyPdfPattern) String
patterns = Map (PDFReference AnyPdfPattern) String
newMap }
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [ forall s a. SerializeValue s a => a -> s
serialize String
"\n/"
, forall s a. SerializeValue s a => a -> s
serialize String
newColorName
, forall s a. SerializeValue s a => a -> s
serialize String
" CS"
]
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ [ forall s a. SerializeValue s a => a -> s
serialize Char
'\n'
, forall a. PdfObject a => a -> Builder
toPDF PDFFloat
r
, forall s a. SerializeValue s a => a -> s
serialize Char
' '
, forall a. PdfObject a => a -> Builder
toPDF PDFFloat
g
, forall s a. SerializeValue s a => a -> s
serialize Char
' '
, forall a. PdfObject a => a -> Builder
toPDF PDFFloat
b
, forall s a. SerializeValue s a => a -> s
serialize Char
' '
, forall s a. SerializeValue s a => a -> s
serialize String
" /"
, forall s a. SerializeValue s a => a -> s
serialize String
newName
, forall s a. SerializeValue s a => a -> s
serialize String
" SCN"
]