{-# LANGUAGE CPP                       #-}
{-# LANGUAGE DeriveDataTypeable        #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TemplateHaskell           #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TypeOperators             #-}
{-# LANGUAGE TypeSynonymInstances      #-}
{-# LANGUAGE ViewPatterns              #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Backend.Postscript
-- Copyright   :  (c) 2013 Diagrams team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- A Postscript rendering backend for diagrams.
--
-- To build diagrams for Postscript rendering use the @Postscript@
-- type in the diagram type construction
--
-- > d :: Diagram Postscript
-- > d = ...
--
-- and render giving the @Postscript@ token
--
-- > renderDia Postscript (PostscriptOptions "file.eps" (Width 400) EPS) d
--
-- This IO action will write the specified file.
--
-----------------------------------------------------------------------------
module Diagrams.Backend.Postscript

  ( -- * Backend token
    Postscript(..)
  , B

    -- * Postscript-specific options
    -- $PostscriptOptions

  , Options(..), psfileName, psSizeSpec, psOutputFormat

    -- * Postscript-supported output formats
  , OutputFormat(..)

  , renderDias
  ) where

import           Diagrams.Backend.Postscript.CMYK
import           Diagrams.Core.Compile
import qualified Graphics.Rendering.Postscript    as C

import           Diagrams.Prelude                 hiding (fillColor, view)

import           Diagrams.TwoD.Adjust             (adjustDia2D)
import           Diagrams.TwoD.Path               (Clip (Clip), getFillRule)
import           Diagrams.TwoD.Text

import           Control.Lens                     hiding (transform)
import           Control.Monad                    (when)
import qualified Control.Monad.StateStack         as SS
import           Control.Monad.Trans              (lift)
import           Data.Maybe                       (catMaybes, isJust)

import qualified Data.ByteString.Builder          as B

import qualified Data.Foldable                    as F
import           Data.Hashable                    (Hashable (..))
import           Data.Tree
import           Data.Typeable
import           GHC.Generics                     (Generic)

-- | This data declaration is simply used as a token to distinguish this rendering engine.
data Postscript = Postscript
    deriving (Postscript -> Postscript -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Postscript -> Postscript -> Bool
$c/= :: Postscript -> Postscript -> Bool
== :: Postscript -> Postscript -> Bool
$c== :: Postscript -> Postscript -> Bool
Eq,Eq Postscript
Postscript -> Postscript -> Bool
Postscript -> Postscript -> Ordering
Postscript -> Postscript -> Postscript
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Postscript -> Postscript -> Postscript
$cmin :: Postscript -> Postscript -> Postscript
max :: Postscript -> Postscript -> Postscript
$cmax :: Postscript -> Postscript -> Postscript
>= :: Postscript -> Postscript -> Bool
$c>= :: Postscript -> Postscript -> Bool
> :: Postscript -> Postscript -> Bool
$c> :: Postscript -> Postscript -> Bool
<= :: Postscript -> Postscript -> Bool
$c<= :: Postscript -> Postscript -> Bool
< :: Postscript -> Postscript -> Bool
$c< :: Postscript -> Postscript -> Bool
compare :: Postscript -> Postscript -> Ordering
$ccompare :: Postscript -> Postscript -> Ordering
Ord,ReadPrec [Postscript]
ReadPrec Postscript
Int -> ReadS Postscript
ReadS [Postscript]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Postscript]
$creadListPrec :: ReadPrec [Postscript]
readPrec :: ReadPrec Postscript
$creadPrec :: ReadPrec Postscript
readList :: ReadS [Postscript]
$creadList :: ReadS [Postscript]
readsPrec :: Int -> ReadS Postscript
$creadsPrec :: Int -> ReadS Postscript
Read,Int -> Postscript -> ShowS
[Postscript] -> ShowS
Postscript -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Postscript] -> ShowS
$cshowList :: [Postscript] -> ShowS
show :: Postscript -> String
$cshow :: Postscript -> String
showsPrec :: Int -> Postscript -> ShowS
$cshowsPrec :: Int -> Postscript -> ShowS
Show,Typeable)

type B = Postscript

type instance V Postscript = V2
type instance N Postscript = Double

-- | Postscript only supports EPS style output at the moment.  Future formats would each
--   have their own associated properties that affect the output.
data OutputFormat = EPS -- ^ Encapsulated Postscript output.
  deriving (OutputFormat -> OutputFormat -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputFormat -> OutputFormat -> Bool
$c/= :: OutputFormat -> OutputFormat -> Bool
== :: OutputFormat -> OutputFormat -> Bool
$c== :: OutputFormat -> OutputFormat -> Bool
Eq, Eq OutputFormat
OutputFormat -> OutputFormat -> Bool
OutputFormat -> OutputFormat -> Ordering
OutputFormat -> OutputFormat -> OutputFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OutputFormat -> OutputFormat -> OutputFormat
$cmin :: OutputFormat -> OutputFormat -> OutputFormat
max :: OutputFormat -> OutputFormat -> OutputFormat
$cmax :: OutputFormat -> OutputFormat -> OutputFormat
>= :: OutputFormat -> OutputFormat -> Bool
$c>= :: OutputFormat -> OutputFormat -> Bool
> :: OutputFormat -> OutputFormat -> Bool
$c> :: OutputFormat -> OutputFormat -> Bool
<= :: OutputFormat -> OutputFormat -> Bool
$c<= :: OutputFormat -> OutputFormat -> Bool
< :: OutputFormat -> OutputFormat -> Bool
$c< :: OutputFormat -> OutputFormat -> Bool
compare :: OutputFormat -> OutputFormat -> Ordering
$ccompare :: OutputFormat -> OutputFormat -> Ordering
Ord, ReadPrec [OutputFormat]
ReadPrec OutputFormat
Int -> ReadS OutputFormat
ReadS [OutputFormat]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OutputFormat]
$creadListPrec :: ReadPrec [OutputFormat]
readPrec :: ReadPrec OutputFormat
$creadPrec :: ReadPrec OutputFormat
readList :: ReadS [OutputFormat]
$creadList :: ReadS [OutputFormat]
readsPrec :: Int -> ReadS OutputFormat
$creadsPrec :: Int -> ReadS OutputFormat
Read, Int -> OutputFormat -> ShowS
[OutputFormat] -> ShowS
OutputFormat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputFormat] -> ShowS
$cshowList :: [OutputFormat] -> ShowS
show :: OutputFormat -> String
$cshow :: OutputFormat -> String
showsPrec :: Int -> OutputFormat -> ShowS
$cshowsPrec :: Int -> OutputFormat -> ShowS
Show, Int -> OutputFormat
OutputFormat -> Int
OutputFormat -> [OutputFormat]
OutputFormat -> OutputFormat
OutputFormat -> OutputFormat -> [OutputFormat]
OutputFormat -> OutputFormat -> OutputFormat -> [OutputFormat]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OutputFormat -> OutputFormat -> OutputFormat -> [OutputFormat]
$cenumFromThenTo :: OutputFormat -> OutputFormat -> OutputFormat -> [OutputFormat]
enumFromTo :: OutputFormat -> OutputFormat -> [OutputFormat]
$cenumFromTo :: OutputFormat -> OutputFormat -> [OutputFormat]
enumFromThen :: OutputFormat -> OutputFormat -> [OutputFormat]
$cenumFromThen :: OutputFormat -> OutputFormat -> [OutputFormat]
enumFrom :: OutputFormat -> [OutputFormat]
$cenumFrom :: OutputFormat -> [OutputFormat]
fromEnum :: OutputFormat -> Int
$cfromEnum :: OutputFormat -> Int
toEnum :: Int -> OutputFormat
$ctoEnum :: Int -> OutputFormat
pred :: OutputFormat -> OutputFormat
$cpred :: OutputFormat -> OutputFormat
succ :: OutputFormat -> OutputFormat
$csucc :: OutputFormat -> OutputFormat
Enum, OutputFormat
forall a. a -> a -> Bounded a
maxBound :: OutputFormat
$cmaxBound :: OutputFormat
minBound :: OutputFormat
$cminBound :: OutputFormat
Bounded, Typeable, forall x. Rep OutputFormat x -> OutputFormat
forall x. OutputFormat -> Rep OutputFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OutputFormat x -> OutputFormat
$cfrom :: forall x. OutputFormat -> Rep OutputFormat x
Generic)

instance Hashable OutputFormat

data PostscriptState
  = PostscriptState { PostscriptState -> Style V2 Double
_accumStyle :: Style V2 Double
                      -- ^ The current accumulated style.
                    , PostscriptState -> Bool
_ignoreFill :: Bool
                      -- ^ Whether or not we saw any lines in the most
                      --   recent path (as opposed to loops).  If we did,
                      --   we should ignore any fill attribute.
                      --   diagrams-lib separates lines and loops into
                      --   separate path primitives so we don't have to
                      --   worry about seeing them together in the same
                      --   path.
                    }

$(makeLenses ''PostscriptState)

instance Default PostscriptState where
   def :: PostscriptState
def = PostscriptState
         { _accumStyle :: Style V2 Double
_accumStyle = forall a. Monoid a => a
mempty
         , _ignoreFill :: Bool
_ignoreFill = Bool
False
         }

type RenderM a = SS.StateStackT PostscriptState C.Render a

liftC :: C.Render a -> RenderM a
liftC :: forall a. Render a -> RenderM a
liftC = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runRenderM :: RenderM a -> C.Render a
runRenderM :: forall a. RenderM a -> Render a
runRenderM = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateStackT s m a -> s -> m a
SS.evalStateStackT forall a. Default a => a
def

save :: RenderM ()
save :: RenderM ()
save = forall s (m :: * -> *). MonadStateStack s m => m ()
SS.save forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Render a -> RenderM a
liftC Render ()
C.save

restore :: RenderM ()
restore :: RenderM ()
restore = forall a. Render a -> RenderM a
liftC Render ()
C.restore forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *). MonadStateStack s m => m ()
SS.restore

instance Semigroup (Render Postscript V2 Double) where
  C RenderM ()
x <> :: Render Postscript V2 Double
-> Render Postscript V2 Double -> Render Postscript V2 Double
<> C RenderM ()
y = RenderM () -> Render Postscript V2 Double
C (RenderM ()
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RenderM ()
y)

instance Monoid (Render Postscript V2 Double) where
  mempty :: Render Postscript V2 Double
mempty  = RenderM () -> Render Postscript V2 Double
C forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif

instance Backend Postscript V2 Double where
  data Render  Postscript V2 Double = C (RenderM ())
  type Result  Postscript V2 Double = B.Builder
  data Options Postscript V2 Double = PostscriptOptions
          { Options Postscript V2 Double -> String
_psfileName     :: String       -- ^ the name of the file you want generated
          , Options Postscript V2 Double -> SizeSpec V2 Double
_psSizeSpec     :: SizeSpec V2 Double   -- ^ the requested size of the output
          , Options Postscript V2 Double -> OutputFormat
_psOutputFormat :: OutputFormat -- ^ the output format and associated options
          }
    deriving (Int -> Options Postscript V2 Double -> ShowS
[Options Postscript V2 Double] -> ShowS
Options Postscript V2 Double -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options Postscript V2 Double] -> ShowS
$cshowList :: [Options Postscript V2 Double] -> ShowS
show :: Options Postscript V2 Double -> String
$cshow :: Options Postscript V2 Double -> String
showsPrec :: Int -> Options Postscript V2 Double -> ShowS
$cshowsPrec :: Int -> Options Postscript V2 Double -> ShowS
Show, Options Postscript V2 Double
-> Options Postscript V2 Double -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options Postscript V2 Double
-> Options Postscript V2 Double -> Bool
$c/= :: Options Postscript V2 Double
-> Options Postscript V2 Double -> Bool
== :: Options Postscript V2 Double
-> Options Postscript V2 Double -> Bool
$c== :: Options Postscript V2 Double
-> Options Postscript V2 Double -> Bool
Eq)

  renderRTree :: Postscript
-> Options Postscript V2 Double
-> RTree Postscript V2 Double Annotation
-> Result Postscript V2 Double
renderRTree Postscript
_ Options Postscript V2 Double
opts RTree Postscript V2 Double Annotation
t =
    let surfaceF :: Surface -> Builder
surfaceF Surface
surface = forall a b. (a, b) -> a
fst (forall a. Surface -> Render a -> (Builder, a)
C.renderBuilder Surface
surface Render ()
r)
        V2 Double
w Double
h = forall (v :: * -> *) n.
(Foldable v, Functor v, Num n, Ord n) =>
n -> SizeSpec v n -> v n
specToSize Double
100 (Options Postscript V2 Double
optsforall s a. s -> Getting a s a -> a
^.Lens' (Options Postscript V2 Double) (SizeSpec V2 Double)
psSizeSpec)
        r :: Render ()
r = forall a. RenderM a -> Render a
runRenderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Render Postscript V2 Double -> RenderM ()
runC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
RTree Postscript V2 Double a -> Render Postscript V2 Double
toRender forall a b. (a -> b) -> a -> b
$ RTree Postscript V2 Double Annotation
t
    in case Options Postscript V2 Double
optsforall s a. s -> Getting a s a -> a
^.Lens' (Options Postscript V2 Double) OutputFormat
psOutputFormat of
         OutputFormat
EPS -> forall r. String -> Int -> Int -> (Surface -> r) -> r
C.withEPSSurface (Options Postscript V2 Double
optsforall s a. s -> Getting a s a -> a
^.Lens' (Options Postscript V2 Double) String
psfileName) (forall a b. (RealFrac a, Integral b) => a -> b
round Double
w) (forall a b. (RealFrac a, Integral b) => a -> b
round Double
h) Surface -> Builder
surfaceF

  adjustDia :: forall m.
(Additive V2, Monoid' m, Num Double) =>
Postscript
-> Options Postscript V2 Double
-> QDiagram Postscript V2 Double m
-> (Options Postscript V2 Double, Transformation V2 Double,
    QDiagram Postscript V2 Double m)
adjustDia = forall n m b.
(TypeableFloat n, Monoid' m) =>
Lens' (Options b V2 n) (SizeSpec V2 n)
-> b
-> Options b V2 n
-> QDiagram b V2 n m
-> (Options b V2 n, Transformation V2 n, QDiagram b V2 n m)
adjustDia2D Lens' (Options Postscript V2 Double) (SizeSpec V2 Double)
psSizeSpec

runC :: Render Postscript V2 Double -> RenderM ()
runC :: Render Postscript V2 Double -> RenderM ()
runC (C RenderM ()
r) = RenderM ()
r

-- | Get an accumulated style attribute from the render monad state.
getStyleAttrib :: AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib :: forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib a -> b
f = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
getAttr) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' PostscriptState (Style V2 Double)
accumStyle

toRender :: RTree Postscript V2 Double a -> Render Postscript V2 Double
toRender :: forall a.
RTree Postscript V2 Double a -> Render Postscript V2 Double
toRender (Node (RPrim Prim Postscript V2 Double
p) [Tree (RNode Postscript V2 Double a)]
_) = forall t b. Renderable t b => b -> t -> Render b (V t) (N t)
render Postscript
Postscript Prim Postscript V2 Double
p
toRender (Node (RStyle Style V2 Double
sty) [Tree (RNode Postscript V2 Double a)]
rs) = RenderM () -> Render Postscript V2 Double
C forall a b. (a -> b) -> a -> b
$ do
  RenderM ()
save
  forall (v :: * -> *). Style v Double -> RenderM ()
postscriptStyle Style V2 Double
sty
  Lens' PostscriptState (Style V2 Double)
accumStyle forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall a. Semigroup a => a -> a -> a
<> Style V2 Double
sty)
  Render Postscript V2 Double -> RenderM ()
runC forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap forall a.
RTree Postscript V2 Double a -> Render Postscript V2 Double
toRender [Tree (RNode Postscript V2 Double a)]
rs
  RenderM ()
restore
toRender (Node RNode Postscript V2 Double a
_ [Tree (RNode Postscript V2 Double a)]
rs) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap forall a.
RTree Postscript V2 Double a -> Render Postscript V2 Double
toRender [Tree (RNode Postscript V2 Double a)]
rs

instance Hashable (Options Postscript V2 Double) where
  hashWithSalt :: Int -> Options Postscript V2 Double -> Int
hashWithSalt Int
s (PostscriptOptions String
fn SizeSpec V2 Double
sz OutputFormat
out) =
    Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` String
fn
      forall a. Hashable a => Int -> a -> Int
`hashWithSalt` SizeSpec V2 Double
sz
      forall a. Hashable a => Int -> a -> Int
`hashWithSalt` OutputFormat
out

psfileName :: Lens' (Options Postscript V2 Double) String
psfileName :: Lens' (Options Postscript V2 Double) String
psfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(PostscriptOptions {_psfileName :: Options Postscript V2 Double -> String
_psfileName = String
f}) -> String
f)
                     (\Options Postscript V2 Double
o String
f -> Options Postscript V2 Double
o {_psfileName :: String
_psfileName = String
f})

psSizeSpec :: Lens' (Options Postscript V2 Double) (SizeSpec V2 Double)
psSizeSpec :: Lens' (Options Postscript V2 Double) (SizeSpec V2 Double)
psSizeSpec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(PostscriptOptions {_psSizeSpec :: Options Postscript V2 Double -> SizeSpec V2 Double
_psSizeSpec = SizeSpec V2 Double
s}) -> SizeSpec V2 Double
s)
                     (\Options Postscript V2 Double
o SizeSpec V2 Double
s -> Options Postscript V2 Double
o {_psSizeSpec :: SizeSpec V2 Double
_psSizeSpec = SizeSpec V2 Double
s})

psOutputFormat :: Lens' (Options Postscript V2 Double) OutputFormat
psOutputFormat :: Lens' (Options Postscript V2 Double) OutputFormat
psOutputFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(PostscriptOptions {_psOutputFormat :: Options Postscript V2 Double -> OutputFormat
_psOutputFormat = OutputFormat
t}) -> OutputFormat
t)
                     (\Options Postscript V2 Double
o OutputFormat
t -> Options Postscript V2 Double
o {_psOutputFormat :: OutputFormat
_psOutputFormat = OutputFormat
t})

renderDias :: (Semigroup m, Monoid m) =>
               Options Postscript V2 Double -> [QDiagram Postscript V2 Double m] -> IO [()]
renderDias :: forall m.
(Semigroup m, Monoid m) =>
Options Postscript V2 Double
-> [QDiagram Postscript V2 Double m] -> IO [()]
renderDias Options Postscript V2 Double
opts [QDiagram Postscript V2 Double m]
ds = case Options Postscript V2 Double
optsforall s a. s -> Getting a s a -> a
^.Lens' (Options Postscript V2 Double) OutputFormat
psOutputFormat of
  OutputFormat
EPS -> forall r. String -> Int -> Int -> (Surface -> r) -> r
C.withEPSSurface (Options Postscript V2 Double
optsforall s a. s -> Getting a s a -> a
^.Lens' (Options Postscript V2 Double) String
psfileName) (forall a b. (RealFrac a, Integral b) => a -> b
round Double
w) (forall a b. (RealFrac a, Integral b) => a -> b
round Double
h) Surface -> IO [()]
surfaceF
    where
      surfaceF :: Surface -> IO [()]
surfaceF Surface
surface  = forall (m :: * -> *) a. MonadIO m => Surface -> [Render a] -> m [a]
C.renderPagesWith Surface
surface [Render ()]
rs
      dropMid :: (a, b, b) -> (a, b)
dropMid (a
x, b
_, b
z) = (a
x,b
z)
      optsdss :: [(Options Postscript V2 Double, QDiagram Postscript V2 Double m)]
optsdss = forall a b. (a -> b) -> [a] -> [b]
map (forall {a} {b} {b}. (a, b, b) -> (a, b)
dropMid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b (v :: * -> *) n m.
(Backend b v n, Additive v, Monoid' m, Num n) =>
b
-> Options b v n
-> QDiagram b v n m
-> (Options b v n, Transformation v n, QDiagram b v n m)
adjustDia Postscript
Postscript Options Postscript V2 Double
opts) [QDiagram Postscript V2 Double m]
ds
      g2o :: Transformation V2 Double
g2o     = forall (v :: * -> *) n.
(Additive v, Fractional n) =>
n -> Transformation v n
scaling (forall a. Floating a => a -> a
sqrt (Double
w forall a. Num a => a -> a -> a
* Double
h))
      rs :: [Render ()]
rs      = forall a b. (a -> b) -> [a] -> [b]
map (forall a. RenderM a -> Render a
runRenderM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Render Postscript V2 Double -> RenderM ()
runC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
RTree Postscript V2 Double a -> Render Postscript V2 Double
toRender forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n m b.
(HasLinearMap v, Metric v, Typeable n, OrderedField n, Monoid m,
 Semigroup m) =>
Transformation v n -> QDiagram b v n m -> RTree b v n Annotation
toRTree Transformation V2 Double
g2o forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Options Postscript V2 Double, QDiagram Postscript V2 Double m)]
optsdss
      sizes :: [V2 Double]
sizes   = forall a b. (a -> b) -> [a] -> [b]
map (forall (v :: * -> *) n.
(Foldable v, Functor v, Num n, Ord n) =>
n -> SizeSpec v n -> v n
specToSize Double
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' (Options Postscript V2 Double) (SizeSpec V2 Double)
psSizeSpec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Options Postscript V2 Double, QDiagram Postscript V2 Double m)]
optsdss
      V2 Double
w Double
h  = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> a) -> a -> t a -> a
foldBy (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Ord a => a -> a -> a
max) forall (f :: * -> *) a. (Additive f, Num a) => f a
zero [V2 Double]
sizes

renderC :: (Renderable a Postscript, V a ~ V2, N a ~ Double) => a -> RenderM ()
renderC :: forall a.
(Renderable a Postscript, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC = Render Postscript V2 Double -> RenderM ()
runC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t b. Renderable t b => b -> t -> Render b (V t) (N t)
render Postscript
Postscript

-- | Handle those style attributes for which we can immediately emit
--   postscript instructions as we encounter them in the tree (clip, font
--   size, fill rule, line width, cap, join, and dashing).  Other
--   attributes (font face, slant, weight; fill color, stroke color,
--   opacity) must be accumulated.
postscriptStyle :: Style v Double -> RenderM ()
postscriptStyle :: forall (v :: * -> *). Style v Double -> RenderM ()
postscriptStyle Style v Double
s =
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ [ forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle Clip Double -> RenderM ()
clip
                , forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle FillRule -> RenderM ()
lFillRule
                , forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle LineWidth Double -> RenderM ()
lWidth
                , forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle LineJoin -> RenderM ()
lJoin
                , forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle LineMiterLimit -> RenderM ()
lMiter
                , forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle LineCap -> RenderM ()
lCap
                , forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle Dashing Double -> RenderM ()
lDashing
                ]
  where
    handle :: AttributeClass a => (a -> RenderM ()) -> Maybe (RenderM ())
    handle :: forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle a -> RenderM ()
f = a -> RenderM ()
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
getAttr Style v Double
s
    clip :: Clip Double -> RenderM ()
clip     = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Path V2 Double
p -> Path V2 Double -> RenderM ()
postscriptPath Path V2 Double
p forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Render a -> RenderM a
liftC Render ()
C.clip) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op forall n. [Path V2 n] -> Clip n
Clip
    lFillRule :: FillRule -> RenderM ()
lFillRule = forall a. Render a -> RenderM a
liftC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' RenderState DrawState
C.drawState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DrawState FillRule
C.fillRule) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FillRule -> FillRule
getFillRule
    lWidth :: LineWidth Double -> RenderM ()
lWidth = forall a. Render a -> RenderM a
liftC forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Render ()
C.lineWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. LineWidth n -> n
getLineWidth
    lCap :: LineCap -> RenderM ()
lCap = forall a. Render a -> RenderM a
liftC forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCap -> Render ()
C.lineCap forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCap -> LineCap
getLineCap
    lJoin :: LineJoin -> RenderM ()
lJoin = forall a. Render a -> RenderM a
liftC forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> Render ()
C.lineJoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> LineJoin
getLineJoin
    lMiter :: LineMiterLimit -> RenderM ()
lMiter = forall a. Render a -> RenderM a
liftC forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Render ()
C.miterLimit forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineMiterLimit -> Double
getLineMiterLimit
    lDashing :: Dashing Double -> RenderM ()
lDashing (forall n. Dashing n -> Dashing n
getDashing -> Dashing [Double]
ds Double
offs) = forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ [Double] -> Double -> Render ()
C.setDash [Double]
ds Double
offs

fromFontSlant :: FontSlant -> C.FontSlant
fromFontSlant :: FontSlant -> FontSlant
fromFontSlant FontSlant
FontSlantNormal   = FontSlant
C.FontSlantNormal
fromFontSlant FontSlant
FontSlantItalic   = FontSlant
C.FontSlantItalic
fromFontSlant FontSlant
FontSlantOblique  = FontSlant
C.FontSlantOblique

fromFontWeight :: FontWeight -> C.FontWeight
fromFontWeight :: FontWeight -> FontWeight
fromFontWeight FontWeight
FontWeightNormal = FontWeight
C.FontWeightNormal
fromFontWeight FontWeight
FontWeightBold   = FontWeight
C.FontWeightBold
fromFontWeight FontWeight
_                = FontWeight
C.FontWeightNormal

postscriptTransf :: Transformation V2 Double -> C.Render ()
postscriptTransf :: Transformation V2 Double -> Render ()
postscriptTransf Transformation V2 Double
t = Double
-> Double -> Double -> Double -> Double -> Double -> Render ()
C.transform Double
a1 Double
a2 Double
b1 Double
b2 Double
c1 Double
c2
  where (V2 Double
a1 Double
a2) = forall (v :: * -> *) n. Transformation v n -> v n -> v n
apply Transformation V2 Double
t forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX
        (V2 Double
b1 Double
b2) = forall (v :: * -> *) n. Transformation v n -> v n -> v n
apply Transformation V2 Double
t forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY
        (V2 Double
c1 Double
c2) = forall (v :: * -> *) n. Transformation v n -> v n
transl Transformation V2 Double
t

instance Renderable (Segment Closed V2 Double) Postscript where
  render :: Postscript
-> Segment Closed V2 Double
-> Render
     Postscript
     (V (Segment Closed V2 Double))
     (N (Segment Closed V2 Double))
render Postscript
_ (Linear (OffsetClosed V2 Double
v)) = RenderM () -> Render Postscript V2 Double
C forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Render ()
C.relLineTo (forall n. V2 n -> (n, n)
unr2 V2 Double
v)
  render Postscript
_ (Cubic (forall n. V2 n -> (n, n)
unr2 -> (Double
x1, Double
y1))
                  (forall n. V2 n -> (n, n)
unr2 -> (Double
x2, Double
y2))
                  (OffsetClosed (forall n. V2 n -> (n, n)
unr2 -> (Double
x3, Double
y3))))
    = RenderM () -> Render Postscript V2 Double
C forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ Double
-> Double -> Double -> Double -> Double -> Double -> Render ()
C.relCurveTo Double
x1 Double
y1 Double
x2 Double
y2 Double
x3 Double
y3

instance Renderable (Trail V2 Double) Postscript where
  render :: Postscript
-> Trail V2 Double
-> Render Postscript (V (Trail V2 Double)) (N (Trail V2 Double))
render Postscript
_ = forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail Trail' Line V2 Double -> Render Postscript V2 Double
renderLine Trail' Loop V2 Double -> Render Postscript V2 Double
renderLoop
    where
      renderLine :: Trail' Line V2 Double -> Render Postscript V2 Double
renderLine Trail' Line V2 Double
ln = RenderM () -> Render Postscript V2 Double
C forall a b. (a -> b) -> a -> b
$ do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a.
(Renderable a Postscript, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC (forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments Trail' Line V2 Double
ln)

        -- remember that we saw a Line, so we will ignore fill attribute
        Lens' PostscriptState Bool
ignoreFill forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True

      renderLoop :: Trail' Loop V2 Double -> Render Postscript V2 Double
renderLoop Trail' Loop V2 Double
lp = RenderM () -> Render Postscript V2 Double
C forall a b. (a -> b) -> a -> b
$ do
        case forall (v :: * -> *) n.
Trail' Loop v n -> ([Segment Closed v n], Segment Open v n)
loopSegments Trail' Loop V2 Double
lp of
          -- let closePath handle the last segment if it is linear
          ([Segment Closed V2 Double]
segs, Linear Offset Open V2 Double
_) -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a.
(Renderable a Postscript, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC [Segment Closed V2 Double]
segs

          -- otherwise we have to draw it explicitly
          ([Segment Closed V2 Double], Segment Open V2 Double)
_ -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a.
(Renderable a Postscript, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC (forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop forall a b. (a -> b) -> a -> b
$ Trail' Loop V2 Double
lp)

        forall a. Render a -> RenderM a
liftC Render ()
C.closePath

instance Renderable (Path V2 Double) Postscript where
  render :: Postscript
-> Path V2 Double
-> Render Postscript (V (Path V2 Double)) (N (Path V2 Double))
render Postscript
_ Path V2 Double
p = RenderM () -> Render Postscript V2 Double
C forall a b. (a -> b) -> a -> b
$ do
      Path V2 Double -> RenderM ()
postscriptPath Path V2 Double
p
      Maybe (Texture Double)
f <- forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib forall n. FillTexture n -> Texture n
getFillTexture
      Maybe (Texture Double)
s <- forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib forall n. LineTexture n -> Texture n
getLineTexture
      Maybe CMYK
fk <- forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib FillColorCMYK -> CMYK
getFillColorCMYK
      Maybe CMYK
sk <- forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib LineColorCMYK -> CMYK
getLineColorCMYK
      Bool
ign <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' PostscriptState Bool
ignoreFill
      Maybe (Texture Double) -> Maybe CMYK -> RenderM ()
setFillColor Maybe (Texture Double)
f Maybe CMYK
fk
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((forall a. Maybe a -> Bool
isJust Maybe (Texture Double)
f Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe CMYK
fk) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ign) forall a b. (a -> b) -> a -> b
$ forall a. Render a -> RenderM a
liftC Render ()
C.fillPreserve
      Maybe (Texture Double) -> Maybe CMYK -> RenderM ()
setStrokeColor Maybe (Texture Double)
s Maybe CMYK
sk
      forall a. Render a -> RenderM a
liftC Render ()
C.stroke

setFillColor :: Maybe (Texture Double) -> Maybe (CMYK) -> RenderM ()
setFillColor :: Maybe (Texture Double) -> Maybe CMYK -> RenderM ()
setFillColor Maybe (Texture Double)
c Maybe CMYK
cmyk = do
    forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall n. Texture n -> Render ()
C.fillColor Maybe (Texture Double)
c
    forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) CMYK -> Render ()
C.fillColorCMYK Maybe CMYK
cmyk

setStrokeColor :: Maybe (Texture Double) -> Maybe (CMYK) -> RenderM ()
setStrokeColor :: Maybe (Texture Double) -> Maybe CMYK -> RenderM ()
setStrokeColor Maybe (Texture Double)
c Maybe CMYK
cmyk = do
    forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall n. Texture n -> Render ()
C.strokeColor Maybe (Texture Double)
c
    forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) CMYK -> Render ()
C.strokeColorCMYK Maybe CMYK
cmyk

postscriptPath :: Path V2 Double -> RenderM ()
postscriptPath :: Path V2 Double -> RenderM ()
postscriptPath (Path [Located (Trail V2 Double)]
trs) = do
      forall a. Render a -> RenderM a
liftC Render ()
C.newPath
      Lens' PostscriptState Bool
ignoreFill forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ forall {a}.
(V a ~ V2, N a ~ Double, Renderable a Postscript) =>
Located a -> RenderM ()
renderTrail [Located (Trail V2 Double)]
trs
    where renderTrail :: Located a -> RenderM ()
renderTrail (forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (forall n. P2 n -> (n, n)
unp2 -> (Double, Double)
pt, a
tr)) = do
            forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Render ()
C.moveTo (Double, Double)
pt
            forall a.
(Renderable a Postscript, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC a
tr

if' :: Monad m => (a -> m ()) -> Maybe a -> m ()
if' :: forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
if' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ())

instance Renderable (Text Double) Postscript where
  render :: Postscript
-> Text Double
-> Render Postscript (V (Text Double)) (N (Text Double))
render Postscript
_ (Text Transformation V2 Double
tr TextAlignment Double
al String
str) = RenderM () -> Render Postscript V2 Double
C forall a b. (a -> b) -> a -> b
$ do
      Maybe String
ff <- forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib Font -> String
getFont
      Maybe FontSlant
fs <- forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib (FontSlant -> FontSlant
fromFontSlant forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSlant -> FontSlant
getFontSlant)
      Maybe FontWeight
fw <- forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib (FontWeight -> FontWeight
fromFontWeight forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontWeight -> FontWeight
getFontWeight)
      Maybe Double
size' <- forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib forall n. FontSize n -> n
getFontSize
      Maybe (Texture Double)
f <- forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib forall n. FillTexture n -> Texture n
getFillTexture
      Maybe CMYK
fk <- forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib FillColorCMYK -> CMYK
getFillColorCMYK
      RenderM ()
save
      Maybe (Texture Double) -> Maybe CMYK -> RenderM ()
setFillColor Maybe (Texture Double)
f Maybe CMYK
fk
      forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
if' (forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' RenderState DrawState
C.drawState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DrawState PostscriptFont
C.font forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PostscriptFont Double
C.size))   Maybe Double
size'
        forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
if' (forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' RenderState DrawState
C.drawState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DrawState PostscriptFont
C.font forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PostscriptFont String
C.face))   Maybe String
ff
        forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
if' (forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' RenderState DrawState
C.drawState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DrawState PostscriptFont
C.font forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PostscriptFont FontSlant
C.slant))  Maybe FontSlant
fs
        forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
if' (forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (Lens' RenderState DrawState
C.drawState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' DrawState PostscriptFont
C.font forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' PostscriptFont FontWeight
C.weight)) Maybe FontWeight
fw
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (Texture Double)
f Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe CMYK
fk) forall a b. (a -> b) -> a -> b
$ forall a. Render a -> RenderM a
liftC Render ()
C.fillPreserve
      forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ Transformation V2 Double -> Render ()
postscriptTransf Transformation V2 Double
tr
      case TextAlignment Double
al of
        BoxAlignedText Double
xt Double
yt -> forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ Double -> Double -> String -> Render ()
C.showTextAlign Double
xt Double
yt String
str
        TextAlignment Double
BaselineText         -> forall a. Render a -> RenderM a
liftC forall a b. (a -> b) -> a -> b
$ Double -> Double -> Render ()
C.moveTo Double
0 Double
0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Render ()
C.showText String
str
      RenderM ()
restore

-- $PostscriptOptions
--
-- Unfortunately, Haddock does not yet support documentation for
-- associated data families, so we must just provide it manually.
-- This module defines
--
-- > data family Options Postscript V2 Double = PostscriptOptions
-- >           { _psfileName     :: String             -- ^ the name of the file you want generated
-- >           , _psSizeSpec     :: SizeSpec V2 Double -- ^ the requested size of the output
-- >           , _psOutputFormat :: OutputFormat        -- ^ the output format and associated options
-- >           }