{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TupleSections #-}
module Graphics.Rasterific.MicroPdf( renderDrawingToPdf
, renderDrawingsToPdf
, renderOrdersToPdf
) where
import Control.Monad.Free( liftF, Free( .. ) )
import Control.Monad.Free.Church( fromF )
import Control.Monad.State( StateT, get, put, runStateT, modify, execState )
import Control.Monad.Reader( Reader, local, asks, runReader )
import Numeric( showFFloat )
import Data.List( sortOn )
import qualified Data.Foldable as F
import Data.Word( Word32 )
import Data.ByteString.Builder( byteString
, intDec
, toLazyByteString
, word32BE
, word8
, Builder )
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Codec.Picture( PixelRGBA8( PixelRGBA8 )
, Pixel8
, Pixel
, PixelBaseComponent
, pixelOpacity
, mixWithAlpha
)
import Graphics.Rasterific.MiniLens( Lens', use, (.^), (.=), (+=), (%=) )
import Graphics.Rasterific.Types
import Graphics.Rasterific.Linear
import Graphics.Rasterific.Compositor
import Graphics.Rasterific.Command
import Graphics.Rasterific.CubicBezier
import Graphics.Rasterific.PlaneBoundable
import Graphics.Rasterific.Line
import Graphics.Rasterific.Immediate
import Graphics.Rasterific.Operators
import Graphics.Rasterific.Transformations
import Graphics.Rasterific.PathWalker
import Graphics.Rasterific.ComplexPrimitive
import Graphics.Rasterific.Patch
import Graphics.Rasterific.PatchTypes
import Graphics.Rasterific.MeshPatch
import Graphics.Text.TrueType( Dpi )
import Text.Printf
glength :: Foldable f => f a -> Int
glength :: f a -> Int
glength = f a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length
type PdfCommand = B.ByteString
type PdfId = Int
data PdfObject = PdfObject
{ PdfObject -> Int
_pdfId :: !PdfId
, PdfObject -> Int
_pdfRevision :: !PdfId
, PdfObject -> Resources
_pdfAnnot :: !Resources
, PdfObject -> ByteString
_pdfStream :: !B.ByteString
}
instance Eq PdfObject where
PdfObject
obj1 == :: PdfObject -> PdfObject -> Bool
== PdfObject
obj2 =
(PdfObject -> Resources
_pdfAnnot PdfObject
obj1, PdfObject -> ByteString
_pdfStream PdfObject
obj1) (Resources, ByteString) -> (Resources, ByteString) -> Bool
forall a. Eq a => a -> a -> Bool
== (PdfObject -> Resources
_pdfAnnot PdfObject
obj2, PdfObject -> ByteString
_pdfStream PdfObject
obj2)
instance Ord PdfObject where
compare :: PdfObject -> PdfObject -> Ordering
compare PdfObject
obj1 PdfObject
obj2 =
(Resources, ByteString) -> (Resources, ByteString) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PdfObject -> Resources
_pdfAnnot PdfObject
obj1, PdfObject -> ByteString
_pdfStream PdfObject
obj1) (PdfObject -> Resources
_pdfAnnot PdfObject
obj2, PdfObject -> ByteString
_pdfStream PdfObject
obj2)
type InnerRenderer =
forall px . PdfColorable px => Drawing px () -> [DrawOrder px]
data PdfConfiguration = PdfConfiguration
{ PdfConfiguration -> Int
_pdfConfDpi :: !Dpi
, PdfConfiguration -> Int
_pdfWidth :: !Int
, PdfConfiguration -> Int
_pdfHeight :: !Int
, PdfConfiguration
-> forall px. PdfColorable px => Drawing px () -> [DrawOrder px]
_pdfConfToOrder :: InnerRenderer
}
domainOfCircle :: Point -> Float -> (Point, Point) -> Domain
domainOfCircle :: Point -> Float -> (Point, Point) -> Domain
domainOfCircle Point
center Float
radius (Point
mini, Point
maxi) = (Float
0, Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
d1 Float
d2 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
radius)
where
d1 :: Float
d1 = Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
distance Point
maxi Point
center
d2 :: Float
d2 = Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
distance Point
mini Point
center
domainOfLinearGradient :: Line -> (Point, Point) -> (Float, Float)
domainOfLinearGradient :: Line -> (Point, Point) -> Domain
domainOfLinearGradient (Line Point
p1 Point
p2) (Point
mini, Point
maxi) =
(Float
t0 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
xxAdd Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
yxAdd, Float
t0 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
xyAdd Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
yyAdd)
where
delta :: Point
delta = Point
p2 Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
p1
invSquareNorm :: Float
invSquareNorm = Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance Point
delta
normDelta :: Point
normDelta = Point
delta Point -> Float -> Point
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Float
invSquareNorm
t0 :: Float
t0 = (Point
mini Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
p1) Point -> Point -> Float
forall (f :: * -> *) a. (Metric f, Num a) => f a -> f a -> a
`dot` Point
normDelta
V2 Float
tdx Float
tdy = (Point
maxi Point -> Point -> Point
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Point
mini) Point -> Point -> Point
forall a. Num a => a -> a -> a
* Point
normDelta
(Float
xxAdd, Float
xyAdd) | Float
tdx Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 = (Float
tdx, Float
0)
| Bool
otherwise = (Float
0, Float
tdx)
(Float
yxAdd, Float
yyAdd) | Float
tdy Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 = (Float
tdy, Float
0)
| Bool
otherwise = (Float
0, Float
tdy)
type PdfEnv = StateT PdfContext (Reader PdfConfiguration)
runPdfEnvs :: PdfConfiguration -> PdfId -> [PdfEnv a] -> ([a], PdfContext)
runPdfEnvs :: PdfConfiguration -> Int -> [PdfEnv a] -> ([a], PdfContext)
runPdfEnvs PdfConfiguration
conf Int
firstFreeId [PdfEnv a]
producers =
Reader PdfConfiguration ([a], PdfContext)
-> PdfConfiguration -> ([a], PdfContext)
forall r a. Reader r a -> r -> a
runReader (StateT PdfContext (Reader PdfConfiguration) [a]
-> PdfContext -> Reader PdfConfiguration ([a], PdfContext)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ([PdfEnv a] -> StateT PdfContext (Reader PdfConfiguration) [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [PdfEnv a]
producers) (PdfContext -> Reader PdfConfiguration ([a], PdfContext))
-> PdfContext -> Reader PdfConfiguration ([a], PdfContext)
forall a b. (a -> b) -> a -> b
$ Int -> PdfContext
emptyContext Int
firstFreeId) PdfConfiguration
conf
type Resources = [(B.ByteString, B.ByteString)]
data PdfResourceAssoc = PdfResourceAssoc
{ PdfResourceAssoc -> Int
_resFreeIndex :: !Int
, PdfResourceAssoc -> Resources
_resAssoc :: !Resources
}
resFreeIndex :: Lens' PdfResourceAssoc Int
resFreeIndex :: (Int -> f Int) -> PdfResourceAssoc -> f PdfResourceAssoc
resFreeIndex Int -> f Int
f PdfResourceAssoc
v = Int -> PdfResourceAssoc
setter (Int -> PdfResourceAssoc) -> f Int -> f PdfResourceAssoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f (PdfResourceAssoc -> Int
_resFreeIndex PdfResourceAssoc
v) where
setter :: Int -> PdfResourceAssoc
setter Int
new = PdfResourceAssoc
v { _resFreeIndex :: Int
_resFreeIndex = Int
new }
resAssoc :: Lens' PdfResourceAssoc Resources
resAssoc :: (Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
resAssoc Resources -> f Resources
f PdfResourceAssoc
v = Resources -> PdfResourceAssoc
setter (Resources -> PdfResourceAssoc)
-> f Resources -> f PdfResourceAssoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Resources -> f Resources
f (PdfResourceAssoc -> Resources
_resAssoc PdfResourceAssoc
v) where
setter :: Resources -> PdfResourceAssoc
setter Resources
new = PdfResourceAssoc
v { _resAssoc :: Resources
_resAssoc = Resources
new }
data PdfContext = PdfContext
{ PdfContext -> Int
_pdfFreeIndex :: !Int
, PdfContext -> [PdfObject]
_generatedPdfObjects :: ![PdfObject]
, PdfContext -> PdfResourceAssoc
_pdfPatterns :: !PdfResourceAssoc
, PdfContext -> PdfResourceAssoc
_pdfShadings :: !PdfResourceAssoc
, PdfContext -> PdfResourceAssoc
_pdfGraphicStates :: !PdfResourceAssoc
, PdfContext -> PdfResourceAssoc
_pdfXObjects :: !PdfResourceAssoc
}
pdfXObjects :: Lens' PdfContext PdfResourceAssoc
pdfXObjects :: (PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
pdfXObjects PdfResourceAssoc -> f PdfResourceAssoc
f PdfContext
v = PdfResourceAssoc -> PdfContext
setter (PdfResourceAssoc -> PdfContext)
-> f PdfResourceAssoc -> f PdfContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PdfResourceAssoc -> f PdfResourceAssoc
f (PdfContext -> PdfResourceAssoc
_pdfXObjects PdfContext
v) where
setter :: PdfResourceAssoc -> PdfContext
setter PdfResourceAssoc
new = PdfContext
v { _pdfXObjects :: PdfResourceAssoc
_pdfXObjects = PdfResourceAssoc
new }
pdfPatterns :: Lens' PdfContext PdfResourceAssoc
pdfPatterns :: (PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
pdfPatterns PdfResourceAssoc -> f PdfResourceAssoc
f PdfContext
v = PdfResourceAssoc -> PdfContext
setter (PdfResourceAssoc -> PdfContext)
-> f PdfResourceAssoc -> f PdfContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PdfResourceAssoc -> f PdfResourceAssoc
f (PdfContext -> PdfResourceAssoc
_pdfPatterns PdfContext
v) where
setter :: PdfResourceAssoc -> PdfContext
setter PdfResourceAssoc
new = PdfContext
v { _pdfPatterns :: PdfResourceAssoc
_pdfPatterns = PdfResourceAssoc
new }
pdfShadings :: Lens' PdfContext PdfResourceAssoc
pdfShadings :: (PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
pdfShadings PdfResourceAssoc -> f PdfResourceAssoc
f PdfContext
v = PdfResourceAssoc -> PdfContext
setter (PdfResourceAssoc -> PdfContext)
-> f PdfResourceAssoc -> f PdfContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PdfResourceAssoc -> f PdfResourceAssoc
f (PdfContext -> PdfResourceAssoc
_pdfShadings PdfContext
v) where
setter :: PdfResourceAssoc -> PdfContext
setter PdfResourceAssoc
new = PdfContext
v { _pdfShadings :: PdfResourceAssoc
_pdfShadings = PdfResourceAssoc
new }
pdfGraphicStates :: Lens' PdfContext PdfResourceAssoc
pdfGraphicStates :: (PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
pdfGraphicStates PdfResourceAssoc -> f PdfResourceAssoc
f PdfContext
v = PdfResourceAssoc -> PdfContext
setter (PdfResourceAssoc -> PdfContext)
-> f PdfResourceAssoc -> f PdfContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PdfResourceAssoc -> f PdfResourceAssoc
f (PdfContext -> PdfResourceAssoc
_pdfGraphicStates PdfContext
v) where
setter :: PdfResourceAssoc -> PdfContext
setter PdfResourceAssoc
new = PdfContext
v { _pdfGraphicStates :: PdfResourceAssoc
_pdfGraphicStates = PdfResourceAssoc
new }
isPixelTransparent :: (Modulable (PixelBaseComponent px), Pixel px) => px -> Bool
isPixelTransparent :: px -> Bool
isPixelTransparent px
p = px -> PixelBaseComponent px
forall a. Pixel a => a -> PixelBaseComponent a
pixelOpacity px
p PixelBaseComponent px -> PixelBaseComponent px -> Bool
forall a. Ord a => a -> a -> Bool
< PixelBaseComponent px
forall a. Modulable a => a
fullValue
isGradientTransparent :: (Modulable (PixelBaseComponent px), Pixel px) => Gradient px -> Bool
isGradientTransparent :: Gradient px -> Bool
isGradientTransparent = ((Float, px) -> Bool) -> Gradient px -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any (px -> Bool
forall px.
(Modulable (PixelBaseComponent px), Pixel px) =>
px -> Bool
isPixelTransparent (px -> Bool) -> ((Float, px) -> px) -> (Float, px) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, px) -> px
forall a b. (a, b) -> b
snd)
toAlphaGradient :: Pixel px => Gradient px -> Gradient (PixelBaseComponent px)
toAlphaGradient :: Gradient px -> Gradient (PixelBaseComponent px)
toAlphaGradient = ((Float, px) -> (Float, PixelBaseComponent px))
-> Gradient px -> Gradient (PixelBaseComponent px)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Float, px) -> (Float, PixelBaseComponent px)
forall a a. Pixel a => (a, a) -> (a, PixelBaseComponent a)
extractOpacity where
extractOpacity :: (a, a) -> (a, PixelBaseComponent a)
extractOpacity (a
o, a
p) = (a
o, a -> PixelBaseComponent a
forall a. Pixel a => a -> PixelBaseComponent a
pixelOpacity a
p)
toOpaqueGradient :: RenderablePixel px => Gradient px -> Gradient px
toOpaqueGradient :: Gradient px -> Gradient px
toOpaqueGradient = ((Float, px) -> (Float, px)) -> Gradient px -> Gradient px
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Float
o, px
p) -> (Float
o, (Int
-> PixelBaseComponent px
-> PixelBaseComponent px
-> PixelBaseComponent px)
-> (PixelBaseComponent px
-> PixelBaseComponent px -> PixelBaseComponent px)
-> px
-> px
-> px
forall a.
Pixel a =>
(Int
-> PixelBaseComponent a
-> PixelBaseComponent a
-> PixelBaseComponent a)
-> (PixelBaseComponent a
-> PixelBaseComponent a -> PixelBaseComponent a)
-> a
-> a
-> a
mixWithAlpha Int
-> PixelBaseComponent px
-> PixelBaseComponent px
-> PixelBaseComponent px
forall p p p. p -> p -> p -> p
pxId PixelBaseComponent px
-> PixelBaseComponent px -> PixelBaseComponent px
forall a p p. Modulable a => p -> p -> a
pxOpaq px
p px
p)) where
pxId :: p -> p -> p -> p
pxId p
_ p
_ p
v = p
v
pxOpaq :: p -> p -> a
pxOpaq p
_ p
_ = a
forall a. Modulable a => a
fullValue
withLocalSubcontext :: PdfEnv a -> PdfEnv (a, PdfId)
withLocalSubcontext :: PdfEnv a -> PdfEnv (a, Int)
withLocalSubcontext PdfEnv a
sub = do
Resources
oldShadings <- Lens' PdfContext Resources -> Resources -> PdfEnv Resources
forall a. Lens' PdfContext a -> a -> PdfEnv a
reset ((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfShadings((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc) []
Resources
oldPatterns <- Lens' PdfContext Resources -> Resources -> PdfEnv Resources
forall a. Lens' PdfContext a -> a -> PdfEnv a
reset ((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfPatterns((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc) []
Resources
oldStates <- Lens' PdfContext Resources -> Resources -> PdfEnv Resources
forall a. Lens' PdfContext a -> a -> PdfEnv a
reset ((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfGraphicStates((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc) []
Resources
oldXObjects <- Lens' PdfContext Resources -> Resources -> PdfEnv Resources
forall a. Lens' PdfContext a -> a -> PdfEnv a
reset ((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfXObjects((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc) []
a
result <- PdfEnv a
sub
Resources
newShadings <- Lens' PdfContext Resources -> Resources -> PdfEnv Resources
forall a. Lens' PdfContext a -> a -> PdfEnv a
reset ((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfShadings((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc) Resources
oldShadings
Resources
newStates <- Lens' PdfContext Resources -> Resources -> PdfEnv Resources
forall a. Lens' PdfContext a -> a -> PdfEnv a
reset ((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfGraphicStates((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc) Resources
oldStates
Resources
newPatterns <- Lens' PdfContext Resources -> Resources -> PdfEnv Resources
forall a. Lens' PdfContext a -> a -> PdfEnv a
reset ((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfPatterns((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc) Resources
oldPatterns
Resources
newXObjects <- Lens' PdfContext Resources -> Resources -> PdfEnv Resources
forall a. Lens' PdfContext a -> a -> PdfEnv a
reset ((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfXObjects((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc) Resources
oldXObjects
(a
result,) (Int -> (a, Int))
-> StateT PdfContext (Reader PdfConfiguration) Int
-> PdfEnv (a, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject (Resources
-> Resources -> Resources -> Resources -> Int -> PdfObject
resourceObject Resources
newShadings Resources
newStates Resources
newPatterns Resources
newXObjects)
where
reset :: Lens' PdfContext a -> a -> PdfEnv a
reset :: Lens' PdfContext a -> a -> PdfEnv a
reset Lens' PdfContext a
l a
old = do
a
v <- Lens' PdfContext a -> PdfEnv a
forall s (m :: * -> *) t a b. MonadState s m => Lens s t a b -> m a
use Lens' PdfContext a
l
Lens' PdfContext a
l Lens' PdfContext a
-> a -> StateT PdfContext (Reader PdfConfiguration) ()
forall s (m :: * -> *) a. MonadState s m => Lens' s a -> a -> m ()
.= a
old
a -> PdfEnv a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
nameObject :: B.ByteString -> Lens' PdfContext PdfResourceAssoc -> B.ByteString -> PdfEnv Builder
nameObject :: ByteString
-> Lens' PdfContext PdfResourceAssoc
-> ByteString
-> PdfEnv Builder
nameObject ByteString
prefix Lens' PdfContext PdfResourceAssoc
lens ByteString
info = do
Int
idx <- Lens PdfContext PdfContext Int Int
-> StateT PdfContext (Reader PdfConfiguration) Int
forall s (m :: * -> *) t a b. MonadState s m => Lens s t a b -> m a
use ((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
lens((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Int -> f Int) -> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Int -> f Int)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> f Int) -> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Int
resFreeIndex)
(PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
lens((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Int -> f Int) -> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Int -> f Int)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> f Int) -> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Int
resFreeIndex Lens PdfContext PdfContext Int Int
-> Int -> StateT PdfContext (Reader PdfConfiguration) ()
forall a s (m :: * -> *).
(Num a, MonadState s m) =>
Lens' s a -> a -> m ()
+= Int
1
let key :: ByteString
key = Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
tp ByteString
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
idx
(PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
lens((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc Lens' PdfContext Resources
-> (Resources -> Resources)
-> StateT PdfContext (Reader PdfConfiguration) ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens' s a -> (a -> a) -> m ()
%= ((ByteString
key, ByteString
info) (ByteString, ByteString) -> Resources -> Resources
forall a. a -> [a] -> [a]
:)
Builder -> PdfEnv Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> PdfEnv Builder)
-> (ByteString -> Builder) -> ByteString -> PdfEnv Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
tp (ByteString -> PdfEnv Builder) -> ByteString -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ ByteString
"/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
key
nameStateObject :: PdfId -> PdfEnv Builder
nameStateObject :: Int -> PdfEnv Builder
nameStateObject = ByteString
-> Lens' PdfContext PdfResourceAssoc
-> ByteString
-> PdfEnv Builder
nameObject ByteString
"gs" Lens' PdfContext PdfResourceAssoc
pdfGraphicStates (ByteString -> PdfEnv Builder)
-> (Int -> ByteString) -> Int -> PdfEnv Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString
refOf
nameOpacityObject :: Float -> PdfEnv Builder
nameOpacityObject :: Float -> PdfEnv Builder
nameOpacityObject Float
opa = ByteString
-> Lens' PdfContext PdfResourceAssoc
-> ByteString
-> PdfEnv Builder
nameObject ByteString
"gs" Lens' PdfContext PdfResourceAssoc
pdfGraphicStates ByteString
opac where
opb :: Builder
opb = Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
opa
opac :: ByteString
opac = Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
"<< /ca " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
opb Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" /CA " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
opb Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">> "
nameXObject :: PdfId -> PdfEnv Builder
nameXObject :: Int -> PdfEnv Builder
nameXObject = ByteString
-> Lens' PdfContext PdfResourceAssoc
-> ByteString
-> PdfEnv Builder
nameObject ByteString
"x" Lens' PdfContext PdfResourceAssoc
pdfXObjects (ByteString -> PdfEnv Builder)
-> (Int -> ByteString) -> Int -> PdfEnv Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString
refOf
namePatternObject :: B.ByteString -> PdfEnv Builder
namePatternObject :: ByteString -> PdfEnv Builder
namePatternObject = ByteString
-> Lens' PdfContext PdfResourceAssoc
-> ByteString
-> PdfEnv Builder
nameObject ByteString
"P" Lens' PdfContext PdfResourceAssoc
pdfPatterns
generateObject :: (PdfId -> PdfObject) -> PdfEnv PdfId
generateObject :: (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject Int -> PdfObject
f = do
PdfContext
ctxt <- StateT PdfContext (Reader PdfConfiguration) PdfContext
forall s (m :: * -> *). MonadState s m => m s
get
let idx :: Int
idx = PdfContext -> Int
_pdfFreeIndex PdfContext
ctxt
PdfContext -> StateT PdfContext (Reader PdfConfiguration) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (PdfContext -> StateT PdfContext (Reader PdfConfiguration) ())
-> PdfContext -> StateT PdfContext (Reader PdfConfiguration) ()
forall a b. (a -> b) -> a -> b
$ PdfContext
ctxt
{ _pdfFreeIndex :: Int
_pdfFreeIndex = Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
, _generatedPdfObjects :: [PdfObject]
_generatedPdfObjects = Int -> PdfObject
f Int
idx PdfObject -> [PdfObject] -> [PdfObject]
forall a. a -> [a] -> [a]
: PdfContext -> [PdfObject]
_generatedPdfObjects PdfContext
ctxt
}
Int -> StateT PdfContext (Reader PdfConfiguration) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
idx
emptyContext :: PdfId -> PdfContext
emptyContext :: Int -> PdfContext
emptyContext Int
idx = PdfContext :: Int
-> [PdfObject]
-> PdfResourceAssoc
-> PdfResourceAssoc
-> PdfResourceAssoc
-> PdfResourceAssoc
-> PdfContext
PdfContext
{ _pdfFreeIndex :: Int
_pdfFreeIndex = Int
idx
, _generatedPdfObjects :: [PdfObject]
_generatedPdfObjects = [PdfObject]
forall a. Monoid a => a
mempty
, _pdfPatterns :: PdfResourceAssoc
_pdfPatterns = PdfResourceAssoc
emptyAssoc
, _pdfShadings :: PdfResourceAssoc
_pdfShadings = PdfResourceAssoc
emptyAssoc
, _pdfGraphicStates :: PdfResourceAssoc
_pdfGraphicStates = PdfResourceAssoc
emptyAssoc
, _pdfXObjects :: PdfResourceAssoc
_pdfXObjects = PdfResourceAssoc
emptyAssoc
}
where
emptyAssoc :: PdfResourceAssoc
emptyAssoc = PdfResourceAssoc :: Int -> Resources -> PdfResourceAssoc
PdfResourceAssoc
{ _resFreeIndex :: Int
_resFreeIndex = Int
1
, _resAssoc :: Resources
_resAssoc = Resources
forall a. Monoid a => a
mempty
}
class ToPdf a where
toPdf :: a -> Builder
instance ToPdf Float where
toPdf :: Float -> Builder
toPdf Float
v = ByteString -> Builder
forall a. ToPdf a => a -> Builder
toPdf (ByteString -> Builder)
-> (String -> ByteString) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Float -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Float
v String
""
instance ToPdf B.ByteString where
toPdf :: ByteString -> Builder
toPdf = ByteString -> Builder
byteString
newtype Matrix = Matrix Transformation
instance ToPdf Transformation where
toPdf :: Transformation -> Builder
toPdf (Transformation Float
a Float
c Float
e Float
b Float
d Float
f) =
(Float -> Builder) -> [Float] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Float -> Builder
forall a. ToPdf a => a -> Builder
t [Float
a, Float
b, Float
c, Float
d, Float
e, Float
f] Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" cm\n"
where
t :: a -> Builder
t a
v = a -> Builder
forall a. ToPdf a => a -> Builder
toPdf a
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" "
instance ToPdf Matrix where
toPdf :: Matrix -> Builder
toPdf (Matrix (Transformation Float
a Float
c Float
e Float
b Float
d Float
f)) =
Builder -> Builder
arrayOf (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ (Float -> Builder) -> [Float] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Float -> Builder
forall a. ToPdf a => a -> Builder
t [Float
a, Float
b, Float
c, Float
d, Float
e, Float
f]
where
t :: a -> Builder
t a
v = a -> Builder
forall a. ToPdf a => a -> Builder
toPdf a
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" "
instance ToPdf Resources where
toPdf :: Resources -> Builder
toPdf [] = Builder
forall a. Monoid a => a
mempty
toPdf Resources
dic = ByteString -> Builder
tp ByteString
"<< " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((ByteString, ByteString) -> Builder) -> Resources -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString, ByteString) -> Builder
forall a. ToPdf a => (a, ByteString) -> Builder
dicToPdf Resources
dic Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
">> "
where
dicToPdf :: (a, ByteString) -> Builder
dicToPdf (a
_, ByteString
el) | ByteString -> Bool
B.null ByteString
el = Builder
forall a. Monoid a => a
mempty
dicToPdf (a
k, ByteString
el) =
ByteString -> Builder
tp ByteString
"/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. ToPdf a => a -> Builder
toPdf a
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
forall a. ToPdf a => a -> Builder
toPdf ByteString
el Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
"\n"
instance ToPdf PdfObject where
toPdf :: PdfObject -> Builder
toPdf PdfObject
obj = Int -> Builder
intDec (PdfObject -> Int
_pdfId PdfObject
obj)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" "
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec (PdfObject -> Int
_pdfRevision PdfObject
obj)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" obj\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Resources -> Builder
forall a. ToPdf a => a -> Builder
toPdf Resources
dic Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
"\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
stream
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
"endobj\n"
where
bSize :: ByteString
bSize = Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
intDec (Int -> Builder) -> (ByteString -> Int) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ PdfObject -> ByteString
_pdfStream PdfObject
obj
hasntStream :: Bool
hasntStream = ByteString -> Bool
B.null (ByteString -> Bool) -> ByteString -> Bool
forall a b. (a -> b) -> a -> b
$ PdfObject -> ByteString
_pdfStream PdfObject
obj
dic :: Resources
dic
| Bool
hasntStream = PdfObject -> Resources
_pdfAnnot PdfObject
obj
| Bool
otherwise = PdfObject -> Resources
_pdfAnnot PdfObject
obj Resources -> Resources -> Resources
forall a. Semigroup a => a -> a -> a
<> [(ByteString
"Length", ByteString
bSize)]
stream :: Builder
stream
| Bool
hasntStream = Builder
forall a. Monoid a => a
mempty
| Bool
otherwise = ByteString -> Builder
tp ByteString
"stream\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
forall a. ToPdf a => a -> Builder
toPdf (PdfObject -> ByteString
_pdfStream PdfObject
obj)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
"\nendstream\n"
instance ToPdf Point where
toPdf :: Point -> Builder
toPdf (V2 Float
x Float
y) = Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
y
instance ToPdf Bezier where
toPdf :: Bezier -> Builder
toPdf = CubicBezier -> Builder
forall a. ToPdf a => a -> Builder
toPdf (CubicBezier -> Builder)
-> (Bezier -> CubicBezier) -> Bezier -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bezier -> CubicBezier
cubicFromQuadraticBezier
instance ToPdf CubicBezier where
toPdf :: CubicBezier -> Builder
toPdf (CubicBezier Point
_p0 Point
p1 Point
p2 Point
p3) =
Point -> Builder
forall a. ToPdf a => a -> Builder
toPdf Point
p1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Point -> Builder
forall a. ToPdf a => a -> Builder
toPdf Point
p2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Point -> Builder
forall a. ToPdf a => a -> Builder
toPdf Point
p3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" c\n"
instance ToPdf Line where
toPdf :: Line -> Builder
toPdf (Line Point
_p0 Point
p1) = Point -> Builder
forall a. ToPdf a => a -> Builder
toPdf Point
p1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" l\n"
instance ToPdf Primitive where
toPdf :: Primitive -> Builder
toPdf Primitive
p = case Primitive
p of
LinePrim Line
l -> Line -> Builder
forall a. ToPdf a => a -> Builder
toPdf Line
l
BezierPrim Bezier
b -> Bezier -> Builder
forall a. ToPdf a => a -> Builder
toPdf Bezier
b
CubicBezierPrim CubicBezier
c -> CubicBezier -> Builder
forall a. ToPdf a => a -> Builder
toPdf CubicBezier
c
instance PdfColorable px => ToPdf (V2 Double, V2 Float, V2 Float, TensorPatch (ParametricValues px)) where
toPdf :: (V2 Double, Point, Point, TensorPatch (ParametricValues px))
-> Builder
toPdf (V2 Double
sx Double
sy, V2 Float
dx Float
dy, V2 Float
_tx Float
ty, TensorPatch (ParametricValues px)
patch) = Word8 -> Builder
word8 Word8
0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
coords Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (px -> Builder) -> [px] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap px -> Builder
forall px. PdfColorable px => px -> Builder
colorToBinaryPdf [px
c00, px
c03, px
c33, px
c30] where
fx :: Float -> Word32
fx Float
x = Double -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Word32) -> (Double -> Double) -> Double -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
maxi (Double -> Word32) -> Double -> Word32
forall a b. (a -> b) -> a -> b
$ Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dx) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sx
fy :: Float -> Word32
fy Float
y = Double -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Word32) -> (Double -> Double) -> Double -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
maxi (Double -> Word32) -> Double -> Word32
forall a b. (a -> b) -> a -> b
$ Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Float
ty Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dy)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sy
maxi :: Double
maxi = Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32)
coords :: Builder
coords = (Word32 -> Builder) -> [Word32] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word32 -> Builder
word32BE
[ Float -> Word32
fx Float
x00, Float -> Word32
fy Float
y00, Float -> Word32
fx Float
x01, Float -> Word32
fy Float
y01, Float -> Word32
fx Float
x02, Float -> Word32
fy Float
y02, Float -> Word32
fx Float
x03, Float -> Word32
fy Float
y03
, Float -> Word32
fx Float
x13, Float -> Word32
fy Float
y13, Float -> Word32
fx Float
x23, Float -> Word32
fy Float
y23, Float -> Word32
fx Float
x33, Float -> Word32
fy Float
y33, Float -> Word32
fx Float
x32, Float -> Word32
fy Float
y32
, Float -> Word32
fx Float
x31, Float -> Word32
fy Float
y31, Float -> Word32
fx Float
x30, Float -> Word32
fy Float
y30, Float -> Word32
fx Float
x20, Float -> Word32
fy Float
y20, Float -> Word32
fx Float
x10, Float -> Word32
fy Float
y10
, Float -> Word32
fx Float
x11, Float -> Word32
fy Float
y11, Float -> Word32
fx Float
x12, Float -> Word32
fy Float
y12, Float -> Word32
fx Float
x22, Float -> Word32
fy Float
y22, Float -> Word32
fx Float
x21, Float -> Word32
fy Float
y21 ]
CubicBezier (V2 Float
x00 Float
y00) (V2 Float
x10 Float
y10) (V2 Float
x20 Float
y20) (V2 Float
x30 Float
y30) = TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve0 TensorPatch (ParametricValues px)
patch
CubicBezier (V2 Float
x01 Float
y01) (V2 Float
x11 Float
y11) (V2 Float
x21 Float
y21) (V2 Float
x31 Float
y31) = TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve1 TensorPatch (ParametricValues px)
patch
CubicBezier (V2 Float
x02 Float
y02) (V2 Float
x12 Float
y12) (V2 Float
x22 Float
y22) (V2 Float
x32 Float
y32) = TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve2 TensorPatch (ParametricValues px)
patch
CubicBezier (V2 Float
x03 Float
y03) (V2 Float
x13 Float
y13) (V2 Float
x23 Float
y23) (V2 Float
x33 Float
y33) = TensorPatch (ParametricValues px) -> CubicBezier
forall weight. TensorPatch weight -> CubicBezier
_curve3 TensorPatch (ParametricValues px)
patch
param :: ParametricValues px
param = TensorPatch (ParametricValues px) -> ParametricValues px
forall weight. TensorPatch weight -> weight
_tensorValues TensorPatch (ParametricValues px)
patch
c00 :: px
c00 = ParametricValues px -> px
forall a. ParametricValues a -> a
_northValue ParametricValues px
param
c30 :: px
c30 = ParametricValues px -> px
forall a. ParametricValues a -> a
_eastValue ParametricValues px
param
c33 :: px
c33 = ParametricValues px -> px
forall a. ParametricValues a -> a
_southValue ParametricValues px
param
c03 :: px
c03 = ParametricValues px -> px
forall a. ParametricValues a -> a
_westValue ParametricValues px
param
buildToStrict :: Builder -> B.ByteString
buildToStrict :: Builder -> ByteString
buildToStrict = ByteString -> ByteString
LB.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
tp :: B.ByteString -> Builder
tp :: ByteString -> Builder
tp = ByteString -> Builder
forall a. ToPdf a => a -> Builder
toPdf
pdfSignature :: B.ByteString
pdfSignature :: ByteString
pdfSignature = ByteString
"%PDF-1.4\n%\xBF\xF7\xA2\xFE\n"
refOf :: PdfId -> B.ByteString
refOf :: Int -> ByteString
refOf Int
i = Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Builder
intDec Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" 0 R "
arrayOf :: Builder -> Builder
arrayOf :: Builder -> Builder
arrayOf Builder
a = ByteString -> Builder
tp ByteString
"[ " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" ]"
localGraphicState :: Builder -> Builder
localGraphicState :: Builder -> Builder
localGraphicState Builder
sub = ByteString -> Builder
tp ByteString
"q\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sub Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
"Q\n"
dicObj :: [(B.ByteString, B.ByteString)] -> PdfId -> PdfObject
dicObj :: Resources -> Int -> PdfObject
dicObj Resources
annots Int
pid = PdfObject :: Int -> Int -> Resources -> ByteString -> PdfObject
PdfObject
{ _pdfId :: Int
_pdfId = Int
pid
, _pdfRevision :: Int
_pdfRevision = Int
0
, _pdfAnnot :: Resources
_pdfAnnot = Resources
annots
, _pdfStream :: ByteString
_pdfStream = ByteString
forall a. Monoid a => a
mempty
}
outlinesObject :: Foldable f => f PdfCommand -> PdfId -> PdfObject
outlinesObject :: f ByteString -> Int -> PdfObject
outlinesObject f ByteString
outlines = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"Type", ByteString
"/Outlines")
, (ByteString
"Count", Builder -> ByteString
buildToStrict (Builder -> ByteString) -> (Int -> Builder) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
intDec (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ f ByteString -> Int
forall (f :: * -> *) a. Foldable f => f a -> Int
glength f ByteString
outlines)
]
pagesObject :: Foldable f => f PdfId -> PdfId -> PdfObject
pagesObject :: f Int -> Int -> PdfObject
pagesObject f Int
pages = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"Type", ByteString
"/Pages")
, (ByteString
"Kids", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Builder -> Builder) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
arrayOf (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> Builder) -> f Int -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString -> Builder
forall a. ToPdf a => a -> Builder
toPdf (ByteString -> Builder) -> (Int -> ByteString) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString
refOf) f Int
pages)
, (ByteString
"Count", Builder -> ByteString
buildToStrict (Builder -> ByteString) -> (Int -> Builder) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
intDec (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ f Int -> Int
forall (f :: * -> *) a. Foldable f => f a -> Int
glength f Int
pages)
]
catalogObject :: PdfId -> PdfId -> PdfId -> PdfObject
catalogObject :: Int -> Int -> Int -> PdfObject
catalogObject Int
pagesId Int
outlineId = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"Type", ByteString
"/Catalog")
, (ByteString
"Outlines", Int -> ByteString
refOf Int
outlineId)
, (ByteString
"Pages", Int -> ByteString
refOf Int
pagesId)
]
pageObject :: PdfColorable px
=> Proxy px -> Int -> Int -> PdfId -> PdfId -> PdfId -> PdfId -> PdfObject
pageObject :: Proxy px -> Int -> Int -> Int -> Int -> Int -> Int -> PdfObject
pageObject Proxy px
px Int
width Int
height Int
parentId Int
contentId Int
resourceId = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"Type", ByteString
"/Page")
, (ByteString
"Parent", Int -> ByteString
refOf Int
parentId)
, (ByteString
"MediaBox", Builder -> ByteString
buildToStrict Builder
box)
, (ByteString
"Contents", Int -> ByteString
refOf Int
contentId)
, (ByteString
"Resources", Int -> ByteString
refOf Int
resourceId)
, (ByteString
"Group", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Resources -> Builder) -> Resources -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Resources -> Builder
forall a. ToPdf a => a -> Builder
toPdf (Resources -> ByteString) -> Resources -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy px -> Resources
forall px. PdfColorable px => Proxy px -> Resources
groupDic Proxy px
px)
]
where
box :: Builder
box = ByteString -> Builder
tp ByteString
"[0 0 " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
width Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
height Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
"]"
gradientPatternObject :: Transformation -> PdfId -> PdfId -> PdfObject
gradientPatternObject :: Transformation -> Int -> Int -> PdfObject
gradientPatternObject Transformation
trans Int
gradientId = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"Type", ByteString
"/Pattern")
, (ByteString
"PatternType", ByteString
"2")
, (ByteString
"Matrix", ByteString
it)
, (ByteString
"Shading", Int -> ByteString
refOf Int
gradientId)
]
where
it :: ByteString
it = Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Matrix -> Builder) -> Matrix -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix -> Builder
forall a. ToPdf a => a -> Builder
toPdf (Matrix -> ByteString) -> Matrix -> ByteString
forall a b. (a -> b) -> a -> b
$ Transformation -> Matrix
Matrix Transformation
trans
linearGradientObject :: Line -> Domain -> B.ByteString -> PdfId -> PdfId -> PdfObject
linearGradientObject :: Line -> Domain -> ByteString -> Int -> Int -> PdfObject
linearGradientObject (Line Point
p1 Point
p2) (Float
beg, Float
end) ByteString
colorSpace Int
funId = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"ShadingType", ByteString
"2")
, (ByteString
"ColorSpace", ByteString
colorSpace)
, (ByteString
"Coords", Builder -> ByteString
buildToStrict Builder
coords)
, (ByteString
"Function", Int -> ByteString
refOf Int
funId)
, (ByteString
"Domain", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Builder -> Builder) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
arrayOf (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
beg Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
end)
, (ByteString
"Extend", ByteString
"[true true]")
]
where
coords :: Builder
coords = Builder -> Builder
arrayOf (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Point -> Builder
forall a. ToPdf a => a -> Builder
toPdf Point
p1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Point -> Builder
forall a. ToPdf a => a -> Builder
toPdf Point
p2
radialGradientObject :: Domain -> Point -> Point -> Float -> B.ByteString -> PdfId
-> PdfId -> PdfObject
radialGradientObject :: Domain
-> Point -> Point -> Float -> ByteString -> Int -> Int -> PdfObject
radialGradientObject (Float
beg, Float
end) Point
center Point
focus Float
radius ByteString
colorSpace Int
funId = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"ShadingType", ByteString
"3")
, (ByteString
"ColorSpace", ByteString
colorSpace)
, (ByteString
"Coords", Builder -> ByteString
buildToStrict Builder
coords)
, (ByteString
"Function", Int -> ByteString
refOf Int
funId)
, (ByteString
"Domain", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Builder -> Builder) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
arrayOf (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
beg Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
end)
, (ByteString
"Extend", ByteString
"[true true]")
]
where
coords :: Builder
coords = Builder -> Builder
arrayOf (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Point -> Builder
forall a. ToPdf a => a -> Builder
toPdf Point
center Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
radius
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Point -> Builder
forall a. ToPdf a => a -> Builder
toPdf Point
focus Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" 0"
meshGradientObject :: PdfColorable px => MeshPatch px -> Int -> PdfId -> PdfObject
meshGradientObject :: MeshPatch px -> Int -> Int -> PdfObject
meshGradientObject MeshPatch px
mesh Int
height Int
pid = PdfObject :: Int -> Int -> Resources -> ByteString -> PdfObject
PdfObject
{ _pdfId :: Int
_pdfId = Int
pid
, _pdfRevision :: Int
_pdfRevision = Int
0
, _pdfAnnot :: Resources
_pdfAnnot =
[ (ByteString
"ShadingType", ByteString
"7")
, (ByteString
"ColorSpace", ByteString
"/DeviceRGB")
, (ByteString
"BitsPerComponent", ByteString
"8")
, (ByteString
"BitsPerCoordinate", ByteString
"32")
, (ByteString
"BitsPerFlag", ByteString
"8")
, (ByteString
"Decode", String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Float -> Float -> Float -> Float -> String
forall r. PrintfType r => String -> r
printf String
"[%g %g %g %g 0 1 0 1 0 1]"
Float
x0 Float
x1 (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1)
(Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y0))
]
, _pdfStream :: ByteString
_pdfStream = Builder -> ByteString
buildToStrict
(Builder -> ByteString)
-> ([TensorPatch (ParametricValues px)] -> Builder)
-> [TensorPatch (ParametricValues px)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TensorPatch (ParametricValues px) -> Builder)
-> [TensorPatch (ParametricValues px)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\TensorPatch (ParametricValues px)
patch -> (V2 Double, Point, Point, TensorPatch (ParametricValues px))
-> Builder
forall a. ToPdf a => a -> Builder
toPdf (V2 Double
scal, Point
transl, Point
fullSize, TensorPatch (ParametricValues px)
patch))
([TensorPatch (ParametricValues px)] -> ByteString)
-> [TensorPatch (ParametricValues px)] -> ByteString
forall a b. (a -> b) -> a -> b
$ MeshPatch px -> [TensorPatch (ParametricValues px)]
forall px. MeshPatch px -> [TensorPatch (ParametricValues px)]
tensorPatchesOf MeshPatch px
mesh
}
where
maxi :: Double
maxi = Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32)
scaleOf :: Float -> Float -> Double
scaleOf :: Float -> Float -> Double
scaleOf Float
a Float
b | Float -> Bool
forall a. Epsilon a => a -> Bool
nearZero (Float -> Bool) -> Float -> Bool
forall a b. (a -> b) -> a -> b
$ Float
a Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
b = Double
0
| Bool
otherwise = Double
maxi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
a)
fullSize :: Point
fullSize = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x0) (Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y0)
transl :: Point
transl = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (-Float
x0) (-Float
y0)
scal :: V2 Double
scal = Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Float -> Float -> Double
scaleOf Float
x0 Float
x1) (Float -> Float -> Double
scaleOf Float
y0 Float
y1)
PlaneBound (V2 Float
x0 Float
y0) (V2 Float
x1 Float
y1) =
(PlaneBound -> Point -> PlaneBound)
-> PlaneBound -> MeshPatch px -> PlaneBound
forall a px. (a -> Point -> a) -> a -> MeshPatch px -> a
foldMeshPoints (\PlaneBound
v -> PlaneBound -> PlaneBound -> PlaneBound
forall a. Monoid a => a -> a -> a
mappend PlaneBound
v (PlaneBound -> PlaneBound)
-> (Point -> PlaneBound) -> Point -> PlaneBound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> PlaneBound
forall a. PlaneBoundable a => a -> PlaneBound
planeBounds) PlaneBound
forall a. Monoid a => a
mempty MeshPatch px
mesh
createMeshGradient :: forall px. PdfBaseColorable px
=> Builder -> MeshPatch px -> PdfEnv (Either String Builder)
createMeshGradient :: Builder -> MeshPatch px -> PdfEnv (Either String Builder)
createMeshGradient Builder
inner MeshPatch px
mesh = do
Int
height <- (PdfConfiguration -> Int)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PdfConfiguration -> Int
_pdfHeight
Int
meshId <- (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall a b. (a -> b) -> a -> b
$ MeshPatch px -> Int -> Int -> PdfObject
forall px.
PdfColorable px =>
MeshPatch px -> Int -> Int -> PdfObject
meshGradientObject MeshPatch px
mesh Int
height
Int
patId <- (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject (Transformation -> Int -> Int -> PdfObject
gradientPatternObject Transformation
forall a. Monoid a => a
mempty Int
meshId)
Builder
pat <- ByteString -> PdfEnv Builder
namePatternObject (ByteString -> PdfEnv Builder) -> ByteString -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
refOf Int
patId
Either String Builder -> PdfEnv (Either String Builder)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Builder -> PdfEnv (Either String Builder))
-> (Builder -> Either String Builder)
-> Builder
-> PdfEnv (Either String Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Either String Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv (Either String Builder))
-> Builder -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$
Builder
"/Pattern cs\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pat Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" scn\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Builder
"/Pattern CS\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pat Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" SCN\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
inner
contentObject :: B.ByteString -> PdfId -> PdfObject
contentObject :: ByteString -> Int -> PdfObject
contentObject ByteString
content Int
pid = PdfObject :: Int -> Int -> Resources -> ByteString -> PdfObject
PdfObject
{ _pdfId :: Int
_pdfId = Int
pid
, _pdfRevision :: Int
_pdfRevision = Int
0
, _pdfAnnot :: Resources
_pdfAnnot = []
, _pdfStream :: ByteString
_pdfStream = ByteString
content
}
pathToPdf :: [Primitive] -> Builder
pathToPdf :: [Primitive] -> Builder
pathToPdf [Primitive]
ps = case [Primitive]
ps of
[] -> Builder
forall a. Monoid a => a
mempty
Primitive
p:[Primitive]
_ ->
Point -> Builder
forall a. ToPdf a => a -> Builder
toPdf (Primitive -> Point
firstPointOf Primitive
p) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" m\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Primitive -> Builder) -> [Primitive] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Primitive -> Builder
forall a. ToPdf a => a -> Builder
toPdf [Primitive]
ps Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
class RenderablePixel px => PdfColorable px where
pdfColorSpace :: Proxy px -> B.ByteString
colorToPdf :: px -> Builder
colorToBinaryPdf :: px -> Builder
instance PdfColorable Pixel8 where
pdfColorSpace :: Proxy Word8 -> ByteString
pdfColorSpace Proxy Word8
_ = ByteString
"/DeviceGray"
colorToPdf :: Word8 -> Builder
colorToPdf Word8
c = Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf (Word8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255 :: Float)
colorToBinaryPdf :: Word8 -> Builder
colorToBinaryPdf = Word8 -> Builder
word8
instance PdfColorable PixelRGBA8 where
pdfColorSpace :: Proxy PixelRGBA8 -> ByteString
pdfColorSpace Proxy PixelRGBA8
_ = ByteString
"/DeviceRGB"
colorToPdf :: PixelRGBA8 -> Builder
colorToPdf (PixelRGBA8 Word8
r Word8
g Word8
b Word8
_a) =
Word8 -> Builder
forall px. PdfColorable px => px -> Builder
colorToPdf Word8
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall px. PdfColorable px => px -> Builder
colorToPdf Word8
g Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall px. PdfColorable px => px -> Builder
colorToPdf Word8
b
colorToBinaryPdf :: PixelRGBA8 -> Builder
colorToBinaryPdf (PixelRGBA8 Word8
r Word8
g Word8
b Word8
_a) =
Word8 -> Builder
forall px. PdfColorable px => px -> Builder
colorToBinaryPdf Word8
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall px. PdfColorable px => px -> Builder
colorToBinaryPdf Word8
g Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall px. PdfColorable px => px -> Builder
colorToBinaryPdf Word8
b
maskObject :: PdfId -> PdfId -> PdfObject
maskObject :: Int -> Int -> PdfObject
maskObject Int
maskId = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"Type", ByteString
"/Mask")
, (ByteString
"S", ByteString
"/Luminosity")
, (ByteString
"G", Int -> ByteString
refOf Int
maskId)
]
alphaMaskObject :: PdfId -> PdfId -> PdfObject
alphaMaskObject :: Int -> Int -> PdfObject
alphaMaskObject Int
maskId = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"Type", ByteString
"/Mask")
, (ByteString
"S", ByteString
"/Alpha")
, (ByteString
"G", Int -> ByteString
refOf Int
maskId)
]
opaState :: Float -> PdfId -> PdfObject
opaState :: Float -> Int -> PdfObject
opaState Float
opa = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"Type", ByteString
"/ExtGState")
, (ByteString
"ca", ByteString
v)
, (ByteString
"CA", ByteString
v)
]
where v :: ByteString
v = Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
opa
maskState :: PdfId -> PdfId -> PdfObject
maskState :: Int -> Int -> PdfObject
maskState Int
maskObj = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"Type", ByteString
"/ExtGState")
, (ByteString
"SMask", Int -> ByteString
refOf Int
maskObj)
, (ByteString
"ca", ByteString
"1")
, (ByteString
"CA", ByteString
"1")
, (ByteString
"AIS", ByteString
"false")
]
colorInterpolationFunction :: PdfColorable px => px -> px -> PdfId -> PdfObject
colorInterpolationFunction :: px -> px -> Int -> PdfObject
colorInterpolationFunction px
c0 px
c1 = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"FunctionType", ByteString
"2")
, (ByteString
"Domain", ByteString
"[ 0 1 ]")
, (ByteString
"C0", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Builder -> Builder) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
arrayOf (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ px -> Builder
forall px. PdfColorable px => px -> Builder
colorToPdf px
c0)
, (ByteString
"C1", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Builder -> Builder) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
arrayOf (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ px -> Builder
forall px. PdfColorable px => px -> Builder
colorToPdf px
c1)
, (ByteString
"N", ByteString
"1")
]
resourceObject :: Resources -> Resources -> Resources -> Resources
-> PdfId -> PdfObject
resourceObject :: Resources
-> Resources -> Resources -> Resources -> Int -> PdfObject
resourceObject Resources
shadings Resources
extStates Resources
patterns Resources
xobjects= Resources -> Int -> PdfObject
dicObj (Resources -> Int -> PdfObject) -> Resources -> Int -> PdfObject
forall a b. (a -> b) -> a -> b
$
(ByteString
"ProcSet", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Builder -> Builder) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
arrayOf (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
tp ByteString
"/PDF /Text") (ByteString, ByteString) -> Resources -> Resources
forall a. a -> [a] -> [a]
:
ByteString -> Resources -> Resources
forall a a. ToPdf [a] => a -> [a] -> [(a, ByteString)]
genExt ByteString
"ExtGState" ((ByteString
"ao", ByteString
"<< /ca 1 /CA 1 >>") (ByteString, ByteString) -> Resources -> Resources
forall a. a -> [a] -> [a]
: Resources
extStates)
Resources -> Resources -> Resources
forall a. Semigroup a => a -> a -> a
<> ByteString -> Resources -> Resources
forall a a. ToPdf [a] => a -> [a] -> [(a, ByteString)]
genExt ByteString
"Pattern" Resources
patterns
Resources -> Resources -> Resources
forall a. Semigroup a => a -> a -> a
<> ByteString -> Resources -> Resources
forall a a. ToPdf [a] => a -> [a] -> [(a, ByteString)]
genExt ByteString
"Shading" Resources
shadings
Resources -> Resources -> Resources
forall a. Semigroup a => a -> a -> a
<> ByteString -> Resources -> Resources
forall a a. ToPdf [a] => a -> [a] -> [(a, ByteString)]
genExt ByteString
"XObject" Resources
xobjects
where
genExt :: a -> [a] -> [(a, ByteString)]
genExt a
_ [] = []
genExt a
k [a]
lst = [(a
k, Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [a] -> Builder
forall a. ToPdf a => a -> Builder
toPdf [a]
lst)]
stitchingFunction :: [PdfId] -> [(Float, Float)] -> PdfId -> PdfObject
stitchingFunction :: [Int] -> [Domain] -> Int -> PdfObject
stitchingFunction [Int]
interpolations [Domain]
bounds = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"FunctionType", ByteString
"3")
, (ByteString
"Domain", ByteString
"[ 0 1 ]")
, (ByteString
"Functions", Builder -> ByteString
buildToStrict Builder
interpIds)
, (ByteString
"Bounds", Builder -> ByteString
buildToStrict Builder
boundsId)
, (ByteString
"Encode", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> ([Builder] -> Builder) -> [Builder] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
arrayOf (Builder -> Builder)
-> ([Builder] -> Builder) -> [Builder] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold ([Builder] -> ByteString) -> [Builder] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> Builder) -> [Int] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder -> Int -> Builder
forall a b. a -> b -> a
const (Builder -> Int -> Builder) -> Builder -> Int -> Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
tp ByteString
"0 1 ") [Int]
interpolations)
]
where
interpIds :: Builder
interpIds =
Builder -> Builder
arrayOf (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ (Int -> Builder) -> [Int] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Int
i -> ByteString -> Builder
forall a. ToPdf a => a -> Builder
toPdf (Int -> ByteString
refOf Int
i) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" ") [Int]
interpolations
boundsId :: Builder
boundsId = Builder -> Builder
arrayOf (Builder -> Builder)
-> ([Domain] -> Builder) -> [Domain] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Domain -> Builder) -> [Domain] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" ") (Builder -> Builder) -> (Domain -> Builder) -> Domain -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf (Float -> Builder) -> (Domain -> Float) -> Domain -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> Float
forall a b. (a, b) -> b
snd) ([Domain] -> Builder) -> [Domain] -> Builder
forall a b. (a -> b) -> a -> b
$ [Domain] -> [Domain]
forall a. [a] -> [a]
init [Domain]
bounds
repeatingFunction :: Bool -> Float -> Float -> PdfId -> PdfId -> PdfObject
repeatingFunction :: Bool -> Float -> Float -> Int -> Int -> PdfObject
repeatingFunction Bool
reflect Float
begin Float
end Int
fun = Resources -> Int -> PdfObject
dicObj
[ (ByteString
"FunctionType", ByteString
"3")
, (ByteString
"Domain", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Builder -> Builder) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
arrayOf (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Builder
intDec Int
ibegin Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
iend)
, (ByteString
"Functions", Builder -> ByteString
buildToStrict Builder
interpIds)
, (ByteString
"Bounds", Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
arrayOf Builder
boundsIds)
, (ByteString
"Encode", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Builder -> Builder) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
arrayOf (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> Builder) -> [Int] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Int -> Builder
encoding [Int
ibegin .. Int
iend Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
]
where
ibegin :: Int
ibegin = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
begin
iend :: Int
iend = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
end
interpIds :: Builder
interpIds =
Builder -> Builder
arrayOf (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ (Int -> Builder) -> [Int] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Int
_ -> ByteString -> Builder
forall a. ToPdf a => a -> Builder
toPdf (Int -> ByteString
refOf Int
fun) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" ") [Int
ibegin .. Int
iend Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
boundsIds :: Builder
boundsIds =
(Int -> Builder) -> [Int] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" ") (Builder -> Builder) -> (Int -> Builder) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
intDec) [Int
ibegin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
iend Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
encoding :: Int -> Builder
encoding Int
i | Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& Bool
reflect = ByteString -> Builder
tp ByteString
"1 0 "
| Bool
otherwise = ByteString -> Builder
tp ByteString
"0 1 "
tillingPattern :: Transformation -> Int -> Int -> Builder -> PdfId -> PdfId -> PdfObject
tillingPattern :: Transformation -> Int -> Int -> Builder -> Int -> Int -> PdfObject
tillingPattern Transformation
trans Int
w Int
h Builder
content Int
res Int
pid = PdfObject :: Int -> Int -> Resources -> ByteString -> PdfObject
PdfObject
{ _pdfId :: Int
_pdfId = Int
pid
, _pdfRevision :: Int
_pdfRevision = Int
0
, _pdfStream :: ByteString
_pdfStream = Builder -> ByteString
buildToStrict Builder
content
, _pdfAnnot :: Resources
_pdfAnnot =
[ (ByteString
"Type", ByteString
"/Pattern")
, (ByteString
"PatternType", ByteString
"1")
, (ByteString
"PaintType", ByteString
"1")
, (ByteString
"TilingType", ByteString
"1")
, (ByteString
"BBox", Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
"[0 0 " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
w Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
h Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]")
, (ByteString
"XStep", Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Builder
intDec Int
w)
, (ByteString
"YStep", Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Builder
intDec Int
h)
, (ByteString
"Resources", Int -> ByteString
refOf Int
res)
, (ByteString
"Matrix", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Matrix -> Builder) -> Matrix -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix -> Builder
forall a. ToPdf a => a -> Builder
toPdf (Matrix -> ByteString) -> Matrix -> ByteString
forall a b. (a -> b) -> a -> b
$ Transformation -> Matrix
Matrix Transformation
trans)
]
}
groupDic :: PdfColorable px => Proxy px -> [(B.ByteString, B.ByteString)]
groupDic :: Proxy px -> Resources
groupDic Proxy px
px =
[ (ByteString
"Type", ByteString
"/Group")
, (ByteString
"S", ByteString
"/Transparency")
, (ByteString
"I", ByteString
"true")
, (ByteString
"CS", Proxy px -> ByteString
forall px. PdfColorable px => Proxy px -> ByteString
pdfColorSpace Proxy px
px)
]
formObject :: PdfColorable px
=> Resources -> Proxy px -> B.ByteString -> PdfId
-> PdfEnv (PdfId -> PdfObject)
formObject :: Resources
-> Proxy px -> ByteString -> Int -> PdfEnv (Int -> PdfObject)
formObject Resources
aditionalAttributes Proxy px
px ByteString
content Int
res = do
Builder
width <- Int -> Builder
intDec (Int -> Builder)
-> StateT PdfContext (Reader PdfConfiguration) Int
-> PdfEnv Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PdfConfiguration -> Int)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PdfConfiguration -> Int
_pdfWidth
Builder
height <- Int -> Builder
intDec (Int -> Builder)
-> StateT PdfContext (Reader PdfConfiguration) Int
-> PdfEnv Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PdfConfiguration -> Int)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PdfConfiguration -> Int
_pdfHeight
(Int -> PdfObject) -> PdfEnv (Int -> PdfObject)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int -> PdfObject) -> PdfEnv (Int -> PdfObject))
-> (Int -> PdfObject) -> PdfEnv (Int -> PdfObject)
forall a b. (a -> b) -> a -> b
$ \Int
pid -> PdfObject :: Int -> Int -> Resources -> ByteString -> PdfObject
PdfObject
{ _pdfId :: Int
_pdfId = Int
pid
, _pdfRevision :: Int
_pdfRevision = Int
0
, _pdfStream :: ByteString
_pdfStream = ByteString
content
, _pdfAnnot :: Resources
_pdfAnnot =
[ (ByteString
"Type", ByteString
"/XObject")
, (ByteString
"Subtype", ByteString
"/Form")
, (ByteString
"BBox", Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
"[0 0 " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
width Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
height Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]")
, (ByteString
"XStep", Builder -> ByteString
buildToStrict Builder
width)
, (ByteString
"YStep", Builder -> ByteString
buildToStrict Builder
height)
, (ByteString
"Resources", Int -> ByteString
refOf Int
res)
, (ByteString
"Group", Builder -> ByteString
buildToStrict (Builder -> ByteString)
-> (Resources -> Builder) -> Resources -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Resources -> Builder
forall a. ToPdf a => a -> Builder
toPdf (Resources -> ByteString) -> Resources -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy px -> Resources
forall px. PdfColorable px => Proxy px -> Resources
groupDic Proxy px
px)
] Resources -> Resources -> Resources
forall a. Semigroup a => a -> a -> a
<> Resources
aditionalAttributes
}
gradientToPdf :: PdfColorable px => Gradient px -> PdfEnv PdfId
gradientToPdf :: Gradient px -> StateT PdfContext (Reader PdfConfiguration) Int
gradientToPdf [] = Int -> StateT PdfContext (Reader PdfConfiguration) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
gradientToPdf [(Float
_, px
a), (Float
_, px
b)] = (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject (px -> px -> Int -> PdfObject
forall px. PdfColorable px => px -> px -> Int -> PdfObject
colorInterpolationFunction px
a px
b)
gradientToPdf lst :: Gradient px
lst@((Float, px)
_:Gradient px
rest) = do
[Int]
interpolations <-
((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> [Int -> PdfObject]
-> StateT PdfContext (Reader PdfConfiguration) [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject [px -> px -> Int -> PdfObject
forall px. PdfColorable px => px -> px -> Int -> PdfObject
colorInterpolationFunction px
a px
b
| ((Float
_, px
a), (Float
_, px
b)) <- Gradient px -> Gradient px -> [((Float, px), (Float, px))]
forall a b. [a] -> [b] -> [(a, b)]
zip Gradient px
lst Gradient px
rest]
let bounds :: [Domain]
bounds = [Float] -> [Float] -> [Domain]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Float, px) -> Float) -> Gradient px -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float, px) -> Float
forall a b. (a, b) -> a
fst Gradient px
lst) (((Float, px) -> Float) -> Gradient px -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float, px) -> Float
forall a b. (a, b) -> a
fst Gradient px
rest)
(Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ([Int] -> [Domain] -> Int -> PdfObject
stitchingFunction [Int]
interpolations [Domain]
bounds)
repeatFunction :: SamplerRepeat -> Float -> Float -> PdfId -> PdfEnv PdfId
repeatFunction :: SamplerRepeat
-> Float
-> Float
-> Int
-> StateT PdfContext (Reader PdfConfiguration) Int
repeatFunction SamplerRepeat
sampler Float
beg Float
end Int
fun = case SamplerRepeat
sampler of
SamplerRepeat
SamplerPad -> Int -> StateT PdfContext (Reader PdfConfiguration) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
fun
SamplerRepeat
_ | Int -> Int
forall a. Num a => a -> a
abs (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
beg) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int
1 :: Int) -> Int -> StateT PdfContext (Reader PdfConfiguration) Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
fun
SamplerRepeat
SamplerRepeat -> (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall a b. (a -> b) -> a -> b
$ Bool -> Float -> Float -> Int -> Int -> PdfObject
repeatingFunction Bool
False Float
beg Float
end Int
fun
SamplerRepeat
SamplerReflect -> (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall a b. (a -> b) -> a -> b
$ Bool -> Float -> Float -> Int -> Int -> PdfObject
repeatingFunction Bool
True Float
beg Float
end Int
fun
type Domain = (Float, Float)
createGradientFunction :: PdfColorable px
=> Transformation -> Domain -> SamplerRepeat -> Gradient px
-> (PdfId -> PdfId -> PdfObject)
-> PdfEnv PdfId
createGradientFunction :: Transformation
-> Domain
-> SamplerRepeat
-> Gradient px
-> (Int -> Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
createGradientFunction Transformation
trans (Float
beg, Float
end) SamplerRepeat
sampler Gradient px
grad Int -> Int -> PdfObject
generator = do
Int
shaderId <- Gradient px -> StateT PdfContext (Reader PdfConfiguration) Int
forall px.
PdfColorable px =>
Gradient px -> StateT PdfContext (Reader PdfConfiguration) Int
gradientToPdf Gradient px
grad
Int
stitched <- SamplerRepeat
-> Float
-> Float
-> Int
-> StateT PdfContext (Reader PdfConfiguration) Int
repeatFunction SamplerRepeat
sampler Float
beg Float
end Int
shaderId
Int
gradId <- (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject (Int -> Int -> PdfObject
generator Int
stitched)
(Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject (Transformation -> Int -> Int -> PdfObject
gradientPatternObject Transformation
trans Int
gradId)
type PdfBaseColorable px =
( PdfColorable px
, PdfColorable (PixelBaseComponent px)
, Integral (PixelBaseComponent px)
, PixelBaseComponent (PixelBaseComponent px) ~ (PixelBaseComponent px))
fullPageFill :: PdfEnv Builder
fullPageFill :: PdfEnv Builder
fullPageFill = do
Int
w <- (PdfConfiguration -> Int)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PdfConfiguration -> Int
_pdfWidth
Int
h <- (PdfConfiguration -> Int)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PdfConfiguration -> Int
_pdfHeight
Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Builder
"0 0 " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
w Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
h Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" re f\n"
gradientObjectGenerator :: forall px. PdfBaseColorable px
=> Builder -> Transformation
-> Domain -> SamplerRepeat -> Gradient px
-> (B.ByteString -> PdfId -> PdfId -> PdfObject)
-> PdfEnv (Either String Builder)
gradientObjectGenerator :: Builder
-> Transformation
-> Domain
-> SamplerRepeat
-> Gradient px
-> (ByteString -> Int -> Int -> PdfObject)
-> PdfEnv (Either String Builder)
gradientObjectGenerator Builder
inner Transformation
rootTrans Domain
dom SamplerRepeat
sampler Gradient px
rootGrad ByteString -> Int -> Int -> PdfObject
generator
| Gradient px -> Bool
forall px.
(Modulable (PixelBaseComponent px), Pixel px) =>
Gradient px -> Bool
isGradientTransparent Gradient px
rootGrad = Gradient px -> PdfEnv (Either String Builder)
goAlpha Gradient px
rootGrad
| Bool
otherwise = Transformation -> Gradient px -> PdfEnv (Either String Builder)
go Transformation
rootTrans Gradient px
rootGrad
where
alphaPxProxy :: Proxy (PixelBaseComponent px)
alphaPxProxy = Proxy (PixelBaseComponent px)
forall p. Proxy p
Proxy :: Proxy (PixelBaseComponent px)
alphaColorspace :: ByteString
alphaColorspace = Proxy
(PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px)))
-> ByteString
forall px. PdfColorable px => Proxy px -> ByteString
pdfColorSpace Proxy (PixelBaseComponent px)
Proxy
(PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px)))
alphaPxProxy
pxFullProxy :: Proxy px
pxFullProxy = Proxy px
forall p. Proxy p
Proxy :: Proxy px
colorSpace :: ByteString
colorSpace = Proxy px -> ByteString
forall px. PdfColorable px => Proxy px -> ByteString
pdfColorSpace Proxy px
pxFullProxy
go :: Transformation -> Gradient px -> PdfEnv (Either String Builder)
go Transformation
trans Gradient px
grad = do
Int
patternId <- Transformation
-> Domain
-> SamplerRepeat
-> Gradient px
-> (Int -> Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall px.
PdfColorable px =>
Transformation
-> Domain
-> SamplerRepeat
-> Gradient px
-> (Int -> Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
createGradientFunction Transformation
trans Domain
dom SamplerRepeat
sampler Gradient px
grad ((Int -> Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> (Int -> Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Int -> PdfObject
generator ByteString
colorSpace
Builder
pat <- ByteString -> PdfEnv Builder
namePatternObject (ByteString -> PdfEnv Builder) -> ByteString -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
refOf Int
patternId
Either String Builder -> PdfEnv (Either String Builder)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Builder -> PdfEnv (Either String Builder))
-> (Builder -> Either String Builder)
-> Builder
-> PdfEnv (Either String Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Either String Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv (Either String Builder))
-> Builder -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$
Builder
"/Pattern cs\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pat Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" scn\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Builder
"/Pattern CS\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pat Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" SCN\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
inner
goAlpha :: Gradient px -> PdfEnv (Either String Builder)
goAlpha Gradient px
grad = do
let alphaGrad :: Gradient (PixelBaseComponent px)
alphaGrad = Gradient px -> Gradient (PixelBaseComponent px)
forall px.
Pixel px =>
Gradient px -> Gradient (PixelBaseComponent px)
toAlphaGradient Gradient px
grad
(Either String Builder
colorGradCom, Int
xObjectRes) <-
PdfEnv (Either String Builder)
-> PdfEnv (Either String Builder, Int)
forall a. PdfEnv a -> PdfEnv (a, Int)
withLocalSubcontext (PdfEnv (Either String Builder)
-> PdfEnv (Either String Builder, Int))
-> (Gradient px -> PdfEnv (Either String Builder))
-> Gradient px
-> PdfEnv (Either String Builder, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation -> Gradient px -> PdfEnv (Either String Builder)
go Transformation
forall a. Monoid a => a
mempty (Gradient px -> PdfEnv (Either String Builder, Int))
-> Gradient px -> PdfEnv (Either String Builder, Int)
forall a b. (a -> b) -> a -> b
$ Gradient px -> Gradient px
forall px. RenderablePixel px => Gradient px -> Gradient px
toOpaqueGradient Gradient px
grad
Int
alphaId <- Transformation
-> Domain
-> SamplerRepeat
-> Gradient
(PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px)))
-> (Int -> Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall px.
PdfColorable px =>
Transformation
-> Domain
-> SamplerRepeat
-> Gradient px
-> (Int -> Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
createGradientFunction Transformation
forall a. Monoid a => a
mempty Domain
dom SamplerRepeat
sampler Gradient (PixelBaseComponent px)
Gradient
(PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px)))
alphaGrad ((Int -> Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> (Int -> Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Int -> PdfObject
generator ByteString
alphaColorspace
(ByteString
command, Int
resourceId) <- PdfEnv ByteString -> PdfEnv (ByteString, Int)
forall a. PdfEnv a -> PdfEnv (a, Int)
withLocalSubcontext (PdfEnv ByteString -> PdfEnv (ByteString, Int))
-> PdfEnv ByteString -> PdfEnv (ByteString, Int)
forall a b. (a -> b) -> a -> b
$ do
Builder
alphaShadingName <- ByteString -> PdfEnv Builder
namePatternObject (ByteString -> PdfEnv Builder) -> ByteString -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
refOf Int
alphaId
Int
opaDicId <- (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall a b. (a -> b) -> a -> b
$ Float -> Int -> PdfObject
opaState Float
1
Builder
gsName <- Int -> PdfEnv Builder
nameStateObject Int
opaDicId
Builder
fullFill <- PdfEnv Builder
fullPageFill
ByteString -> PdfEnv ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> PdfEnv ByteString)
-> (Builder -> ByteString) -> Builder -> PdfEnv ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
buildToStrict (Builder -> PdfEnv ByteString) -> Builder -> PdfEnv ByteString
forall a b. (a -> b) -> a -> b
$ Builder
gsName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" gs /Pattern cs " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
alphaShadingName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" scn\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fullFill
let subInfo :: ByteString
subInfo = (String -> ByteString)
-> (Builder -> ByteString) -> Either String Builder -> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> String -> ByteString
forall a b. a -> b -> a
const ByteString
forall a. Monoid a => a
mempty) Builder -> ByteString
buildToStrict Either String Builder
colorGradCom
Int
formId <- (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> PdfEnv (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Resources
-> Proxy
(PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px)))
-> ByteString
-> Int
-> PdfEnv (Int -> PdfObject)
forall px.
PdfColorable px =>
Resources
-> Proxy px -> ByteString -> Int -> PdfEnv (Int -> PdfObject)
formObject [(ByteString
"FormType", ByteString
"1")] Proxy (PixelBaseComponent px)
Proxy
(PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px)))
alphaPxProxy ByteString
command Int
resourceId
Int -> PdfObject
xObjectGenerator <- Resources
-> Proxy px -> ByteString -> Int -> PdfEnv (Int -> PdfObject)
forall px.
PdfColorable px =>
Resources
-> Proxy px -> ByteString -> Int -> PdfEnv (Int -> PdfObject)
formObject [] Proxy px
pxFullProxy ByteString
subInfo Int
xObjectRes
Builder
xObjName <- Int -> PdfEnv Builder
nameXObject (Int -> PdfEnv Builder)
-> StateT PdfContext (Reader PdfConfiguration) Int
-> PdfEnv Builder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject Int -> PdfObject
xObjectGenerator
Int
maskId <- (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> PdfObject
maskObject Int
formId
Int
maskGraphicStateId <- (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> PdfObject
maskState Int
maskId
Builder
stateName <- Int -> PdfEnv Builder
nameStateObject Int
maskGraphicStateId
Either String Builder -> PdfEnv (Either String Builder)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Builder -> PdfEnv (Either String Builder))
-> (Builder -> Either String Builder)
-> Builder
-> PdfEnv (Either String Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Either String Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> Either String Builder)
-> (Builder -> Builder) -> Builder -> Either String Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
localGraphicState (Builder -> PdfEnv (Either String Builder))
-> Builder -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$ Builder
stateName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" gs\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
xObjName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" Do\n"
alphaLayerGenerator :: forall px. PdfBaseColorable px
=> Proxy px -> (Builder, PdfId) -> Float -> PdfEnv Builder
alphaLayerGenerator :: Proxy px -> (Builder, Int) -> Float -> PdfEnv Builder
alphaLayerGenerator Proxy px
pxFullProxy (Builder
inner, Int
innerResource) Float
alpha = PdfEnv Builder
go where
generateFill :: PdfEnv (ByteString, Int)
generateFill = PdfEnv ByteString -> PdfEnv (ByteString, Int)
forall a. PdfEnv a -> PdfEnv (a, Int)
withLocalSubcontext (PdfEnv ByteString -> PdfEnv (ByteString, Int))
-> PdfEnv ByteString -> PdfEnv (ByteString, Int)
forall a b. (a -> b) -> a -> b
$do
Builder
fill <- PdfEnv Builder
fullPageFill
Builder
shade <- Float -> PdfEnv Builder
nameOpacityObject Float
alpha
let co :: Builder
co = px -> Builder
forall px. PdfColorable px => px -> Builder
colorToPdf (px
forall px. RenderablePixel px => px
emptyPx :: px)
ByteString -> PdfEnv ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> PdfEnv ByteString)
-> (Builder -> ByteString) -> Builder -> PdfEnv ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
buildToStrict (Builder -> PdfEnv ByteString) -> Builder -> PdfEnv ByteString
forall a b. (a -> b) -> a -> b
$ Builder
co Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" rg\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
co Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" RG\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
shade Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" gs " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fill Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" "
go :: PdfEnv Builder
go = do
(ByteString
transpCall, Int
layerRes) <- PdfEnv (ByteString, Int)
generateFill
Int
formId <- (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> PdfEnv (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Resources
-> Proxy px -> ByteString -> Int -> PdfEnv (Int -> PdfObject)
forall px.
PdfColorable px =>
Resources
-> Proxy px -> ByteString -> Int -> PdfEnv (Int -> PdfObject)
formObject Resources
forall a. Monoid a => a
mempty Proxy px
pxFullProxy ByteString
transpCall Int
layerRes
Int
maskId <- (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> PdfObject
alphaMaskObject Int
formId
Builder
maskName <- Int -> PdfEnv Builder
nameStateObject (Int -> PdfEnv Builder)
-> StateT PdfContext (Reader PdfConfiguration) Int
-> PdfEnv Builder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject (Int -> Int -> PdfObject
maskState Int
maskId)
Int
xObjId <- (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> PdfEnv (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Resources
-> Proxy px -> ByteString -> Int -> PdfEnv (Int -> PdfObject)
forall px.
PdfColorable px =>
Resources
-> Proxy px -> ByteString -> Int -> PdfEnv (Int -> PdfObject)
formObject [] Proxy px
pxFullProxy (Builder -> ByteString
buildToStrict Builder
inner) Int
innerResource
Builder
xObjName <- Int -> PdfEnv Builder
nameXObject Int
xObjId
Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder)
-> (Builder -> Builder) -> Builder -> PdfEnv Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
localGraphicState (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Builder
maskName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" gs\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
xObjName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" Do\n"
sampledDomainOf :: SamplerRepeat -> Domain -> Domain
sampledDomainOf :: SamplerRepeat -> Domain -> Domain
sampledDomainOf SamplerRepeat
_ (Float
beg, Float
end) | Float -> Float
forall a. Num a => a -> a
abs (Float
beg Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
end) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
1 = (Float
0, Float
1)
sampledDomainOf SamplerRepeat
sampler (Float
beg, Float
end) = case SamplerRepeat
sampler of
SamplerRepeat
SamplerPad -> (Float
0, Float
1)
SamplerRepeat
SamplerRepeat -> (Float
beg, Float
end)
SamplerRepeat
SamplerReflect -> (Float
beg, Float
end)
currentViewBox :: Transformation -> PdfEnv (Point, Point)
currentViewBox :: Transformation -> PdfEnv (Point, Point)
currentViewBox Transformation
trans = do
Float
width <- (PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float)
-> (PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float)
-> (PdfConfiguration -> Int) -> PdfConfiguration -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PdfConfiguration -> Int
_pdfWidth
Float
height <- (PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float)
-> (PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float)
-> (PdfConfiguration -> Int) -> PdfConfiguration -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PdfConfiguration -> Int
_pdfHeight
let pMin :: Point
pMin = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 Float
0
pMax :: Point
pMax = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
width Float
height
fitBounds :: Transformation -> (Point, Point)
fitBounds Transformation
t = (Transformation -> Point -> Point
applyTransformation Transformation
t Point
pMin, Transformation -> Point -> Point
applyTransformation Transformation
t Point
pMax)
(Point, Point) -> PdfEnv (Point, Point)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Point, Point) -> PdfEnv (Point, Point))
-> (Maybe Transformation -> (Point, Point))
-> Maybe Transformation
-> PdfEnv (Point, Point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point, Point)
-> (Transformation -> (Point, Point))
-> Maybe Transformation
-> (Point, Point)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Point
pMin, Point
pMax) Transformation -> (Point, Point)
fitBounds (Maybe Transformation -> PdfEnv (Point, Point))
-> Maybe Transformation -> PdfEnv (Point, Point)
forall a b. (a -> b) -> a -> b
$ Transformation -> Maybe Transformation
inverseTransformation Transformation
trans
createLinearGradient :: forall px. PdfBaseColorable px
=> Builder -> Transformation -> SamplerRepeat -> Gradient px -> Line
-> PdfEnv (Either String Builder)
createLinearGradient :: Builder
-> Transformation
-> SamplerRepeat
-> Gradient px
-> Line
-> PdfEnv (Either String Builder)
createLinearGradient Builder
inner Transformation
trans SamplerRepeat
sampler Gradient px
grad Line
line = do
Domain
baseDomain <- Line -> (Point, Point) -> Domain
domainOfLinearGradient Line
line ((Point, Point) -> Domain)
-> PdfEnv (Point, Point)
-> StateT PdfContext (Reader PdfConfiguration) Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transformation -> PdfEnv (Point, Point)
currentViewBox Transformation
trans
let dom :: Domain
dom@(Float
beg, Float
end) = SamplerRepeat -> Domain -> Domain
sampledDomainOf SamplerRepeat
sampler Domain
baseDomain
sampledLine :: Line
sampledLine = Float -> Float -> Line -> Line
extendLine Float
beg Float
end Line
line
Builder
-> Transformation
-> Domain
-> SamplerRepeat
-> Gradient px
-> (ByteString -> Int -> Int -> PdfObject)
-> PdfEnv (Either String Builder)
forall px.
PdfBaseColorable px =>
Builder
-> Transformation
-> Domain
-> SamplerRepeat
-> Gradient px
-> (ByteString -> Int -> Int -> PdfObject)
-> PdfEnv (Either String Builder)
gradientObjectGenerator Builder
inner Transformation
trans Domain
dom SamplerRepeat
sampler Gradient px
grad ((ByteString -> Int -> Int -> PdfObject)
-> PdfEnv (Either String Builder))
-> (ByteString -> Int -> Int -> PdfObject)
-> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$
Line -> Domain -> ByteString -> Int -> Int -> PdfObject
linearGradientObject Line
sampledLine Domain
dom
createRadialGradient :: forall px. PdfBaseColorable px
=> Builder -> Transformation -> SamplerRepeat -> Gradient px
-> Point -> Point -> Float
-> PdfEnv (Either String Builder)
createRadialGradient :: Builder
-> Transformation
-> SamplerRepeat
-> Gradient px
-> Point
-> Point
-> Float
-> PdfEnv (Either String Builder)
createRadialGradient Builder
inner Transformation
trans SamplerRepeat
sampler Gradient px
grad Point
center Point
focus Float
radius = do
Domain
baseDomain <- Point -> Float -> (Point, Point) -> Domain
domainOfCircle Point
center Float
radius ((Point, Point) -> Domain)
-> PdfEnv (Point, Point)
-> StateT PdfContext (Reader PdfConfiguration) Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transformation -> PdfEnv (Point, Point)
currentViewBox Transformation
trans
let dom :: Domain
dom@(Float
beg, Float
end) = SamplerRepeat -> Domain -> Domain
sampledDomainOf SamplerRepeat
sampler Domain
baseDomain
radius' :: Float
radius' = Float
radius Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (Float -> Float
forall a. Num a => a -> a
abs Float
beg) (Float -> Float
forall a. Num a => a -> a
abs Float
end)
Builder
-> Transformation
-> Domain
-> SamplerRepeat
-> Gradient px
-> (ByteString -> Int -> Int -> PdfObject)
-> PdfEnv (Either String Builder)
forall px.
PdfBaseColorable px =>
Builder
-> Transformation
-> Domain
-> SamplerRepeat
-> Gradient px
-> (ByteString -> Int -> Int -> PdfObject)
-> PdfEnv (Either String Builder)
gradientObjectGenerator Builder
inner Transformation
trans Domain
dom SamplerRepeat
sampler Gradient px
grad ((ByteString -> Int -> Int -> PdfObject)
-> PdfEnv (Either String Builder))
-> (ByteString -> Int -> Int -> PdfObject)
-> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$
Domain
-> Point -> Point -> Float -> ByteString -> Int -> Int -> PdfObject
radialGradientObject Domain
dom Point
center Point
focus Float
radius'
opacityToPdf :: forall n. (Integral n, Modulable n) => n -> Float
opacityToPdf :: n -> Float
opacityToPdf n
comp = n -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
comp Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ n -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
fv where
fv :: n
fv = n
forall a. Modulable a => a
fullValue :: n
textureToPdf :: forall px. PdfBaseColorable px
=> Transformation -> Builder -> Texture px
-> PdfEnv (Either String Builder)
textureToPdf :: Transformation
-> Builder -> Texture px -> PdfEnv (Either String Builder)
textureToPdf Transformation
rootTrans Builder
inner = Transformation
-> SamplerRepeat -> Texture px -> PdfEnv (Either String Builder)
go Transformation
rootTrans SamplerRepeat
SamplerPad where
go :: Transformation
-> SamplerRepeat -> Texture px -> PdfEnv (Either String Builder)
go Transformation
currTrans SamplerRepeat
sampler Texture px
tex = case Texture px
tex of
SampledTexture Image px
_img -> Either String Builder -> PdfEnv (Either String Builder)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Builder -> PdfEnv (Either String Builder))
-> Either String Builder -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$ String -> Either String Builder
forall a b. a -> Either a b
Left String
"Unsupported raw image in PDF output."
ShaderTexture ShaderFunction px
_f -> Either String Builder -> PdfEnv (Either String Builder)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Builder -> PdfEnv (Either String Builder))
-> Either String Builder -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$ String -> Either String Builder
forall a b. a -> Either a b
Left String
"Unsupported shader function in PDF output."
ModulateTexture Texture px
_tx Texture (PixelBaseComponent px)
_modulation -> Either String Builder -> PdfEnv (Either String Builder)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Builder -> PdfEnv (Either String Builder))
-> Either String Builder -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$ String -> Either String Builder
forall a b. a -> Either a b
Left String
"Unsupported modulation in PDF output."
AlphaModulateTexture Texture px
_tx Texture (PixelBaseComponent px)
_modulation -> Either String Builder -> PdfEnv (Either String Builder)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Builder -> PdfEnv (Either String Builder))
-> Either String Builder -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$ String -> Either String Builder
forall a b. a -> Either a b
Left String
"Unsupported alpha modulation in PDF output."
RawTexture Image px
img -> Transformation
-> SamplerRepeat -> Texture px -> PdfEnv (Either String Builder)
go Transformation
currTrans SamplerRepeat
sampler (Image px -> Texture px
forall px. Image px -> Texture px
SampledTexture Image px
img)
WithSampler SamplerRepeat
newSampler Texture px
tx -> Transformation
-> SamplerRepeat -> Texture px -> PdfEnv (Either String Builder)
go Transformation
currTrans SamplerRepeat
newSampler Texture px
tx
SolidTexture px
px | px -> Bool
forall px.
(Modulable (PixelBaseComponent px), Pixel px) =>
px -> Bool
isPixelTransparent px
px -> do
Builder
localState <- Float -> PdfEnv Builder
nameOpacityObject (Float -> PdfEnv Builder)
-> (PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px))
-> Float)
-> PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px))
-> PdfEnv Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px))
-> Float
forall n. (Integral n, Modulable n) => n -> Float
opacityToPdf (PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px))
-> PdfEnv Builder)
-> PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px))
-> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ px -> PixelBaseComponent px
forall a. Pixel a => a -> PixelBaseComponent a
pixelOpacity px
px
Either String Builder -> PdfEnv (Either String Builder)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Builder -> PdfEnv (Either String Builder))
-> (Builder -> Either String Builder)
-> Builder
-> PdfEnv (Either String Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Either String Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> Either String Builder)
-> (Builder -> Builder) -> Builder -> Either String Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
localGraphicState (Builder -> PdfEnv (Either String Builder))
-> Builder -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$
Builder
localState Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" gs\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
co Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" rg\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
co Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" RG\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
inner
where co :: Builder
co = px -> Builder
forall px. PdfColorable px => px -> Builder
colorToPdf px
px
SolidTexture px
px ->
Either String Builder -> PdfEnv (Either String Builder)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Builder -> PdfEnv (Either String Builder))
-> (Builder -> Either String Builder)
-> Builder
-> PdfEnv (Either String Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Either String Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv (Either String Builder))
-> Builder -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$ Builder
"/ao gs " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
co Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" rg\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
co Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" RG\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
inner
where co :: Builder
co = px -> Builder
forall px. PdfColorable px => px -> Builder
colorToPdf px
px
MeshPatchTexture PatchInterpolation
_ MeshPatch px
mesh -> Builder -> MeshPatch px -> PdfEnv (Either String Builder)
forall px.
PdfBaseColorable px =>
Builder -> MeshPatch px -> PdfEnv (Either String Builder)
createMeshGradient Builder
inner MeshPatch px
mesh
LinearGradientTexture Gradient px
grad Line
line -> Builder
-> Transformation
-> SamplerRepeat
-> Gradient px
-> Line
-> PdfEnv (Either String Builder)
forall px.
PdfBaseColorable px =>
Builder
-> Transformation
-> SamplerRepeat
-> Gradient px
-> Line
-> PdfEnv (Either String Builder)
createLinearGradient Builder
inner Transformation
currTrans SamplerRepeat
sampler Gradient px
grad Line
line
RadialGradientTexture Gradient px
grad Point
center Float
radius ->
Transformation
-> SamplerRepeat -> Texture px -> PdfEnv (Either String Builder)
go Transformation
currTrans SamplerRepeat
sampler (Texture px -> PdfEnv (Either String Builder))
-> Texture px -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$ Gradient px -> Point -> Float -> Point -> Texture px
forall px. Gradient px -> Point -> Float -> Point -> Texture px
RadialGradientWithFocusTexture Gradient px
grad Point
center Float
radius Point
center
RadialGradientWithFocusTexture Gradient px
grad Point
center Float
rad Point
focus -> do
let invGrad :: Gradient px
invGrad = Gradient px -> Gradient px
forall a. [a] -> [a]
reverse [(Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
o, px
c) | (Float
o, px
c) <- Gradient px
grad]
Builder
-> Transformation
-> SamplerRepeat
-> Gradient px
-> Point
-> Point
-> Float
-> PdfEnv (Either String Builder)
forall px.
PdfBaseColorable px =>
Builder
-> Transformation
-> SamplerRepeat
-> Gradient px
-> Point
-> Point
-> Float
-> PdfEnv (Either String Builder)
createRadialGradient Builder
inner Transformation
currTrans SamplerRepeat
sampler Gradient px
invGrad Point
center Point
focus Float
rad
WithTextureTransform Transformation
trans Texture px
tx ->
Transformation
-> SamplerRepeat -> Texture px -> PdfEnv (Either String Builder)
go Transformation
tt SamplerRepeat
sampler Texture px
tx
where tt :: Transformation
tt = case Transformation -> Maybe Transformation
inverseTransformation Transformation
trans of
Maybe Transformation
Nothing -> Transformation
currTrans
Just Transformation
v -> Transformation
currTrans Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Transformation
v
PatternTexture Int
w Int
h px
px Drawing px ()
draw Image px
_img -> do
let withPatternSize :: PdfConfiguration -> PdfConfiguration
withPatternSize PdfConfiguration
conf = PdfConfiguration
conf { _pdfWidth :: Int
_pdfWidth = Int
w, _pdfHeight :: Int
_pdfHeight = Int
h }
baseTexture :: Texture px
baseTexture = px -> Texture px
forall px. px -> Texture px
SolidTexture px
px
backRect :: [Primitive]
backRect = Point -> Float -> Float -> [Primitive]
rectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 Float
0) (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
backDraw :: Drawing px ()
backDraw =
DrawCommand px () -> Drawing px ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> Drawing px ())
-> DrawCommand px () -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ Texture px -> Drawing px () -> () -> DrawCommand px ()
forall px next.
Texture px -> Drawing px () -> next -> DrawCommand px next
SetTexture Texture px
baseTexture
(DrawCommand px () -> Drawing px ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> Drawing px ())
-> DrawCommand px () -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ FillMethod -> [Primitive] -> () -> DrawCommand px ()
forall px next.
FillMethod -> [Primitive] -> next -> DrawCommand px next
Fill FillMethod
FillWinding [Primitive]
backRect ()) ()
(Builder
content, Int
resId) <-
(PdfConfiguration -> PdfConfiguration)
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int)
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local PdfConfiguration -> PdfConfiguration
withPatternSize (StateT PdfContext (Reader PdfConfiguration) (Builder, Int)
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int))
-> (PdfEnv Builder
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int))
-> PdfEnv Builder
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PdfEnv Builder
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int)
forall a. PdfEnv a -> PdfEnv (a, Int)
withLocalSubcontext (PdfEnv Builder
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int))
-> PdfEnv Builder
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int)
forall a b. (a -> b) -> a -> b
$ Texture px -> Drawing px () -> PdfEnv Builder
forall pixel.
PdfBaseColorable pixel =>
Texture pixel -> Drawing pixel () -> PdfEnv Builder
pdfProducer Texture px
baseTexture (Drawing px ()
backDraw Drawing px () -> Drawing px () -> Drawing px ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Drawing px ()
draw)
Int
tillingId <- (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
generateObject ((Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int)
-> (Int -> PdfObject)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall a b. (a -> b) -> a -> b
$ Transformation -> Int -> Int -> Builder -> Int -> Int -> PdfObject
tillingPattern Transformation
rootTrans Int
w Int
h (Builder
content) Int
resId
Builder
pat <- ByteString -> PdfEnv Builder
namePatternObject (ByteString -> PdfEnv Builder) -> ByteString -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
refOf Int
tillingId
Either String Builder -> PdfEnv (Either String Builder)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Builder -> PdfEnv (Either String Builder))
-> (Builder -> Either String Builder)
-> Builder
-> PdfEnv (Either String Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Either String Builder
forall a b. b -> Either a b
Right (Builder -> PdfEnv (Either String Builder))
-> Builder -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$ Builder
"/Pattern cs\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
pat Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" scn\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
inner
reClose :: [Primitive] -> Builder
reClose :: [Primitive] -> Builder
reClose [] = Builder
forall a. Monoid a => a
mempty
reClose lst :: [Primitive]
lst@(Primitive
x:[Primitive]
_)
| Primitive -> Point
lastPointOf ([Primitive] -> Primitive
forall a. [a] -> a
last [Primitive]
lst) Point -> Point -> Bool
`isDistingableFrom` Primitive -> Point
firstPointOf Primitive
x = Builder
forall a. Monoid a => a
mempty
| Bool
otherwise = ByteString -> Builder
tp ByteString
" h\n"
fillCommandOf :: FillMethod -> Builder
fillCommandOf :: FillMethod -> Builder
fillCommandOf FillMethod
m = ByteString -> Builder
tp (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ case FillMethod
m of
FillMethod
FillWinding -> ByteString
"f\n"
FillMethod
FillEvenOdd -> ByteString
"f*\n"
clipCommandOf :: FillMethod -> Builder
clipCommandOf :: FillMethod -> Builder
clipCommandOf FillMethod
m = ByteString -> Builder
tp (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ case FillMethod
m of
FillMethod
FillWinding -> ByteString
"W n\n"
FillMethod
FillEvenOdd -> ByteString
"W* n\n"
lineCapOf :: Cap -> Builder
lineCapOf :: Cap -> Builder
lineCapOf Cap
c = ByteString -> Builder
tp (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ case Cap
c of
CapStraight Float
0 -> ByteString
"0 J "
CapStraight Float
_g -> ByteString
"2 J "
Cap
CapRound -> ByteString
"1 J "
lineJoinOf :: Join -> Builder
lineJoinOf :: Join -> Builder
lineJoinOf Join
j = case Join
j of
Join
JoinRound -> ByteString -> Builder
tp ByteString
"1 j "
JoinMiter Float
0 -> ByteString -> Builder
tp ByteString
"8 M 0 j "
JoinMiter Float
n -> Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" M 0 j "
orderToPdf :: PdfBaseColorable px => Transformation -> DrawOrder px
-> PdfEnv Builder
orderToPdf :: Transformation -> DrawOrder px -> PdfEnv Builder
orderToPdf Transformation
trans DrawOrder px
order = do
let processPath :: [Primitive] -> Builder
processPath = ([Primitive] -> Builder) -> [[Primitive]] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Primitive] -> Builder
pathToPdf ([[Primitive]] -> Builder)
-> ([Primitive] -> [[Primitive]]) -> [Primitive] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Primitive] -> [[Primitive]]
resplit
geometryCode :: Builder
geometryCode = ([Primitive] -> Builder) -> [[Primitive]] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Primitive] -> Builder
processPath ([[Primitive]] -> Builder) -> [[Primitive]] -> Builder
forall a b. (a -> b) -> a -> b
$ DrawOrder px -> [[Primitive]]
forall px. DrawOrder px -> [[Primitive]]
_orderPrimitives DrawOrder px
order
Either String Builder
etx <- Transformation
-> Builder -> Texture px -> PdfEnv (Either String Builder)
forall px.
PdfBaseColorable px =>
Transformation
-> Builder -> Texture px -> PdfEnv (Either String Builder)
textureToPdf Transformation
trans Builder
geometryCode (Texture px -> PdfEnv (Either String Builder))
-> Texture px -> PdfEnv (Either String Builder)
forall a b. (a -> b) -> a -> b
$ DrawOrder px -> Texture px
forall px. DrawOrder px -> Texture px
_orderTexture DrawOrder px
order
case Either String Builder
etx of
Left String
_ -> Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
forall a. Monoid a => a
mempty
Right Builder
tx -> Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Builder
tx Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
geometryCode Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FillMethod -> Builder
fillCommandOf (DrawOrder px -> FillMethod
forall px. DrawOrder px -> FillMethod
_orderFillMethod DrawOrder px
order)
buildXRefTable :: [Int] -> Builder
buildXRefTable :: [Int] -> Builder
buildXRefTable [Int]
lst = ByteString -> Builder
tp ByteString
"xref\n0 " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec ([Int] -> Int
forall (f :: * -> *) a. Foldable f => f a -> Int
glength [Int]
lst) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
"\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int -> Builder) -> [Int] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Int -> Builder
forall t. (Eq t, Num t, PrintfArg t) => t -> Builder
build [Int]
lst where
build :: t -> Builder
build t
0 = Builder
"0000000000 65535 f \n"
build t
off = ByteString -> Builder
forall a. ToPdf a => a -> Builder
toPdf (ByteString -> Builder)
-> (String -> ByteString) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
B.pack (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ String -> t -> String
forall r. PrintfType r => String -> r
printf String
"%010d 00000 n \n" t
off
buildTrailer :: Foldable f => f a -> PdfId -> Builder
buildTrailer :: f a -> Int -> Builder
buildTrailer f a
objs Int
startId = ByteString -> Builder
tp ByteString
"trailer\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Resources -> Builder
forall a. ToPdf a => a -> Builder
toPdf
[(ByteString
"Size" :: B.ByteString, Builder -> ByteString
buildToStrict (Builder -> ByteString) -> (Int -> Builder) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
intDec (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ f a -> Int
forall (f :: * -> *) a. Foldable f => f a -> Int
glength f a
objs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
,(ByteString
"Root", Int -> ByteString
refOf Int
startId)
]
toPdfSpace :: Float -> Transformation
toPdfSpace :: Float -> Transformation
toPdfSpace Float
h = Point -> Transformation
translate (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 Float
h) Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Float -> Float -> Transformation
scale Float
1 (-Float
1)
pdfFromProducer :: PdfBaseColorable px
=> Proxy px -> PdfConfiguration -> PdfEnv Builder -> LB.ByteString
pdfFromProducer :: Proxy px -> PdfConfiguration -> PdfEnv Builder -> ByteString
pdfFromProducer Proxy px
px PdfConfiguration
conf PdfEnv Builder
producer = Proxy px -> PdfConfiguration -> [PdfEnv Builder] -> ByteString
forall px.
PdfBaseColorable px =>
Proxy px -> PdfConfiguration -> [PdfEnv Builder] -> ByteString
pdfFromProducers Proxy px
px PdfConfiguration
conf [PdfEnv Builder
producer]
pdfFromProducers :: PdfBaseColorable px
=> Proxy px -> PdfConfiguration -> [PdfEnv Builder] -> LB.ByteString
pdfFromProducers :: Proxy px -> PdfConfiguration -> [PdfEnv Builder] -> ByteString
pdfFromProducers Proxy px
px PdfConfiguration
conf [PdfEnv Builder]
producers = Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
(ByteString -> Builder) -> [ByteString] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ByteString -> Builder
byteString [ByteString]
objs
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
xref
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [PdfObject] -> Int -> Builder
forall (f :: * -> *) a. Foldable f => f a -> Int -> Builder
buildTrailer [PdfObject]
objects Int
catalogId
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
xrefPosition
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
"%%EOF"
where
height :: Int
height = PdfConfiguration -> Int
_pdfHeight PdfConfiguration
conf
(Int
catalogId : Int
outlineId : Int
pagesId : Int
endObjId : [Int]
remainingIds) = [Int
1..]
([Int]
pageIds, [Int]
remainingIds') = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt ([PdfEnv Builder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PdfEnv Builder]
producers) [Int]
remainingIds
([Int]
contentIds, [Int]
remainingIds'') = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt ([PdfEnv Builder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PdfEnv Builder]
producers) [Int]
remainingIds'
firstFreeId :: Int
firstFreeId = [Int] -> Int
forall a. [a] -> a
head [Int]
remainingIds''
([Builder]
contents, PdfContext
endContext) = PdfConfiguration
-> Int -> [PdfEnv Builder] -> ([Builder], PdfContext)
forall a.
PdfConfiguration -> Int -> [PdfEnv a] -> ([a], PdfContext)
runPdfEnvs PdfConfiguration
conf Int
firstFreeId [PdfEnv Builder]
producers
initialTransform :: Builder
initialTransform = Transformation -> Builder
forall a. ToPdf a => a -> Builder
toPdf (Transformation -> Builder)
-> (Float -> Transformation) -> Float -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Transformation
toPdfSpace (Float -> Builder) -> Float -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height
objects :: [PdfObject]
objects =
[ Int -> Int -> Int -> PdfObject
catalogObject Int
pagesId Int
outlineId Int
catalogId
, [ByteString] -> Int -> PdfObject
forall (f :: * -> *).
Foldable f =>
f ByteString -> Int -> PdfObject
outlinesObject [] Int
outlineId
, [Int] -> Int -> PdfObject
forall (f :: * -> *). Foldable f => f Int -> Int -> PdfObject
pagesObject [Int]
pageIds Int
pagesId
] [PdfObject] -> [PdfObject] -> [PdfObject]
forall a. Semigroup a => a -> a -> a
<>
((Int, Int, Builder) -> [PdfObject])
-> [(Int, Int, Builder)] -> [PdfObject]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
contentId, Int
pageId, Builder
content) ->
[ Proxy px -> Int -> Int -> Int -> Int -> Int -> Int -> PdfObject
forall px.
PdfColorable px =>
Proxy px -> Int -> Int -> Int -> Int -> Int -> Int -> PdfObject
pageObject Proxy px
px (PdfConfiguration -> Int
_pdfWidth PdfConfiguration
conf) Int
height Int
pagesId Int
contentId Int
endObjId Int
pageId
, ByteString -> Int -> PdfObject
contentObject (Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
initialTransform Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
content) Int
contentId]
) ([Int] -> [Int] -> [Builder] -> [(Int, Int, Builder)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int]
contentIds [Int]
pageIds [Builder]
contents)
[PdfObject] -> [PdfObject] -> [PdfObject]
forall a. Semigroup a => a -> a -> a
<>
[ Resources
-> Resources -> Resources -> Resources -> Int -> PdfObject
resourceObject
(PdfContext
endContext PdfContext -> Lens' PdfContext Resources -> Resources
forall s t a b. s -> Lens s t a b -> a
.^ (PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfShadings((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc)
(PdfContext
endContext PdfContext -> Lens' PdfContext Resources -> Resources
forall s t a b. s -> Lens s t a b -> a
.^ (PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfGraphicStates((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc)
(PdfContext
endContext PdfContext -> Lens' PdfContext Resources -> Resources
forall s t a b. s -> Lens s t a b -> a
.^ (PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfPatterns((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc)
(PdfContext
endContext PdfContext -> Lens' PdfContext Resources -> Resources
forall s t a b. s -> Lens s t a b -> a
.^ (PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext
Lens' PdfContext PdfResourceAssoc
pdfXObjects((PdfResourceAssoc -> f PdfResourceAssoc)
-> PdfContext -> f PdfContext)
-> ((Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc)
-> (Resources -> f Resources)
-> PdfContext
-> f PdfContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Resources -> f Resources)
-> PdfResourceAssoc -> f PdfResourceAssoc
Lens' PdfResourceAssoc Resources
resAssoc)
Int
endObjId
]
[PdfObject] -> [PdfObject] -> [PdfObject]
forall a. Semigroup a => a -> a -> a
<> [PdfObject] -> [PdfObject]
forall a. [a] -> [a]
reverse (PdfContext -> [PdfObject]
_generatedPdfObjects PdfContext
endContext)
([(Int, Int)]
indexes, [ByteString]
objs) = [((Int, Int), ByteString)] -> ([(Int, Int)], [ByteString])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((Int, Int), ByteString)] -> ([(Int, Int)], [ByteString]))
-> [((Int, Int), ByteString)] -> ([(Int, Int)], [ByteString])
forall a b. (a -> b) -> a -> b
$ [PdfObject] -> [((Int, Int), ByteString)]
prepareObjects [PdfObject]
objects
(Int
_, Int
lastOffset) = [(Int, Int)] -> (Int, Int)
forall a. [a] -> a
last [(Int, Int)]
indexes
xrefOffset :: Int
xrefOffset = Int
lastOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ([ByteString] -> ByteString
forall a. [a] -> a
last [ByteString]
objs)
xrefPosition :: Builder
xrefPosition = Builder
"startxref\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
xrefOffset Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
"\n"
offsets :: [Int]
offsets = ((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
forall a b. (a, b) -> b
snd ([(Int, Int)] -> [Int]) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Int) -> [(Int, Int)] -> [(Int, Int)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Int) -> Int
forall a b. (a, b) -> a
fst [(Int, Int)]
indexes
xref :: Builder
xref = [Int] -> Builder
buildXRefTable [Int]
offsets
renderDrawingToPdf :: (forall px . PdfColorable px => Drawing px () -> [DrawOrder px])
-> Int -> Int -> Dpi -> Drawing PixelRGBA8 ()
-> LB.ByteString
renderDrawingToPdf :: (forall px. PdfColorable px => Drawing px () -> [DrawOrder px])
-> Int -> Int -> Int -> Drawing PixelRGBA8 () -> ByteString
renderDrawingToPdf forall px. PdfColorable px => Drawing px () -> [DrawOrder px]
toOrders Int
width Int
height Int
dpi Drawing PixelRGBA8 ()
d = (forall px. PdfColorable px => Drawing px () -> [DrawOrder px])
-> Int -> Int -> Int -> [Drawing PixelRGBA8 ()] -> ByteString
renderDrawingsToPdf forall px. PdfColorable px => Drawing px () -> [DrawOrder px]
toOrders Int
width Int
height Int
dpi [Drawing PixelRGBA8 ()
d]
renderDrawingsToPdf :: (forall px . PdfColorable px => Drawing px () -> [DrawOrder px])
-> Int -> Int -> Dpi -> [Drawing PixelRGBA8 ()]
-> LB.ByteString
renderDrawingsToPdf :: (forall px. PdfColorable px => Drawing px () -> [DrawOrder px])
-> Int -> Int -> Int -> [Drawing PixelRGBA8 ()] -> ByteString
renderDrawingsToPdf forall px. PdfColorable px => Drawing px () -> [DrawOrder px]
toOrders Int
width Int
height Int
dpi [Drawing PixelRGBA8 ()]
ds =
Proxy PixelRGBA8
-> PdfConfiguration -> [PdfEnv Builder] -> ByteString
forall px.
PdfBaseColorable px =>
Proxy px -> PdfConfiguration -> [PdfEnv Builder] -> ByteString
pdfFromProducers Proxy PixelRGBA8
px PdfConfiguration
conf ([PdfEnv Builder] -> ByteString) -> [PdfEnv Builder] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Drawing PixelRGBA8 () -> PdfEnv Builder)
-> [Drawing PixelRGBA8 ()] -> [PdfEnv Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Texture PixelRGBA8 -> Drawing PixelRGBA8 () -> PdfEnv Builder
forall pixel.
PdfBaseColorable pixel =>
Texture pixel -> Drawing pixel () -> PdfEnv Builder
pdfProducer Texture PixelRGBA8
baseTexture) [Drawing PixelRGBA8 ()]
ds
where
px :: Proxy PixelRGBA8
px = Proxy PixelRGBA8
forall p. Proxy p
Proxy :: Proxy PixelRGBA8
baseTexture :: Texture PixelRGBA8
baseTexture = PixelRGBA8 -> Texture PixelRGBA8
forall px. px -> Texture px
SolidTexture PixelRGBA8
forall px. RenderablePixel px => px
emptyPx
conf :: PdfConfiguration
conf = PdfConfiguration :: Int
-> Int
-> Int
-> (forall px. PdfColorable px => Drawing px () -> [DrawOrder px])
-> PdfConfiguration
PdfConfiguration
{ _pdfConfDpi :: Int
_pdfConfDpi = Int
dpi
, _pdfWidth :: Int
_pdfWidth = Int
width
, _pdfHeight :: Int
_pdfHeight = Int
height
, _pdfConfToOrder :: forall px. PdfColorable px => Drawing px () -> [DrawOrder px]
_pdfConfToOrder = forall px. PdfColorable px => Drawing px () -> [DrawOrder px]
toOrders
}
pdfProducer :: forall pixel . PdfBaseColorable pixel
=> Texture pixel -> Drawing pixel () -> PdfEnv Builder
pdfProducer :: Texture pixel -> Drawing pixel () -> PdfEnv Builder
pdfProducer Texture pixel
baseTexture Drawing pixel ()
draw = do
Transformation
initTrans <- (PdfConfiguration -> Transformation)
-> StateT PdfContext (Reader PdfConfiguration) Transformation
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Float -> Transformation
toPdfSpace (Float -> Transformation)
-> (PdfConfiguration -> Float)
-> PdfConfiguration
-> Transformation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float)
-> (PdfConfiguration -> Int) -> PdfConfiguration -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PdfConfiguration -> Int
_pdfHeight)
Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture pixel
-> Free (DrawCommand pixel) ()
-> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
goNext Bool
False Transformation
initTrans FillMethod -> Builder
fillCommandOf Texture pixel
baseTexture (Free (DrawCommand pixel) () -> PdfEnv Builder)
-> Free (DrawCommand pixel) () -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Drawing pixel () -> Free (DrawCommand pixel) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing pixel ()
draw where
goNext :: forall px. PdfBaseColorable px
=> Bool -> Transformation -> (FillMethod -> Builder) -> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
goNext :: Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
goNext Bool
forceInverse Transformation
activeTrans FillMethod -> Builder
filler Texture px
prevTexture Free (DrawCommand px) ()
f = case Free (DrawCommand px) ()
f of
Free DrawCommand px (Free (DrawCommand px) ())
c -> Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> DrawCommand px (Free (DrawCommand px) ())
-> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> DrawCommand px (Free (DrawCommand px) ())
-> PdfEnv Builder
go Bool
forceInverse Transformation
activeTrans FillMethod -> Builder
filler Texture px
prevTexture DrawCommand px (Free (DrawCommand px) ())
c
Pure () -> Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
forall a. Monoid a => a
mempty
go :: forall px. PdfBaseColorable px
=> Bool -> Transformation -> (FillMethod -> Builder) -> Texture px
-> DrawCommand px (Free (DrawCommand px) ()) -> PdfEnv Builder
go :: Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> DrawCommand px (Free (DrawCommand px) ())
-> PdfEnv Builder
go Bool
forceInverse Transformation
activeTrans FillMethod -> Builder
filler Texture px
prevTexture DrawCommand px (Free (DrawCommand px) ())
com = case DrawCommand px (Free (DrawCommand px) ())
com of
CustomRender forall s. DrawContext (ST s) px ()
_mesh Free (DrawCommand px) ()
next -> Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
MeshPatchRender PatchInterpolation
i MeshPatch px
m Free (DrawCommand px) ()
next -> do
Float
w <- (PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float)
-> (PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float)
-> (PdfConfiguration -> Int) -> PdfConfiguration -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PdfConfiguration -> Int
_pdfWidth
Float
h <- (PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float)
-> (PdfConfiguration -> Float)
-> StateT PdfContext (Reader PdfConfiguration) Float
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float)
-> (PdfConfiguration -> Int) -> PdfConfiguration -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PdfConfiguration -> Int
_pdfHeight
let rect :: [Primitive]
rect = Point -> Float -> Float -> [Primitive]
rectangle (Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
0 Float
0) Float
w Float
h
Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> DrawCommand px (Free (DrawCommand px) ())
-> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> DrawCommand px (Free (DrawCommand px) ())
-> PdfEnv Builder
go Bool
forceInverse Transformation
activeTrans FillMethod -> Builder
filler Texture px
prevTexture (DrawCommand px (Free (DrawCommand px) ()) -> PdfEnv Builder)
-> DrawCommand px (Free (DrawCommand px) ()) -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$
Texture px
-> Drawing px ()
-> Free (DrawCommand px) ()
-> DrawCommand px (Free (DrawCommand px) ())
forall px next.
Texture px -> Drawing px () -> next -> DrawCommand px next
SetTexture (PatchInterpolation -> MeshPatch px -> Texture px
forall px. PatchInterpolation -> MeshPatch px -> Texture px
MeshPatchTexture PatchInterpolation
i MeshPatch px
m) (DrawCommand px () -> Drawing px ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> Drawing px ())
-> DrawCommand px () -> Drawing px ()
forall a b. (a -> b) -> a -> b
$ FillMethod -> [Primitive] -> () -> DrawCommand px ()
forall px next.
FillMethod -> [Primitive] -> next -> DrawCommand px next
Fill FillMethod
FillWinding [Primitive]
rect ()) Free (DrawCommand px) ()
next
Fill FillMethod
method [Primitive]
prims Free (DrawCommand px) ()
next -> do
Builder
after <- Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ ([Primitive] -> Builder) -> [[Primitive]] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Primitive] -> Builder
pathToPdf ([Primitive] -> [[Primitive]]
resplit [Primitive]
prims)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FillMethod -> Builder
filler FillMethod
method
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
after
Stroke Float
w Join
j (Cap
c, Cap
_) [Primitive]
prims Free (DrawCommand px) ()
next -> do
Builder
after <- Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
let output :: [Primitive] -> Builder
output [Primitive]
p = [Primitive] -> Builder
pathToPdf [Primitive]
p Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Primitive] -> Builder
reClose [Primitive]
p
stroke :: Builder
stroke = case Float
w of
Float
0 -> Builder
forall a. Monoid a => a
mempty
Float
_ -> Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
w Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" w "
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Join -> Builder
lineJoinOf Join
j
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Cap -> Builder
lineCapOf Cap
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([Primitive] -> Builder) -> [[Primitive]] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Primitive] -> Builder
output ([Primitive] -> [[Primitive]]
resplit [Primitive]
prims)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
"S\n"
Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Builder
stroke Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
after
DashedStroke Float
o [Float]
pat Float
w Join
j (Cap
c, Cap
_) [Primitive]
prims Free (DrawCommand px) ()
next -> do
Builder
sub <- Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> DrawCommand px (Free (DrawCommand px) ())
-> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> DrawCommand px (Free (DrawCommand px) ())
-> PdfEnv Builder
go Bool
forceInverse Transformation
activeTrans FillMethod -> Builder
filler Texture px
prevTexture (DrawCommand px (Free (DrawCommand px) ()) -> PdfEnv Builder)
-> DrawCommand px (Free (DrawCommand px) ()) -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Float
-> Join
-> (Cap, Cap)
-> [Primitive]
-> Free (DrawCommand px) ()
-> DrawCommand px (Free (DrawCommand px) ())
forall px next.
Float
-> Join -> (Cap, Cap) -> [Primitive] -> next -> DrawCommand px next
Stroke Float
w Join
j (Cap
c, Cap
c) [Primitive]
prims (() -> Free (DrawCommand px) ()
forall (f :: * -> *) a. a -> Free f a
Pure ())
Builder
after <- Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
arrayOf ((Float -> Builder) -> [Float] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Float -> Builder
forall a. ToPdf a => a -> Builder
coords [Float]
pat)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Float -> Builder
forall a. ToPdf a => a -> Builder
toPdf Float
o Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" d "
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sub
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"[] 0 d "
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
after
where
coords :: a -> Builder
coords a
co = a -> Builder
forall a. ToPdf a => a -> Builder
toPdf a
co Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
" "
WithGlobalOpacity PixelBaseComponent px
opacity Drawing px ()
sub Free (DrawCommand px) ()
next | PixelBaseComponent px
PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px))
opacity PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px))
-> PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px))
-> Bool
forall a. Ord a => a -> a -> Bool
>= PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px))
forall a. Modulable a => a
fullValue ->
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> PdfEnv Builder
-> StateT PdfContext (Reader PdfConfiguration) (Builder -> Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Free (DrawCommand px) () -> PdfEnv Builder
recurse (Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
sub) StateT PdfContext (Reader PdfConfiguration) (Builder -> Builder)
-> PdfEnv Builder -> PdfEnv Builder
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
WithGlobalOpacity PixelBaseComponent px
opacity Drawing px ()
sub Free (DrawCommand px) ()
next -> do
(Builder, Int)
inner <- PdfEnv Builder
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int)
forall a. PdfEnv a -> PdfEnv (a, Int)
withLocalSubcontext (PdfEnv Builder
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int))
-> (Free (DrawCommand px) () -> PdfEnv Builder)
-> Free (DrawCommand px) ()
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free (DrawCommand px) () -> PdfEnv Builder
recurse (Free (DrawCommand px) ()
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int))
-> Free (DrawCommand px) ()
-> StateT PdfContext (Reader PdfConfiguration) (Builder, Int)
forall a b. (a -> b) -> a -> b
$ Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
sub
Builder
after <- Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
let alpha :: Float
alpha = PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px))
-> Float
forall n. (Integral n, Modulable n) => n -> Float
opacityToPdf PixelBaseComponent px
PixelBaseComponent (PixelBaseComponent (PixelBaseComponent px))
opacity
proxy :: Proxy px
proxy = Proxy px
forall p. Proxy p
Proxy :: Proxy px
(Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
after) (Builder -> Builder) -> PdfEnv Builder -> PdfEnv Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy px -> (Builder, Int) -> Float -> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Proxy px -> (Builder, Int) -> Float -> PdfEnv Builder
alphaLayerGenerator Proxy px
proxy (Builder, Int)
inner Float
alpha
WithImageEffect Image px -> ImageTransformer px
_f Drawing px ()
sub Free (DrawCommand px) ()
next ->
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) (Builder -> Builder -> Builder)
-> PdfEnv Builder
-> StateT PdfContext (Reader PdfConfiguration) (Builder -> Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Free (DrawCommand px) () -> PdfEnv Builder
recurse (Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
sub) StateT PdfContext (Reader PdfConfiguration) (Builder -> Builder)
-> PdfEnv Builder -> PdfEnv Builder
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
WithTransform Transformation
trans Drawing px ()
sub Free (DrawCommand px) ()
next | Bool
forceInverse -> do
Builder
after <- Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
let subTrans :: Transformation
subTrans = (Transformation
activeTrans Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Transformation
trans)
Builder
inner <- Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
goNext Bool
forceInverse Transformation
subTrans FillMethod -> Builder
filler Texture px
prevTexture (Free (DrawCommand px) () -> PdfEnv Builder)
-> Free (DrawCommand px) () -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
sub
let inv :: Builder
inv = (Transformation -> Builder) -> Maybe Transformation -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Transformation -> Builder
forall a. ToPdf a => a -> Builder
toPdf (Maybe Transformation -> Builder)
-> Maybe Transformation -> Builder
forall a b. (a -> b) -> a -> b
$ Transformation -> Maybe Transformation
inverseTransformation Transformation
trans
Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Transformation -> Builder
forall a. ToPdf a => a -> Builder
toPdf Transformation
trans Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
inner Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
inv Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
after
WithTransform Transformation
trans Drawing px ()
sub Free (DrawCommand px) ()
next -> do
Builder
after <- Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
let subTrans :: Transformation
subTrans = Transformation
activeTrans Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Transformation
trans
Builder
inner <- Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
goNext Bool
forceInverse Transformation
subTrans FillMethod -> Builder
filler Texture px
prevTexture (Free (DrawCommand px) () -> PdfEnv Builder)
-> Free (DrawCommand px) () -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
sub
Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
localGraphicState (Transformation -> Builder
forall a. ToPdf a => a -> Builder
toPdf Transformation
trans Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
inner) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
after
SetTexture Texture px
tx Drawing px ()
sub Free (DrawCommand px) ()
next -> do
Builder
innerCode <- Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
goNext Bool
forceInverse Transformation
activeTrans FillMethod -> Builder
filler Texture px
tx (Free (DrawCommand px) () -> PdfEnv Builder)
-> Free (DrawCommand px) () -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
sub
Builder
after <- Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
Either String Builder
tex <- Transformation
-> Builder -> Texture px -> PdfEnv (Either String Builder)
forall px.
PdfBaseColorable px =>
Transformation
-> Builder -> Texture px -> PdfEnv (Either String Builder)
textureToPdf Transformation
activeTrans Builder
innerCode Texture px
tx
Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ case Either String Builder
tex of
Left String
_ -> Builder
innerCode Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
after
Right Builder
texCode -> Builder -> Builder
localGraphicState Builder
texCode Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
after
WithCliping forall innerPixel. Drawing innerPixel ()
clipping Drawing px ()
sub Free (DrawCommand px) ()
next -> do
Builder
after <- Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
let draw8 :: Drawing px ()
draw8 = Drawing px ()
forall innerPixel. Drawing innerPixel ()
clipping :: Drawing px ()
localClip :: Builder -> Builder
localClip | Bool
forceInverse = Builder -> Builder
forall a. a -> a
id
| Bool
otherwise = Builder -> Builder
localGraphicState
Builder
clipPath <- Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
goNext Bool
True Transformation
activeTrans FillMethod -> Builder
clipCommandOf Texture px
prevTexture (Free (DrawCommand px) () -> PdfEnv Builder)
-> Free (DrawCommand px) () -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
draw8
Builder
drawing <- Free (DrawCommand px) () -> PdfEnv Builder
recurse (Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF Drawing px ()
sub)
Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Builder -> Builder
localClip (Builder
clipPath Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
tp ByteString
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
drawing)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
after
TextFill Point
p [TextRange px]
ranges Free (DrawCommand px) ()
next -> do
Int
dpi <- (PdfConfiguration -> Int)
-> StateT PdfContext (Reader PdfConfiguration) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PdfConfiguration -> Int
_pdfConfDpi
Builder
after <- Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
let orders :: [DrawOrder px]
orders = Int -> Texture px -> Point -> [TextRange px] -> [DrawOrder px]
forall px.
Int -> Texture px -> Point -> [TextRange px] -> [DrawOrder px]
textToDrawOrders Int
dpi Texture px
prevTexture Point
p [TextRange px]
ranges
[Builder]
textPrint <- (DrawOrder px -> PdfEnv Builder)
-> [DrawOrder px]
-> StateT PdfContext (Reader PdfConfiguration) [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Transformation -> DrawOrder px -> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Transformation -> DrawOrder px -> PdfEnv Builder
orderToPdf Transformation
activeTrans) [DrawOrder px]
orders
Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold [Builder]
textPrint Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
after
WithPathOrientation Path
path Float
base Drawing px ()
subDrawings Free (DrawCommand px) ()
next -> do
Drawing px () -> [DrawOrder px]
toOrders <- (PdfConfiguration -> Drawing px () -> [DrawOrder px])
-> StateT
PdfContext
(Reader PdfConfiguration)
(Drawing px () -> [DrawOrder px])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (\PdfConfiguration
r -> PdfConfiguration
-> forall px. PdfColorable px => Drawing px () -> [DrawOrder px]
_pdfConfToOrder PdfConfiguration
r)
let orders :: [DrawOrder px]
orders :: [DrawOrder px]
orders = Drawing px () -> [DrawOrder px]
toOrders (Drawing px () -> [DrawOrder px])
-> (DrawCommand px () -> Drawing px ())
-> DrawCommand px ()
-> [DrawOrder px]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DrawCommand px () -> Drawing px ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (DrawCommand px () -> [DrawOrder px])
-> DrawCommand px () -> [DrawOrder px]
forall a b. (a -> b) -> a -> b
$ Texture px -> Drawing px () -> () -> DrawCommand px ()
forall px next.
Texture px -> Drawing px () -> next -> DrawCommand px next
SetTexture Texture px
prevTexture Drawing px ()
subDrawings ()
drawer :: Transformation -> p -> DrawOrder px -> m ()
drawer Transformation
trans p
_ DrawOrder px
order =
([m ()] -> [m ()]) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (DrawCommand px () -> m ()
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (Transformation -> Drawing px () -> () -> DrawCommand px ()
forall px next.
Transformation -> Drawing px () -> next -> DrawCommand px next
WithTransform Transformation
trans (DrawOrder px -> Drawing px ()
forall px. DrawOrder px -> Drawing px ()
orderToDrawing DrawOrder px
order) ()) m () -> [m ()] -> [m ()]
forall a. a -> [a] -> [a]
:)
placedDrawings :: [Drawing px ()]
placedDrawings :: [Drawing px ()]
placedDrawings =
[Drawing px ()] -> [Drawing px ()]
forall a. [a] -> [a]
reverse ([Drawing px ()] -> [Drawing px ()])
-> [Drawing px ()] -> [Drawing px ()]
forall a b. (a -> b) -> a -> b
$ State [Drawing px ()] () -> [Drawing px ()] -> [Drawing px ()]
forall s a. State s a -> s -> s
execState (PathDrawer (StateT [Drawing px ()] Identity) px
-> Float
-> Float
-> Path
-> [DrawOrder px]
-> State [Drawing px ()] ()
forall (m :: * -> *) px.
Monad m =>
PathDrawer m px -> Float -> Float -> Path -> [DrawOrder px] -> m ()
drawOrdersOnPath PathDrawer (StateT [Drawing px ()] Identity) px
forall (m :: * -> *) (m :: * -> *) px p.
(MonadState [m ()] m, MonadFree (DrawCommand px) m) =>
Transformation -> p -> DrawOrder px -> m ()
drawer Float
0 Float
base Path
path [DrawOrder px]
orders) []
Builder
after <- Free (DrawCommand px) () -> PdfEnv Builder
recurse Free (DrawCommand px) ()
next
Builder
this <- Free (DrawCommand px) () -> PdfEnv Builder
recurse (Free (DrawCommand px) () -> PdfEnv Builder)
-> (Drawing px () -> Free (DrawCommand px) ())
-> Drawing px ()
-> PdfEnv Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Drawing px () -> Free (DrawCommand px) ()
forall (f :: * -> *) (m :: * -> *) a. MonadFree f m => F f a -> m a
fromF (Drawing px () -> PdfEnv Builder)
-> Drawing px () -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ [Drawing px ()] -> Drawing px ()
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold [Drawing px ()]
placedDrawings
Builder -> PdfEnv Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> PdfEnv Builder) -> Builder -> PdfEnv Builder
forall a b. (a -> b) -> a -> b
$ Builder
this Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
after
where
recurse :: Free (DrawCommand px) () -> PdfEnv Builder
recurse = Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Bool
-> Transformation
-> (FillMethod -> Builder)
-> Texture px
-> Free (DrawCommand px) ()
-> PdfEnv Builder
goNext Bool
forceInverse Transformation
activeTrans FillMethod -> Builder
filler Texture px
prevTexture
renderOrdersToPdf :: InnerRenderer -> Int -> Int -> Dpi -> [DrawOrder PixelRGBA8]
-> LB.ByteString
renderOrdersToPdf :: (forall px. PdfColorable px => Drawing px () -> [DrawOrder px])
-> Int -> Int -> Int -> [DrawOrder PixelRGBA8] -> ByteString
renderOrdersToPdf forall px. PdfColorable px => Drawing px () -> [DrawOrder px]
toOrders Int
width Int
height Int
dpi [DrawOrder PixelRGBA8]
orders =
Proxy PixelRGBA8
-> PdfConfiguration -> PdfEnv Builder -> ByteString
forall px.
PdfBaseColorable px =>
Proxy px -> PdfConfiguration -> PdfEnv Builder -> ByteString
pdfFromProducer (Proxy PixelRGBA8
forall p. Proxy p
Proxy :: Proxy PixelRGBA8) PdfConfiguration
conf (PdfEnv Builder -> ByteString) -> PdfEnv Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
[Builder] -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold ([Builder] -> Builder)
-> StateT PdfContext (Reader PdfConfiguration) [Builder]
-> PdfEnv Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DrawOrder PixelRGBA8 -> PdfEnv Builder)
-> [DrawOrder PixelRGBA8]
-> StateT PdfContext (Reader PdfConfiguration) [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Transformation -> DrawOrder PixelRGBA8 -> PdfEnv Builder
forall px.
PdfBaseColorable px =>
Transformation -> DrawOrder px -> PdfEnv Builder
orderToPdf Transformation
rootTrans) [DrawOrder PixelRGBA8]
orders
where
rootTrans :: Transformation
rootTrans = Float -> Transformation
toPdfSpace (Float -> Transformation) -> Float -> Transformation
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height
conf :: PdfConfiguration
conf = PdfConfiguration :: Int
-> Int
-> Int
-> (forall px. PdfColorable px => Drawing px () -> [DrawOrder px])
-> PdfConfiguration
PdfConfiguration
{ _pdfConfDpi :: Int
_pdfConfDpi = Int
dpi
, _pdfWidth :: Int
_pdfWidth = Int
width
, _pdfHeight :: Int
_pdfHeight = Int
height
, _pdfConfToOrder :: forall px. PdfColorable px => Drawing px () -> [DrawOrder px]
_pdfConfToOrder = forall px. PdfColorable px => Drawing px () -> [DrawOrder px]
toOrders
}
prepareObjects :: [PdfObject] -> [((PdfId, Int), B.ByteString)]
prepareObjects :: [PdfObject] -> [((Int, Int), ByteString)]
prepareObjects = (((Int, Int), ByteString) -> PdfObject -> ((Int, Int), ByteString))
-> ((Int, Int), ByteString)
-> [PdfObject]
-> [((Int, Int), ByteString)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl ((Int, Int), ByteString) -> PdfObject -> ((Int, Int), ByteString)
forall a.
((a, Int), ByteString) -> PdfObject -> ((Int, Int), ByteString)
go ((Int
0, Int
0), ByteString
pdfSignature) where
go :: ((a, Int), ByteString) -> PdfObject -> ((Int, Int), ByteString)
go ((a
_, Int
off), ByteString
prev) PdfObject
obj = ((PdfObject -> Int
_pdfId PdfObject
obj, Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
prev), Builder -> ByteString
buildToStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ PdfObject -> Builder
forall a. ToPdf a => a -> Builder
toPdf PdfObject
obj)