{-# LANGUAGE CPP                       #-}
{-# LANGUAGE DeriveDataTypeable        #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TemplateHaskell           #-}
{-# LANGUAGE TypeFamilies              #-}
{-# 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
(Postscript -> Postscript -> Bool)
-> (Postscript -> Postscript -> Bool) -> Eq Postscript
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
Eq Postscript
-> (Postscript -> Postscript -> Ordering)
-> (Postscript -> Postscript -> Bool)
-> (Postscript -> Postscript -> Bool)
-> (Postscript -> Postscript -> Bool)
-> (Postscript -> Postscript -> Bool)
-> (Postscript -> Postscript -> Postscript)
-> (Postscript -> Postscript -> Postscript)
-> Ord 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
$cp1Ord :: Eq Postscript
Ord,ReadPrec [Postscript]
ReadPrec Postscript
Int -> ReadS Postscript
ReadS [Postscript]
(Int -> ReadS Postscript)
-> ReadS [Postscript]
-> ReadPrec Postscript
-> ReadPrec [Postscript]
-> Read 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
(Int -> Postscript -> ShowS)
-> (Postscript -> String)
-> ([Postscript] -> ShowS)
-> Show Postscript
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
(OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool) -> Eq OutputFormat
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
Eq OutputFormat
-> (OutputFormat -> OutputFormat -> Ordering)
-> (OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> OutputFormat)
-> (OutputFormat -> OutputFormat -> OutputFormat)
-> Ord 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
$cp1Ord :: Eq OutputFormat
Ord, ReadPrec [OutputFormat]
ReadPrec OutputFormat
Int -> ReadS OutputFormat
ReadS [OutputFormat]
(Int -> ReadS OutputFormat)
-> ReadS [OutputFormat]
-> ReadPrec OutputFormat
-> ReadPrec [OutputFormat]
-> Read 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
(Int -> OutputFormat -> ShowS)
-> (OutputFormat -> String)
-> ([OutputFormat] -> ShowS)
-> Show OutputFormat
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]
(OutputFormat -> OutputFormat)
-> (OutputFormat -> OutputFormat)
-> (Int -> OutputFormat)
-> (OutputFormat -> Int)
-> (OutputFormat -> [OutputFormat])
-> (OutputFormat -> OutputFormat -> [OutputFormat])
-> (OutputFormat -> OutputFormat -> [OutputFormat])
-> (OutputFormat -> OutputFormat -> OutputFormat -> [OutputFormat])
-> Enum 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
OutputFormat -> OutputFormat -> Bounded OutputFormat
forall a. a -> a -> Bounded a
maxBound :: OutputFormat
$cmaxBound :: OutputFormat
minBound :: OutputFormat
$cminBound :: OutputFormat
Bounded, Typeable, (forall x. OutputFormat -> Rep OutputFormat x)
-> (forall x. Rep OutputFormat x -> OutputFormat)
-> Generic OutputFormat
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 :: Style V2 Double -> Bool -> PostscriptState
PostscriptState
         { _accumStyle :: Style V2 Double
_accumStyle = Style V2 Double
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 :: Render a -> RenderM a
liftC = Render a -> RenderM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

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

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

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

instance Semigroup (Render Postscript V2 Double) where
  C x <> :: Render Postscript V2 Double
-> Render Postscript V2 Double -> Render Postscript V2 Double
<> C y = RenderM () -> Render Postscript V2 Double
C (RenderM ()
x RenderM () -> RenderM () -> RenderM ()
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 (RenderM () -> Render Postscript V2 Double)
-> RenderM () -> Render Postscript V2 Double
forall a b. (a -> b) -> a -> b
$ () -> RenderM ()
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
(Int -> Options Postscript V2 Double -> ShowS)
-> (Options Postscript V2 Double -> String)
-> ([Options Postscript V2 Double] -> ShowS)
-> Show (Options Postscript V2 Double)
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
(Options Postscript V2 Double
 -> Options Postscript V2 Double -> Bool)
-> (Options Postscript V2 Double
    -> Options Postscript V2 Double -> Bool)
-> Eq (Options Postscript V2 Double)
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 = (Builder, ()) -> Builder
forall a b. (a, b) -> a
fst (Surface -> Render () -> (Builder, ())
forall a. Surface -> Render a -> (Builder, a)
C.renderBuilder Surface
surface Render ()
r)
        V2 Double
w Double
h = Double -> SizeSpec V2 Double -> V2 Double
forall (v :: * -> *) n.
(Foldable v, Functor v, Num n, Ord n) =>
n -> SizeSpec v n -> v n
specToSize Double
100 (Options Postscript V2 Double
optsOptions Postscript V2 Double
-> Getting
     (SizeSpec V2 Double)
     (Options Postscript V2 Double)
     (SizeSpec V2 Double)
-> SizeSpec V2 Double
forall s a. s -> Getting a s a -> a
^.Getting
  (SizeSpec V2 Double)
  (Options Postscript V2 Double)
  (SizeSpec V2 Double)
Lens' (Options Postscript V2 Double) (SizeSpec V2 Double)
psSizeSpec)
        r :: Render ()
r = RenderM () -> Render ()
forall a. RenderM a -> Render a
runRenderM (RenderM () -> Render ())
-> (RTree Postscript V2 Double Annotation -> RenderM ())
-> RTree Postscript V2 Double Annotation
-> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Render Postscript V2 Double -> RenderM ()
runC (Render Postscript V2 Double -> RenderM ())
-> (RTree Postscript V2 Double Annotation
    -> Render Postscript V2 Double)
-> RTree Postscript V2 Double Annotation
-> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTree Postscript V2 Double Annotation
-> Render Postscript V2 Double
forall a.
RTree Postscript V2 Double a -> Render Postscript V2 Double
toRender (RTree Postscript V2 Double Annotation -> Render ())
-> RTree Postscript V2 Double Annotation -> Render ()
forall a b. (a -> b) -> a -> b
$ RTree Postscript V2 Double Annotation
t
    in case Options Postscript V2 Double
optsOptions Postscript V2 Double
-> Getting OutputFormat (Options Postscript V2 Double) OutputFormat
-> OutputFormat
forall s a. s -> Getting a s a -> a
^.Getting OutputFormat (Options Postscript V2 Double) OutputFormat
Lens' (Options Postscript V2 Double) OutputFormat
psOutputFormat of
         OutputFormat
EPS -> String -> Int -> Int -> (Surface -> Builder) -> Builder
forall r. String -> Int -> Int -> (Surface -> r) -> r
C.withEPSSurface (Options Postscript V2 Double
optsOptions Postscript V2 Double
-> Getting String (Options Postscript V2 Double) String -> String
forall s a. s -> Getting a s a -> a
^.Getting String (Options Postscript V2 Double) String
Lens' (Options Postscript V2 Double) String
psfileName) (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
w) (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
h) Surface -> Builder
surfaceF

  adjustDia :: Postscript
-> Options Postscript V2 Double
-> QDiagram Postscript V2 Double m
-> (Options Postscript V2 Double, Transformation V2 Double,
    QDiagram Postscript V2 Double m)
adjustDia = Lens' (Options Postscript V2 Double) (SizeSpec V2 Double)
-> Postscript
-> Options Postscript V2 Double
-> QDiagram Postscript V2 Double m
-> (Options Postscript V2 Double, Transformation V2 Double,
    QDiagram Postscript V2 Double m)
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 r) = RenderM ()
r

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

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

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

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

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

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

renderDias :: (Semigroup m, Monoid m) =>
               Options Postscript V2 Double -> [QDiagram Postscript V2 Double m] -> IO [()]
renderDias :: 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
optsOptions Postscript V2 Double
-> Getting OutputFormat (Options Postscript V2 Double) OutputFormat
-> OutputFormat
forall s a. s -> Getting a s a -> a
^.Getting OutputFormat (Options Postscript V2 Double) OutputFormat
Lens' (Options Postscript V2 Double) OutputFormat
psOutputFormat of
  OutputFormat
EPS -> String -> Int -> Int -> (Surface -> IO [()]) -> IO [()]
forall r. String -> Int -> Int -> (Surface -> r) -> r
C.withEPSSurface (Options Postscript V2 Double
optsOptions Postscript V2 Double
-> Getting String (Options Postscript V2 Double) String -> String
forall s a. s -> Getting a s a -> a
^.Getting String (Options Postscript V2 Double) String
Lens' (Options Postscript V2 Double) String
psfileName) (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
w) (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
h) Surface -> IO [()]
surfaceF
    where
      surfaceF :: Surface -> IO [()]
surfaceF Surface
surface  = Surface -> [Render ()] -> IO [()]
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 = (QDiagram Postscript V2 Double m
 -> (Options Postscript V2 Double, QDiagram Postscript V2 Double m))
-> [QDiagram Postscript V2 Double m]
-> [(Options Postscript V2 Double,
     QDiagram Postscript V2 Double m)]
forall a b. (a -> b) -> [a] -> [b]
map ((Options Postscript V2 Double, Transformation V2 Double,
 QDiagram Postscript V2 Double m)
-> (Options Postscript V2 Double, QDiagram Postscript V2 Double m)
forall a b b. (a, b, b) -> (a, b)
dropMid ((Options Postscript V2 Double, Transformation V2 Double,
  QDiagram Postscript V2 Double m)
 -> (Options Postscript V2 Double, QDiagram Postscript V2 Double m))
-> (QDiagram Postscript V2 Double m
    -> (Options Postscript V2 Double, Transformation V2 Double,
        QDiagram Postscript V2 Double m))
-> QDiagram Postscript V2 Double m
-> (Options Postscript V2 Double, QDiagram Postscript V2 Double m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Postscript
-> Options Postscript V2 Double
-> QDiagram Postscript V2 Double m
-> (Options Postscript V2 Double, Transformation V2 Double,
    QDiagram Postscript V2 Double m)
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     = Double -> Transformation V2 Double
forall (v :: * -> *) n.
(Additive v, Fractional n) =>
n -> Transformation v n
scaling (Double -> Double
forall a. Floating a => a -> a
sqrt (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
h))
      rs :: [Render ()]
rs      = ((Options Postscript V2 Double, QDiagram Postscript V2 Double m)
 -> Render ())
-> [(Options Postscript V2 Double,
     QDiagram Postscript V2 Double m)]
-> [Render ()]
forall a b. (a -> b) -> [a] -> [b]
map (RenderM () -> Render ()
forall a. RenderM a -> Render a
runRenderM (RenderM () -> Render ())
-> ((Options Postscript V2 Double, QDiagram Postscript V2 Double m)
    -> RenderM ())
-> (Options Postscript V2 Double, QDiagram Postscript V2 Double m)
-> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Render Postscript V2 Double -> RenderM ()
runC (Render Postscript V2 Double -> RenderM ())
-> ((Options Postscript V2 Double, QDiagram Postscript V2 Double m)
    -> Render Postscript V2 Double)
-> (Options Postscript V2 Double, QDiagram Postscript V2 Double m)
-> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTree Postscript V2 Double Annotation
-> Render Postscript V2 Double
forall a.
RTree Postscript V2 Double a -> Render Postscript V2 Double
toRender (RTree Postscript V2 Double Annotation
 -> Render Postscript V2 Double)
-> ((Options Postscript V2 Double, QDiagram Postscript V2 Double m)
    -> RTree Postscript V2 Double Annotation)
-> (Options Postscript V2 Double, QDiagram Postscript V2 Double m)
-> Render Postscript V2 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation V2 Double
-> QDiagram Postscript V2 Double m
-> RTree Postscript V2 Double Annotation
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 (QDiagram Postscript V2 Double m
 -> RTree Postscript V2 Double Annotation)
-> ((Options Postscript V2 Double, QDiagram Postscript V2 Double m)
    -> QDiagram Postscript V2 Double m)
-> (Options Postscript V2 Double, QDiagram Postscript V2 Double m)
-> RTree Postscript V2 Double Annotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Options Postscript V2 Double, QDiagram Postscript V2 Double m)
-> QDiagram Postscript V2 Double m
forall a b. (a, b) -> b
snd) [(Options Postscript V2 Double, QDiagram Postscript V2 Double m)]
optsdss
      sizes :: [V2 Double]
sizes   = ((Options Postscript V2 Double, QDiagram Postscript V2 Double m)
 -> V2 Double)
-> [(Options Postscript V2 Double,
     QDiagram Postscript V2 Double m)]
-> [V2 Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> SizeSpec V2 Double -> V2 Double
forall (v :: * -> *) n.
(Foldable v, Functor v, Num n, Ord n) =>
n -> SizeSpec v n -> v n
specToSize Double
1 (SizeSpec V2 Double -> V2 Double)
-> ((Options Postscript V2 Double, QDiagram Postscript V2 Double m)
    -> SizeSpec V2 Double)
-> (Options Postscript V2 Double, QDiagram Postscript V2 Double m)
-> V2 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (SizeSpec V2 Double)
  (Options Postscript V2 Double)
  (SizeSpec V2 Double)
-> Options Postscript V2 Double -> SizeSpec V2 Double
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (SizeSpec V2 Double)
  (Options Postscript V2 Double)
  (SizeSpec V2 Double)
Lens' (Options Postscript V2 Double) (SizeSpec V2 Double)
psSizeSpec (Options Postscript V2 Double -> SizeSpec V2 Double)
-> ((Options Postscript V2 Double, QDiagram Postscript V2 Double m)
    -> Options Postscript V2 Double)
-> (Options Postscript V2 Double, QDiagram Postscript V2 Double m)
-> SizeSpec V2 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Options Postscript V2 Double, QDiagram Postscript V2 Double m)
-> Options Postscript V2 Double
forall a b. (a, b) -> a
fst) [(Options Postscript V2 Double, QDiagram Postscript V2 Double m)]
optsdss
      V2 Double
w Double
h  = (V2 Double -> V2 Double -> V2 Double)
-> V2 Double -> [V2 Double] -> V2 Double
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> a) -> a -> t a -> a
foldBy ((Double -> Double -> Double) -> V2 Double -> V2 Double -> V2 Double
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Double -> Double -> Double
forall a. Ord a => a -> a -> a
max) V2 Double
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 :: a -> RenderM ()
renderC = Render Postscript V2 Double -> RenderM ()
runC (Render Postscript V2 Double -> RenderM ())
-> (a -> Render Postscript V2 Double) -> a -> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Postscript -> a -> Render Postscript (V a) (N a)
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 :: Style v Double -> RenderM ()
postscriptStyle Style v Double
s =
  [RenderM ()] -> RenderM ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
  ([RenderM ()] -> RenderM ())
-> ([Maybe (RenderM ())] -> [RenderM ()])
-> [Maybe (RenderM ())]
-> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (RenderM ())] -> [RenderM ()]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (RenderM ())] -> RenderM ())
-> [Maybe (RenderM ())] -> RenderM ()
forall a b. (a -> b) -> a -> b
$ [ (Clip Double -> RenderM ()) -> Maybe (RenderM ())
forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle Clip Double -> RenderM ()
clip
                , (FillRule -> RenderM ()) -> Maybe (RenderM ())
forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle FillRule -> RenderM ()
lFillRule
                , (LineWidth Double -> RenderM ()) -> Maybe (RenderM ())
forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle LineWidth Double -> RenderM ()
lWidth
                , (LineJoin -> RenderM ()) -> Maybe (RenderM ())
forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle LineJoin -> RenderM ()
lJoin
                , (LineMiterLimit -> RenderM ()) -> Maybe (RenderM ())
forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle LineMiterLimit -> RenderM ()
lMiter
                , (LineCap -> RenderM ()) -> Maybe (RenderM ())
forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle LineCap -> RenderM ()
lCap
                , (Dashing Double -> RenderM ()) -> Maybe (RenderM ())
forall a.
AttributeClass a =>
(a -> RenderM ()) -> Maybe (RenderM ())
handle Dashing Double -> RenderM ()
lDashing
                ]
  where
    handle :: AttributeClass a => (a -> RenderM ()) -> Maybe (RenderM ())
    handle :: (a -> RenderM ()) -> Maybe (RenderM ())
handle a -> RenderM ()
f = a -> RenderM ()
f (a -> RenderM ()) -> Maybe a -> Maybe (RenderM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Style v Double -> Maybe a
forall a (v :: * -> *) n. AttributeClass a => Style v n -> Maybe a
getAttr Style v Double
s
    clip :: Clip Double -> RenderM ()
clip     = (Path V2 Double -> RenderM ()) -> [Path V2 Double] -> RenderM ()
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 RenderM () -> RenderM () -> RenderM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC Render ()
C.clip) ([Path V2 Double] -> RenderM ())
-> (Clip Double -> [Path V2 Double]) -> Clip Double -> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped (Clip Double) -> Clip Double)
-> Clip Double -> Unwrapped (Clip Double)
forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op Unwrapped (Clip Double) -> Clip Double
forall n. [Path V2 n] -> Clip n
Clip
    lFillRule :: FillRule -> RenderM ()
lFillRule = Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ())
-> (FillRule -> Render ()) -> FillRule -> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter RenderState RenderState FillRule FillRule
-> FillRule -> Render ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((DrawState -> Identity DrawState)
-> RenderState -> Identity RenderState
Lens' RenderState DrawState
C.drawState ((DrawState -> Identity DrawState)
 -> RenderState -> Identity RenderState)
-> ((FillRule -> Identity FillRule)
    -> DrawState -> Identity DrawState)
-> ASetter RenderState RenderState FillRule FillRule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FillRule -> Identity FillRule) -> DrawState -> Identity DrawState
Lens' DrawState FillRule
C.fillRule) (FillRule -> Render ())
-> (FillRule -> FillRule) -> FillRule -> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FillRule -> FillRule
getFillRule
    lWidth :: LineWidth Double -> RenderM ()
lWidth = Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ())
-> (LineWidth Double -> Render ())
-> LineWidth Double
-> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Render ()
C.lineWidth (Double -> Render ())
-> (LineWidth Double -> Double) -> LineWidth Double -> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineWidth Double -> Double
forall n. LineWidth n -> n
getLineWidth
    lCap :: LineCap -> RenderM ()
lCap = Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ())
-> (LineCap -> Render ()) -> LineCap -> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCap -> Render ()
C.lineCap (LineCap -> Render ())
-> (LineCap -> LineCap) -> LineCap -> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineCap -> LineCap
getLineCap
    lJoin :: LineJoin -> RenderM ()
lJoin = Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ())
-> (LineJoin -> Render ()) -> LineJoin -> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> Render ()
C.lineJoin (LineJoin -> Render ())
-> (LineJoin -> LineJoin) -> LineJoin -> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineJoin -> LineJoin
getLineJoin
    lMiter :: LineMiterLimit -> RenderM ()
lMiter = Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ())
-> (LineMiterLimit -> Render ()) -> LineMiterLimit -> RenderM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Render ()
C.miterLimit (Double -> Render ())
-> (LineMiterLimit -> Double) -> LineMiterLimit -> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineMiterLimit -> Double
getLineMiterLimit
    lDashing :: Dashing Double -> RenderM ()
lDashing (Dashing Double -> Dashing Double
forall n. Dashing n -> Dashing n
getDashing -> Dashing [Double]
ds Double
offs) = Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
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) = Transformation V2 Double -> V2 Double -> V2 Double
forall (v :: * -> *) n. Transformation v n -> v n -> v n
apply Transformation V2 Double
t V2 Double
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX
        (V2 Double
b1 Double
b2) = Transformation V2 Double -> V2 Double -> V2 Double
forall (v :: * -> *) n. Transformation v n -> v n -> v n
apply Transformation V2 Double
t V2 Double
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY
        (V2 Double
c1 Double
c2) = Transformation V2 Double -> V2 Double
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 (RenderM () -> Render Postscript V2 Double)
-> (Render () -> RenderM ())
-> Render ()
-> Render Postscript V2 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> Render Postscript V2 Double)
-> Render () -> Render Postscript V2 Double
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Render ()) -> (Double, Double) -> Render ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Render ()
C.relLineTo (V2 Double -> (Double, Double)
forall n. V2 n -> (n, n)
unr2 V2 Double
v)
  render Postscript
_ (Cubic (V2 Double -> (Double, Double)
forall n. V2 n -> (n, n)
unr2 -> (Double
x1, Double
y1))
                  (V2 Double -> (Double, Double)
forall n. V2 n -> (n, n)
unr2 -> (Double
x2, Double
y2))
                  (OffsetClosed (V2 Double -> (Double, Double)
forall n. V2 n -> (n, n)
unr2 -> (Double
x3, Double
y3))))
    = RenderM () -> Render Postscript V2 Double
C (RenderM () -> Render Postscript V2 Double)
-> (Render () -> RenderM ())
-> Render ()
-> Render Postscript V2 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> Render Postscript V2 Double)
-> Render () -> Render Postscript V2 Double
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
_ = (Trail' Line V2 Double -> Render Postscript V2 Double)
-> (Trail' Loop V2 Double -> Render Postscript V2 Double)
-> Trail V2 Double
-> Render Postscript V2 Double
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 (RenderM () -> Render Postscript V2 Double)
-> RenderM () -> Render Postscript V2 Double
forall a b. (a -> b) -> a -> b
$ do
        (Segment Closed V2 Double -> RenderM ())
-> [Segment Closed V2 Double] -> RenderM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Segment Closed V2 Double -> RenderM ()
forall a.
(Renderable a Postscript, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC (Trail' Line V2 Double -> [Segment Closed V2 Double]
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
        (Bool -> Identity Bool)
-> PostscriptState -> Identity PostscriptState
Lens' PostscriptState Bool
ignoreFill ((Bool -> Identity Bool)
 -> PostscriptState -> Identity PostscriptState)
-> Bool -> RenderM ()
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 (RenderM () -> Render Postscript V2 Double)
-> RenderM () -> Render Postscript V2 Double
forall a b. (a -> b) -> a -> b
$ do
        case Trail' Loop V2 Double
-> ([Segment Closed V2 Double], Segment Open V2 Double)
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
_) -> (Segment Closed V2 Double -> RenderM ())
-> [Segment Closed V2 Double] -> RenderM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Segment Closed V2 Double -> RenderM ()
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)
_ -> (Segment Closed V2 Double -> RenderM ())
-> [Segment Closed V2 Double] -> RenderM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Segment Closed V2 Double -> RenderM ()
forall a.
(Renderable a Postscript, V a ~ V2, N a ~ Double) =>
a -> RenderM ()
renderC (Trail' Line V2 Double -> [Segment Closed V2 Double]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments (Trail' Line V2 Double -> [Segment Closed V2 Double])
-> (Trail' Loop V2 Double -> Trail' Line V2 Double)
-> Trail' Loop V2 Double
-> [Segment Closed V2 Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Loop V2 Double -> Trail' Line V2 Double
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop (Trail' Loop V2 Double -> [Segment Closed V2 Double])
-> Trail' Loop V2 Double -> [Segment Closed V2 Double]
forall a b. (a -> b) -> a -> b
$ Trail' Loop V2 Double
lp)

        Render () -> RenderM ()
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 (RenderM () -> Render Postscript V2 Double)
-> RenderM () -> Render Postscript V2 Double
forall a b. (a -> b) -> a -> b
$ do
      Path V2 Double -> RenderM ()
postscriptPath Path V2 Double
p
      Maybe (Texture Double)
f <- (FillTexture Double -> Texture Double)
-> RenderM (Maybe (Texture Double))
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib FillTexture Double -> Texture Double
forall n. FillTexture n -> Texture n
getFillTexture
      Maybe (Texture Double)
s <- (LineTexture Double -> Texture Double)
-> RenderM (Maybe (Texture Double))
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib LineTexture Double -> Texture Double
forall n. LineTexture n -> Texture n
getLineTexture
      Maybe CMYK
fk <- (FillColorCMYK -> CMYK) -> RenderM (Maybe CMYK)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib FillColorCMYK -> CMYK
getFillColorCMYK
      Maybe CMYK
sk <- (LineColorCMYK -> CMYK) -> RenderM (Maybe CMYK)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib LineColorCMYK -> CMYK
getLineColorCMYK
      Bool
ign <- Getting Bool PostscriptState Bool
-> StateStackT PostscriptState Render Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool PostscriptState Bool
Lens' PostscriptState Bool
ignoreFill
      Maybe (Texture Double) -> Maybe CMYK -> RenderM ()
setFillColor Maybe (Texture Double)
f Maybe CMYK
fk
      Bool -> RenderM () -> RenderM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Maybe (Texture Double) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Texture Double)
f Bool -> Bool -> Bool
|| Maybe CMYK -> Bool
forall a. Maybe a -> Bool
isJust Maybe CMYK
fk) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ign) (RenderM () -> RenderM ()) -> RenderM () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC Render ()
C.fillPreserve
      Maybe (Texture Double) -> Maybe CMYK -> RenderM ()
setStrokeColor Maybe (Texture Double)
s Maybe CMYK
sk
      Render () -> RenderM ()
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
    Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ Render ()
-> (Texture Double -> Render ())
-> Maybe (Texture Double)
-> Render ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Render ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Texture Double -> Render ()
forall n. Texture n -> Render ()
C.fillColor Maybe (Texture Double)
c
    Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ Render () -> (CMYK -> Render ()) -> Maybe CMYK -> Render ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Render ()
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
    Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ Render ()
-> (Texture Double -> Render ())
-> Maybe (Texture Double)
-> Render ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Render ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Texture Double -> Render ()
forall n. Texture n -> Render ()
C.strokeColor Maybe (Texture Double)
c
    Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ Render () -> (CMYK -> Render ()) -> Maybe CMYK -> Render ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Render ()
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
      Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC Render ()
C.newPath
      (Bool -> Identity Bool)
-> PostscriptState -> Identity PostscriptState
Lens' PostscriptState Bool
ignoreFill ((Bool -> Identity Bool)
 -> PostscriptState -> Identity PostscriptState)
-> Bool -> RenderM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
      (Located (Trail V2 Double) -> RenderM ())
-> [Located (Trail V2 Double)] -> RenderM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
F.mapM_ Located (Trail V2 Double) -> RenderM ()
forall a.
(Renderable a Postscript, V a ~ V2, N a ~ Double) =>
Located a -> RenderM ()
renderTrail [Located (Trail V2 Double)]
trs
    where renderTrail :: Located a -> RenderM ()
renderTrail (Located a -> (Point (V a) (N a), a)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (Point (V a) (N a) -> (Double, Double)
forall n. P2 n -> (n, n)
unp2 -> (Double, Double)
pt, a
tr)) = do
            Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Render ()) -> (Double, Double) -> Render ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Render ()
C.moveTo (Double, Double)
pt
            a -> RenderM ()
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' :: (a -> m ()) -> Maybe a -> m ()
if' = m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
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 (RenderM () -> Render Postscript V2 Double)
-> RenderM () -> Render Postscript V2 Double
forall a b. (a -> b) -> a -> b
$ do
      Maybe String
ff <- (Font -> String) -> RenderM (Maybe String)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib Font -> String
getFont
      Maybe FontSlant
fs <- (FontSlant -> FontSlant) -> RenderM (Maybe FontSlant)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib (FontSlant -> FontSlant
fromFontSlant (FontSlant -> FontSlant)
-> (FontSlant -> FontSlant) -> FontSlant -> FontSlant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSlant -> FontSlant
getFontSlant)
      Maybe FontWeight
fw <- (FontWeight -> FontWeight) -> RenderM (Maybe FontWeight)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib (FontWeight -> FontWeight
fromFontWeight (FontWeight -> FontWeight)
-> (FontWeight -> FontWeight) -> FontWeight -> FontWeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontWeight -> FontWeight
getFontWeight)
      Maybe Double
size' <- (FontSize Double -> Double) -> RenderM (Maybe Double)
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib FontSize Double -> Double
forall n. FontSize n -> n
getFontSize
      Maybe (Texture Double)
f <- (FillTexture Double -> Texture Double)
-> RenderM (Maybe (Texture Double))
forall a b. AttributeClass a => (a -> b) -> RenderM (Maybe b)
getStyleAttrib FillTexture Double -> Texture Double
forall n. FillTexture n -> Texture n
getFillTexture
      Maybe CMYK
fk <- (FillColorCMYK -> CMYK) -> RenderM (Maybe CMYK)
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
      Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ do
        (Double -> Render ()) -> Maybe Double -> Render ()
forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
if' (ASetter RenderState RenderState Double Double
-> Double -> Render ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((DrawState -> Identity DrawState)
-> RenderState -> Identity RenderState
Lens' RenderState DrawState
C.drawState ((DrawState -> Identity DrawState)
 -> RenderState -> Identity RenderState)
-> ((Double -> Identity Double) -> DrawState -> Identity DrawState)
-> ASetter RenderState RenderState Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PostscriptFont -> Identity PostscriptFont)
-> DrawState -> Identity DrawState
Lens' DrawState PostscriptFont
C.font ((PostscriptFont -> Identity PostscriptFont)
 -> DrawState -> Identity DrawState)
-> ((Double -> Identity Double)
    -> PostscriptFont -> Identity PostscriptFont)
-> (Double -> Identity Double)
-> DrawState
-> Identity DrawState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double)
-> PostscriptFont -> Identity PostscriptFont
Lens' PostscriptFont Double
C.size))   Maybe Double
size'
        (String -> Render ()) -> Maybe String -> Render ()
forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
if' (ASetter RenderState RenderState String String
-> String -> Render ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((DrawState -> Identity DrawState)
-> RenderState -> Identity RenderState
Lens' RenderState DrawState
C.drawState ((DrawState -> Identity DrawState)
 -> RenderState -> Identity RenderState)
-> ((String -> Identity String) -> DrawState -> Identity DrawState)
-> ASetter RenderState RenderState String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PostscriptFont -> Identity PostscriptFont)
-> DrawState -> Identity DrawState
Lens' DrawState PostscriptFont
C.font ((PostscriptFont -> Identity PostscriptFont)
 -> DrawState -> Identity DrawState)
-> ((String -> Identity String)
    -> PostscriptFont -> Identity PostscriptFont)
-> (String -> Identity String)
-> DrawState
-> Identity DrawState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Identity String)
-> PostscriptFont -> Identity PostscriptFont
Lens' PostscriptFont String
C.face))   Maybe String
ff
        (FontSlant -> Render ()) -> Maybe FontSlant -> Render ()
forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
if' (ASetter RenderState RenderState FontSlant FontSlant
-> FontSlant -> Render ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((DrawState -> Identity DrawState)
-> RenderState -> Identity RenderState
Lens' RenderState DrawState
C.drawState ((DrawState -> Identity DrawState)
 -> RenderState -> Identity RenderState)
-> ((FontSlant -> Identity FontSlant)
    -> DrawState -> Identity DrawState)
-> ASetter RenderState RenderState FontSlant FontSlant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PostscriptFont -> Identity PostscriptFont)
-> DrawState -> Identity DrawState
Lens' DrawState PostscriptFont
C.font ((PostscriptFont -> Identity PostscriptFont)
 -> DrawState -> Identity DrawState)
-> ((FontSlant -> Identity FontSlant)
    -> PostscriptFont -> Identity PostscriptFont)
-> (FontSlant -> Identity FontSlant)
-> DrawState
-> Identity DrawState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FontSlant -> Identity FontSlant)
-> PostscriptFont -> Identity PostscriptFont
Lens' PostscriptFont FontSlant
C.slant))  Maybe FontSlant
fs
        (FontWeight -> Render ()) -> Maybe FontWeight -> Render ()
forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
if' (ASetter RenderState RenderState FontWeight FontWeight
-> FontWeight -> Render ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((DrawState -> Identity DrawState)
-> RenderState -> Identity RenderState
Lens' RenderState DrawState
C.drawState ((DrawState -> Identity DrawState)
 -> RenderState -> Identity RenderState)
-> ((FontWeight -> Identity FontWeight)
    -> DrawState -> Identity DrawState)
-> ASetter RenderState RenderState FontWeight FontWeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PostscriptFont -> Identity PostscriptFont)
-> DrawState -> Identity DrawState
Lens' DrawState PostscriptFont
C.font ((PostscriptFont -> Identity PostscriptFont)
 -> DrawState -> Identity DrawState)
-> ((FontWeight -> Identity FontWeight)
    -> PostscriptFont -> Identity PostscriptFont)
-> (FontWeight -> Identity FontWeight)
-> DrawState
-> Identity DrawState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FontWeight -> Identity FontWeight)
-> PostscriptFont -> Identity PostscriptFont
Lens' PostscriptFont FontWeight
C.weight)) Maybe FontWeight
fw
      Bool -> RenderM () -> RenderM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Texture Double) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Texture Double)
f Bool -> Bool -> Bool
|| Maybe CMYK -> Bool
forall a. Maybe a -> Bool
isJust Maybe CMYK
fk) (RenderM () -> RenderM ()) -> RenderM () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC Render ()
C.fillPreserve
      Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
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 -> Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ Double -> Double -> String -> Render ()
C.showTextAlign Double
xt Double
yt String
str
        TextAlignment Double
BaselineText         -> Render () -> RenderM ()
forall a. Render a -> RenderM a
liftC (Render () -> RenderM ()) -> Render () -> RenderM ()
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Render ()
C.moveTo Double
0 Double
0 Render () -> Render () -> Render ()
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
-- >           }