{-# 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
{-import Debug.Trace-}

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
    {-
     * Linear gradients are othrogonal to the line passing through
     * their extremes. Because of convexity, the parameter range can
     * be computed as the convex hull (one the real line) of the
     * parameter values of the 4 corners of the box.
     *
     * The parameter value t for a point (x,y) can be computed as:
     *
     *   t = (p2 - p1) . (x,y) / |p2 - p1|^2
     *
     * t0  is the t value for the top left corner
     * tdx is the difference between left and right corners
     * tdy is the difference between top and bottom corners
     -}
    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)

--------------------------------------------------

----       Monadic generation types

--------------------------------------------------

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

{-nameShadingObject :: PdfId -> PdfEnv Builder-}
{-nameShadingObject = nameObject "Sh" pdfShadings . 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
        }



--------------------------------------------------

----            ToPdf class & instances

--------------------------------------------------

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

--------------------------------------------------

----            Helper functions

--------------------------------------------------

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
  }

--------------------------------------------------

----            PDF object helper

--------------------------------------------------

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"

{-  
+------------+
| Color   {c}|<---------\
| interp n   |          |
+------------+          |
                        |
   * * *                |
                        |
+------------+        +-+---------+    +------------+    +------------+     /-------------\
| Color   {c}|<-------+ Stitching |<---+ Repeat  {c}|<---+ Gradient   |<----+ Page     {r}|
| interp n   |        | fun    {c}|    | function   |    |         {c}|     | resources   |
+------------+        +-----------+    +------------+    +------------+     \-----+-------/
                                                                                  |
                                                                                  v
           Gradient with alpha PDF generation                               +-------------+
           (yes this is quite complex)                                      | ExtGState   |
                                                                            | SMask    {a}|
                                                                            +-----+-------+
                                                                                  |
                                                                                  v
                                                                            +-------------+
                                                                            | Mask        |
                                                                            |          {a}|
                                                                            +-----+-------+
                                                                                  |
                                                                                  v
+------------+        +-----------+    +------------+    +------------+     +--------------+
| Color   {a}|<-------+ Stitching |<---+ Repeat  {a}|<---+ Gradient   |<----+ Form with    |
| interp 0   |        | fun    {a}|    | function   |    |         {a}|     | transparency |
+------------+        +-+---------+    +------------+    +------------+     | group     {a}|
                        |                                                   +--------------+
   * * *                |
                        |
+------------+          |
| Color   {a}|<---------/
| interp n   |
+------------+

::: .a { fill: white; }
::: .r { fill: rgb(128, 200, 128); }
-}
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 -- . removeDegeneratePrimitive

      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
" "
     
     -- Opacity is ignored for now

     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)