easyrender-0.1.1.0: User-friendly creation of EPS, PostScript, and PDF files

Safe HaskellNone

Graphics.EasyRender.Internal

Contents

Description

This module exposes the implementation details of Graphics.EasyRender. Most user code should not need to import this; they should import Graphics.EasyRender instead.

This module provides efficient functions for rendering vector graphics to a number of formats, including EPS, PostScript, and PDF. It provides an abstraction for multi-page documents, as well as a set of graphics primitives for page descriptions.

The graphics model is similar to that of the PostScript and PDF languages, but we only implement a subset of their functionality. Care has been taken that graphics rendering is done efficiently and as lazily as possible; documents are rendered "on the fly", without the need to store the whole document in memory.

The provided document description model consists of two separate layers of abstraction:

  • drawing is concerned with placing marks on a fixed surface, and takes place in the Draw monad;
  • document structure is concerned with a sequence of pages, their bounding boxes, and other meta-data. It takes place in the Document monad.

Synopsis

Types

Coordinates

type X = DoubleSource

The type of x-coordinates.

type Y = DoubleSource

The type of y-coordinates.

Colors

data Color Source

The type of colors.

Constructors

Color_RGB Double Double Double

Red, green and blue components, in the range from 0.0 (dark) to 1.0 (bright).

Color_Gray Double

Gray value, in the range from 0.0 (black) to 1.0 (white).

Instances

Fonts

data Basefont Source

A enumeration type for base fonts. For the time being, we only offer TimesRoman and Helvetica.

Constructors

TimesRoman 
Helvetica 

Instances

type Fontmetric = (Double, Map Char Double)Source

A type representing font metrics for a given base font. The first component is the default width of characters; the second component is a map from characters to widths.

metric :: Basefont -> FontmetricSource

Define a font metric for each base font.

metric_timesroman :: FontmetricSource

Font metrics for TimesRoman.

metric_helvetica :: FontmetricSource

Font metrics for Helvetica.

char_metric :: Fontmetric -> Char -> DoubleSource

Look up the width of a character in the given metric.

string_metric :: Fontmetric -> String -> DoubleSource

Look up with width of a string in the given metric.

data Font Source

A data type describing a scaled font. This consists of a base font and a point size.

Constructors

Font Basefont Double 

Instances

nominalsize :: Font -> DoubleSource

Return the nominal point size of a font.

text_width :: Font -> String -> DoubleSource

Return the width of the given string in the given font.

Alignment

type Alignment = DoubleSource

A real number representing text alignment. 0 = left aligned, 0.5 = centered, 1 = right aligned. Intermediate values are also possible. For example, an alignment value of 0.25 means one quarter of the way between left aligned and right aligned.

align_left :: AlignmentSource

Left alignment.

align_center :: AlignmentSource

Centered alignment.

align_right :: AlignmentSource

Right alignment.

The Document monad

Document description takes place in the Document monad. A basic multi-page document has the following structure:

 document :: Document ()
 document = do
   newpage x y $ do
     <<<drawing commands>>>
   newpage x y $ do
     <<<drawing commands>>>
   ...

Here, each newpage command describes one page of the document. The parameters x and y specify the dimensions of the page bounding box. They are expressed in units of PostScript points, i.e., multiples of 1/72 inch.

Sometimes the bounding box for a page is not known until after the page content has been generated. For this purpose, we also provide the following alternative to the newpage command:

   newpage_defer $ do
     <<<drawing commands>>>
     endpage x y

It works just like the newpage command, except that the bounding box is given at the end.

data Document a Source

The Document monad.

Constructors

Document_Return a

Terminate with a result.

Document_Page X Y (Draw (Document a))

Page with bounding box known at the beginning.

Document_Page_defer (Draw (X, Y, Document a))

Page with bounding box known at the end.

A vacuous run function

document_skip :: Document a -> aSource

Skip document without rendering.

User-level document structuring commands

newpage :: X -> Y -> Draw a -> Document aSource

Create a page of the given bounding box, containing the given drawing.

newpage_defer :: Draw (X, Y, a) -> Document aSource

Create a page containing the given drawing, with the bounding box computed at the end of the drawing routines.

endpage :: X -> Y -> Draw (X, Y, ())Source

End the page with the given bounding box.

The Draw monad

The description of the visible content of a page take place in the Draw monad. It takes the form of a sequence of drawing commands, for example:

     moveto 10 10
     lineto 10 100
     lineto 100 100
     lineto 100 10
     closepath
     stroke

The graphics model is similar to that of the PostScript and PDF languages. The basic concept is that of a path, which is a sequence of straight and curved line segments. Paths are first constructed using path construction commands, and then painted using painting commands, depending on a set of current graphics parameters and a current coordinate system.

We also provide block structure. Changes to the graphics state (color, coordinate system, etc.) that are done within a block are local to the block.

     block $ do
       <<drawing commands>>

Internal definition of the Draw monad

data DrawCommand Source

An abstract data type describing individual drawing commands.

Constructors

Newpath

Set the current path to empty.

Moveto X Y

Start a new subpath at the given coordinates.

Lineto X Y

Append a straight line to the current subpath.

Curveto X Y X Y X Y

Append a Bezier curve segment.

Closepath

Close the current subpath.

Clip

Use the current path as a clipping path.

Stroke

Stroke and clear the current path.

Fill Color

Fill and clear the current path.

FillStroke Color

Fill and stroke and clear the current path.

TextBox Alignment Font Color X Y X Y Double String

Text.

SetLineWidth Double

Set current line width.

SetColor Color

Set current color.

Translate X Y

Translate current coordinate system.

Scale X Y

Scale the current coordinate system.

Rotate Double

Rotate the current coordinate system.

Comment String

A human-readable comment, not rendered

Subroutine (Draw ()) [CustomDef]

A subroutine is a composite drawing command. In addition to a default definition that works for any backend, it can also have optional specialized definitions for particular backends.

Instances

In understanding how the Draw monad works, it is useful to keep in mind that there is an isomorphism

Draw aDraw () ×. a,

where "×." is left-strict product, i.e., if the left-hand-side is undefined, then so is the entire expression.

data Draw a Source

The Draw monad.

Constructors

Draw_Return a

Terminate with a result.

Draw_Write DrawCommand (Draw a)

Write a command and continue.

Draw_Block (Draw (Draw a))

Block structure. Perform the commands of the outer Draw in a temporary copy of the graphics state, then continue with the inner Draw in the original graphics state.

Low-level operations for the Draw monad

draw_write :: DrawCommand -> Draw ()Source

Write the given command to the Draw monad.

draw_subroutine :: [CustomDef] -> Draw () -> Draw ()Source

Create a new subroutine.

draw_block :: Draw a -> Draw aSource

Write a block to the Draw monad.

A vacuous run function

draw_skip :: Draw a -> aSource

Skip draw actions without rendering.

User-level drawing commands

Path construction commands

During path construction, there is a notion of current path and current point. A path may consist of zero or more connected subpaths, and each subpath is either open or closed.

newpath :: Draw ()Source

Set the current path to empty.

moveto :: X -> Y -> Draw ()Source

Start a new subpath at (x,y). The point (x,y) becomes the current point.

lineto :: X -> Y -> Draw ()Source

Extend the current subpath by a straight line segment from the current point to (x,y). The point (x,y) becomes the current point.

curveto :: X -> Y -> X -> Y -> X -> Y -> Draw ()Source

curveto x1 y1 x2 y2 x y: Extend the current subpath by a Bezier curve segment from the current point to (x,y), with control points (x1,y1) and (x2,y2). The point (x,y) becomes the current point.

closepath :: Draw ()Source

Close the current subpath. If necessary, connect the subpath's final and initial points by a straight line segment. Note that a closed path is rendered differently than a non-closed path whose initial and final points coincide, because in the latter case, the endpoints are capped rather than mitered.

Clipping

clip :: Draw ()Source

Use the current path as a clipping path. The non-zero winding number determines which points lie "inside" the path. All subsequent drawing operations only paint inside the clipping path. This operation implicitly resets the curent path to empty. There is no way to undo this operation, except by enclosing it in the local block.

Painting commands

stroke :: Draw ()Source

Stroke the current path, using the current line color, line width, and other graphics parameters. This operation implicitly resets the current path to empty.

fill :: Color -> Draw ()Source

Fill the current path, using the given color. This operation implicitly resets the current path to empty.

fillstroke :: Color -> Draw ()Source

Fill the current path, using the given color; also stroke the path using the current line color. This operation implicitly resets the current path to empty.

Text

textbox :: Alignment -> Font -> Color -> X -> Y -> X -> Y -> Double -> String -> Draw ()Source

textbox a f c x0 y0 x1 y1 b s: Write the given string on an imaginary line from point (x0,y0) to (x1,y1), using font f and color c. If the text is too wide to fit on the line, it is scaled down. Otherwise, it is aligned according to the alignment parameter a. The parameter b specifies an additional offset by which to lower the text, with respect to the text's nominal size. For example, if b=0, then the above-mentioned imaginary line from (x0,y0) to (x1,y1) coincides with the text's usual baseline. If b=0.5, then this line approximately goes through the center of each character.

Graphics parameters

The painting commands rely on a set of graphics parameters. The graphics parameters are initially set to default values, and can be altered with the following commands.

setlinewidth :: Double -> Draw ()Source

Set the line width. The initial line width is 1.

setcolor :: Color -> Draw ()Source

Set the current color for stroking. The initial stroke color is black.

Coordinate system

Coordinates, lengths, widths, etc, are all interpreted relative to a current coordinate system. The initial coordinate system of each page has the origin in the lower left corner, with each unit equaling one PostScript point (1/72 inch). The following commands can be used to change the current coordinate system.

translate :: X -> Y -> Draw ()Source

Translate the current coordinate system by (x,y).

scale :: X -> Y -> Draw ()Source

Scale the current coordinate system by (s,t). Here, s is the scaling factor in the x-direction, and t is the scaling factor in the y-direction.

rotate :: Double -> Draw ()Source

Rotate the current coordinate system by angle, measured counterclockwise in degrees.

Comments

comment :: String -> Draw ()Source

Insert a human-readable comment in the content stream. This is for information only, and is not rendered in the graphical output.

Block structure

Drawing operations can be grouped into blocks with the block operator. Changes to the graphics parameters and coordinate system are local to the block. It is undefined whether changes to the current path made within a block persist after the end of the block (they do in PDF, but not in PostScript). Therefore, path construction should not be broken up across end-of-block boundaries.

block :: Draw a -> Draw aSource

Perform a block of commands in a local copy of the graphics state. This is intended to be used like this:

     block $ do
       <<drawing commands>>

Derived commands

PDF has no built-in command for drawing circular arcs, so we define it here. Since PostScript does have such a command, we use the draw_subroutine mechanism.

arc :: X -> Y -> Double -> Double -> Double -> Draw ()Source

Start a new subpath consisting of a circular arc segment. The arc segment is centered at (x,y), has radius r, and extends from angle a1 to angle a2, measured in degrees, counterclockwise from the x-axis. The arc is drawn counterclockwise if a2a1, and clockwise otherwise. The final point becomes the new current point.

arc_append :: X -> Y -> Double -> Double -> Double -> Draw ()Source

Like arc, except append to the current subpath. If necessary, add a straight line segment from the current point to the starting point of the arc.

oval :: X -> Y -> X -> Y -> Draw ()Source

Append a new closed subpath consisting of an oval centered at (x,y), with horizontal and vertical radii rx and ry, respectively.

arc_internal :: Bool -> X -> Y -> Double -> Double -> Double -> Double -> Draw ()Source

The common implementation of arc, arc_append, and oval. The first parameter is a boolean flag indicating whether to append to an existing subpath or start a new subpath. The fourth and fifth parameter are the horizontal and vertical radius.

rectangle :: X -> Y -> X -> Y -> Draw ()Source

rectangle x y w h: Draw a rectangle of width w and height h, starting from (x,y). If w and h are positive, then (x,y) is the lower left corner.

Customization

The document and drawing abstractions provided by this module are purposely kept general-purpose, and do not include application-specific features. However, we provide a mechanism by which applications can provide customized drawing commands and other custom features.

Custom drawing commands

It is sometimes useful to use customized drawing commands. For example, an application that draws many rectangles might like to define a custom rectangle function for appending a rectangle to the current path. Of course this can be defined as an ordinary Haskell function, using elementary drawing commands:

 my_rect :: X -> Y -> X -> Y -> Draw ()
 my_rect x0 y0 x1 y1 = do
   moveto x0 y0
   lineto x0 y1
   lineto x1 y1
   lineto x1 y0
   closepath

However, sometimes it is nice to make use of specialized abilities of individual backends. For example, PDF already has a built-in rectangle drawing command, and PostScript has the ability to define custom subroutines within the document text. Using these features can decrease the size of the generated documents.

We therefore provide a facility for defining new drawing commands with backend-specific implementations. For example, a more general version of the above my_rect function can be defined as follows:

 my_rect :: X -> Y -> X -> Y -> Draw ()
 my_rect x0 y0 x1 y1 = draw_subroutine alt $ do
   moveto x0 y0
   lineto x0 y1
   lineto x1 y1
   lineto x1 y0
   closepath
  where
   alt = [
     custom_ps $      printf "%f %f %f %f rect\n" x0 y0 x1 y1,
     custom_pdf $     printf "%f %f %f %f re\n" x0 y0 (x1-x0) (y1-y0),
     custom_ascii $   printf "My_rect %f %f %f %f\n" x0 y0 x1 y1
     ]

The idea is to provide a default definition in terms of primitive drawing commands, as well as a list of various backend specific definitions. In the case of PostScript subroutines, the PostScript file must then also be supplied with a definition for the rect subroutine, which can be done with the command render_ps_custom:

 my_ps_defs = "/rect { ... } bind def\n"

 my_render_ps = render_ps_custom custom { ps_defs = my_ps_defs }

Note that the draw_subroutine customization mechanism is entirely optional. Its purpose is to generate shorter output for some backends; if it is omitted, the file may be be longer but should look the same.

data Language Source

An enumeration of backend languages, for the purpose of defining custom drawing commands. Note that several backends (e.g. EPS and PostScript) may share the same language, and therefore they are only represented once in this enumeration.

Constructors

Language_PS

PostScript (including EPS)

Language_PDF

PDF

Language_ASCII

ASCII (for debugging)

data CustomDef Source

The type of custom definitions, to be used with the draw_subroutine command.

Constructors

CustomDef Language String 

Instances

custom_ps :: String -> CustomDefSource

Define a custom PostScript definition.

custom_pdf :: String -> CustomDefSource

Define a custom PDF definition.

custom_ascii :: String -> CustomDefSource

Define a custom ASCII definition.

custom_lookup :: Language -> [CustomDef] -> Maybe StringSource

Look up an element in a list of CustomDefs.

Customization interface

data Custom Source

A data structure that holds application-specific meta-data and customization information.

Constructors

Custom 

Fields

creator :: String

Name of the software that created the file. Example: "MyApp 1.0". Note: this is intended to hold the name of the software, not the human user, that created the document.

ps_defs :: String

Definitions to go in the PostScript preamble.

custom :: CustomSource

An empty customization structure. Customizations should be specified by modifying custom, for example:

 custom { creator = "MyApp 1.0" }

Generic string output

The WriterMonad class

class Monad m => WriterMonad m whereSource

A WriterMonad is any monad that one can output strings to.

Minimal complete definition: wPutChar or wPutStr.

Methods

wPutChar :: Char -> m ()Source

Write a character.

wPutStr :: String -> m ()Source

Write a string.

wPutStrLn :: WriterMonad m => String -> m ()Source

Like wPutStr, but adds a newline character.

wprint :: (WriterMonad m, Show a) => a -> m ()Source

Write a value of any printable type, and add a newline.

The Writer monad

data Writer a Source

A generic WriterMonad.

Constructors

Writer_Return a

Terminate with a result.

Writer_PutChar Char (Writer a)

Write a character.

Writer_PutStr String (Writer a)

Write a string.

Isomorphism with (String, a)

writer_to_pair :: Writer a -> (String, a)Source

Isomorphically map a Writer computation to a pair of a string and a value.

Important usage note: the String in the output is produced lazily, and before a is produced. To preserve laziness, do not evaluate a before the end of String has been reached.

pair_to_writer :: (String, a) -> Writer aSource

The inverse of writer_to_pair.

Run functions

run_writer :: WriterMonad m => Writer a -> m aSource

Run a Writer computation in any WriterMonad.

writer_to_file :: Handle -> Writer a -> IO aSource

Run a writer in the IO monad by printing to a file.

writer_to_string :: Writer a -> StringSource

Run a writer by printing to a string.

Boxed monads

newtype Boxed m a Source

Create an identical "boxed" copy of a type constructor. This is used for technical reasons, to allow the wprintf operation to be typed.

Constructors

Boxed (m a) 

Instances

MonadState s m => MonadState s (Boxed m) 
Monad m => Monad (Boxed m) 
Functor m => Functor (Boxed m) 
Applicative m => Applicative (Boxed m) 
WriterMonad m => WriterMonad (Boxed m) 
Boxed_Curry (Boxed m a) () m a 

unbox :: Boxed m a -> m aSource

Unbox a boxed item.

Currying in a boxed monad

class Boxed_Curry fun args m res | fun -> args res m, args res m -> fun whereSource

A class to curry/uncurry functions in any boxed monad. This establishes an isomorphism

 @fun  ≅  args -> Boxed m res,@

where

 fun = a1 -> a2 -> ... -> an -> Boxed m res,
 args = (a1, (a2, (..., (an, ())))).

Methods

boxed_curry :: (args -> Boxed m res) -> funSource

boxed_uncurry :: fun -> args -> Boxed m resSource

Instances

Boxed_Curry (Boxed m a) () m a 
Boxed_Curry fun args m res => Boxed_Curry (a -> fun) (a, args) m res 

Formatted printing

wprintf :: (Boxed_Curry fun args m (), WriterMonad m, Curry fun' args String, PrintfType fun') => String -> funSource

Print a formatted value in the context of a boxed WriterMonad. Usage:

wprintf %f %f x y :: Boxed Writer

with_printf :: WriterMonad m => Boxed m a -> m aSource

In any WriterMonad, introduce a block in which wprintf can be used. This has no computational overhead, i.e., is compiled to the identity operation; it exists only to please the type system, due to the fancy typing of wprintf.

Filters

A filter is any function from strings to strings, but it should usually be lazy. Typical examples are compression, encryption, ASCII armoring, character encoding, and their inverses.

We provide a convenient operator for temporarily wrapping a filter around the Writer monad, as well as specific filters.

with_filter :: WriterMonad m => (String -> String) -> Writer a -> m aSource

Wrap a filter around a Writer computation. This introduces a local block within the Writer monad; all text written within the block is encoded through the given filter. Filters can be composed and nested.

flate_filter :: String -> StringSource

A filter for performing "flate" (also known as "zlib") compression.

Note: both the input and output strings are regarded as sequences of bytes, not characters. Any characters outside the byte range are truncated to 8 bits.

Backends

Auxiliary functions

ensure_nl :: String -> StringSource

Ensure that the last line of the string ends in a newline character, adding one if necessary. An empty string is considered to contain zero lines, so no newline character needs to be added.

ASCII output

draw_to_ascii :: Draw a -> Writer aSource

Render draw actions as ASCII.

command_to_ascii :: DrawCommand -> Writer ()Source

Render drawing commands as ASCII.

document_to_ascii :: Document a -> Writer aSource

Render a document as ASCII.

render_ascii :: Document a -> Writer aSource

Render a document as ASCII. This is for debugging purposes only. The output is a sequence of drawing commands, rather than a graphical representation.

PostScript output

Auxiliary functions

ps_escape :: String -> StringSource

Escape special characters in a string literal.

remove_nl :: String -> StringSource

Remove newline characters in a string.

The PSWriter monad

For convenience, we wrap the Writer monad in a custom state monad; the latter keeps track of the current document bounding box (i.e., the smallest bounding box containing all pages) and the current number of pages.

type Page = IntegerSource

The type of page numbers.

data PS_State Source

A state to keep track of a current bounding box and page number.

Constructors

PS_State !X !Y !Page 

Instances

type PSWriter = Boxed (StateT PS_State Writer)Source

The PSWriter monad. This is just a PS_State wrapped around the Writer monad.

pswriter_run :: PSWriter a -> Writer aSource

Run function for the PSWriter monad.

Access functions for the PSWriter monad

ps_get_bbox :: PSWriter (X, Y)Source

Get the bounding box.

ps_add_bbox :: X -> Y -> PSWriter ()Source

Add to the bounding box.

ps_get_pagecount :: PSWriter PageSource

Get the page count.

ps_next_page :: PSWriter PageSource

Return the next page number.

Internal rendering to the PSWriter monad

draw_to_ps :: Draw a -> PSWriter aSource

Render draw actions as PostScript.

color_to_ps :: Color -> PSWriter ()Source

Set the color.

font_to_ps :: Font -> PSWriter ()Source

Set the font.

command_to_ps :: DrawCommand -> PSWriter ()Source

Draw a single drawing command to PostScript.

document_to_ps :: Custom -> Document a -> PSWriter aSource

Render a document as PostScript.

global_ps_defs :: StringSource

Global PostScript definitions used by the rendering engine.

pages_to_ps :: Document a -> PSWriter aSource

Render pages as PostScript.

Rendering to the Writer monad

render_ps_custom :: Custom -> Document a -> Writer aSource

Render document as PostScript. The first argument is a customization data structure.

EPS output

Encapsulated PostScript (EPS) output is slightly different from normal PostScript output. EPS is limited to a single page, and contains no "showpage" command. We permit the user to print a single page from a multi-page document, by specifying the page number.

document_to_eps :: Custom -> Page -> Document a -> PSWriter aSource

Render a document as EPS. Since EPS only permits a single page of output, the Page parameter is used to specify which page (of a potential multi-page document) should be printed. An error will be thrown if the page number was out of range.

Note: if the return value is not used, the remaining pages are lazily skipped.

render_eps_custom :: Custom -> Page -> Document a -> Writer aSource

Render document as EPS. The first argument is a customization data structure, and the second argument is the number of the page to extract from the document.

PDF output

Auxiliary functions

pdf_escape :: String -> StringSource

Escape special characters in a string literal.

The PDF state

Creating PDF files requires some state: we need to keep track of the current file position, page numbering, and object numbering.

type Filepos = IntegerSource

A position in a file. The first byte is 0.

type Object = IntegerSource

A PDF object reference.

data PDF_State Source

A state to keep track of PDF document structure: current character count, current TOC, current page, etc.

Constructors

PDF_State 

Fields

pdf_filepos :: !Filepos

Current position in file.

pdf_obj :: !Object

Object count.

pdf_xref :: !(Map Object Filepos)

Cross-reference table.

pdf_page :: !Page

Next available page number.

pdf_pagetable :: !(Map Page Object)

Page table.

pdf_font :: !Integer

Next available font number.

pdf_fonttable :: !(Map String String)

Font table mapping each font's PostScript name to a local name.

The PDFWriter monad

type RawPDFWriter = StateT PDF_State WriterSource

The RawPDFWriter monad is just a PDF_State wrapped around the Writer monad. Its wPutChar and wPutStr methods automatically keep track of the file position.

type PDFWriter = Boxed RawPDFWriterSource

Boxed version of the RawPDFWriter monad.

pdfwriter_run :: PDFWriter a -> Writer aSource

Run function for the PDFWriter monad.

Access functions for the PDFWriter monad

pdf_get_filepos :: PDFWriter FileposSource

Get the file position.

pdf_inc_filepos :: Integer -> RawPDFWriter ()Source

Add to the file position.

pdf_get_objcount :: PDFWriter ObjectSource

Get the number of allocated objects. Note that objects are allocated as 1, 2, ..., n; this function returns n.

pdf_next_object :: PDFWriter ObjectSource

Allocate an unused object identifier.

pdf_add_xref :: Object -> Filepos -> PDFWriter ()Source

Add a cross reference to the cross reference table.

pdf_get_xref :: PDFWriter (Map Object Filepos)Source

Retrieve the cross reference table.

pdf_get_pagecount :: PDFWriter PageSource

Get the page count.

pdf_next_page :: PDFWriter PageSource

Return the next page number.

pdf_add_pagetable :: Page -> Object -> PDFWriter ()Source

Add a page to the page table.

pdf_get_pagetable :: PDFWriter (Map Page Object)Source

Retrieve the page table.

pdf_find_font :: String -> PDFWriter StringSource

Look up the local font identifier for a font.

pdf_get_fonttable :: PDFWriter (Map String String)Source

Retrieve the font table.

pdf_clear_fonttable :: PDFWriter ()Source

Clear the font table.

Filters

with_filter_pdf :: (String -> String) -> PDFWriter a -> PDFWriter aSource

A version of with_filter tailored to the PDFWriter monad.

This allows certain global state updates within the local block. Specifically, updates to everything except the file position are propagated from the inner to the outer block. The outer block's file position is updated to reflect the encoded content's length. From the inner block's point of view, the file position starts from 0.

Higher access functions

pdf_deferred_object :: Object -> PDFWriter a -> PDFWriter aSource

Define an indirect PDF object with the given object id, which must have previously been uniquely obtained with pdf_next_object.

This can be used to define objects with forward references: first obtain an object id, then create references to the object, and finally define the object.

It should be used like this:

 obj <- pdf_next_object
 ...
 pdf_deferred_object obj $ do
   <<object definition>>

pdf_define_object :: PDFWriter a -> PDFWriter ObjectSource

Define an indirect PDF object with a newly generated object id. Return the object id. This essentially combines pdf_next_object and pdf_deferred_object into a single function, and should be used like this:

 obj <- pdf_define_object $ do
   <<object definition>>

pdf_deferred_stream :: Object -> PDFWriter a -> PDFWriter aSource

Define a PDF stream object with the given object id, which must have previously been uniquely obtained with pdf_next_object. It should be used like this:

 obj <- pdf_next_object
 ...
 pdf_deferred_stream obj $ do
   <<stream contents>>

pdf_define_stream :: PDFWriter a -> PDFWriter ObjectSource

Define a PDF stream object with a newly generated object id. Return the object id. This should be used like this:

 obj <- pdf_define_stream $ do
   <<stream contents>>

pdf_deferred_flate_stream :: Object -> PDFWriter a -> PDFWriter aSource

Define a compressed PDF stream object with the given object id, which must have previously been uniquely obtained with pdf_next_object. It should be used like this:

 obj <- pdf_next_object
 ...
 pdf_deferred_flate_stream obj $ do
   <<stream contents>>

objref :: Object -> StringSource

Create a direct object from a reference to an indirect object.

wprintf_xref_entry :: Filepos -> Integer -> Char -> PDFWriter ()Source

Write one line in the cross reference table. This must be exactly 20 characters long, including the terminating newline.

wprintf_xref :: PDFWriter FileposSource

Format the cross reference table. Return the file position of the cross reference table.

Internal rendering to the PDFWriter monad

fillcolor_to_pdf :: Color -> PDFWriter ()Source

Set the fill color.

strokecolor_to_pdf :: Color -> PDFWriter ()Source

Set the stroke color.

font_to_pdf :: Font -> PDFWriter ()Source

Set the font.

command_to_pdf :: DrawCommand -> PDFWriter ()Source

Render a drawing command to PDF.

draw_to_pdf :: Draw a -> PDFWriter aSource

Render a draw action to PDF.

pages_to_pdf :: Object -> Document a -> PDFWriter aSource

Render pages as PDF. The first argument is a reference to the document's page tree node.

Note: Acrobat reader cannot handle pages whose bounding box width or height exceed 200 inches (14400 points). Therefore, we automatically scale pages to be no greater than 199 inches.

document_to_pdf :: Custom -> Document a -> PDFWriter aSource

Render a document as PDF.

Rendering to the Writer monad

render_pdf_custom :: Custom -> Document a -> Writer aSource

Render document as PDF. The first argument is a customization data structure.

Generic output functions

The following commands can be used to render documents to various available formats. The available formats are PostScript, PDF, EPS, and an ASCII-based debugging format. Output can be written to standard output, to a file, or to a string.

data RenderFormat Source

Available graphics formats for rendering.

Constructors

Format_PS

PostScript.

Format_PDF

Portable Document Format.

Format_EPS Integer

Encapsulated PostScript. The integer argument specifies which single page to extract from the document.

Format_Debug

An ASCII-based debugging format.

Instances

is_binary_format :: RenderFormat -> BoolSource

Does the format require raw binary output?

Rendering with custom format

The following are versions of the generic rendering functions that also take a customization data structure as an additional parameter.

render_custom :: RenderFormat -> Custom -> Document a -> Writer aSource

Render a document to the Writer monad, using the given output format and customization data structure.

render_custom_file :: Handle -> RenderFormat -> Custom -> Document a -> IO aSource

Render a document to a file, using the given output format and customization data structure.

render_custom_stdout :: RenderFormat -> Custom -> Document a -> IO aSource

Render a document to standard output, using the given output format and customization data structure.

render_custom_string :: RenderFormat -> Custom -> Document a -> StringSource

Render a document to a string, using the given output format and customization data structure.

Rendering without custom format

render :: RenderFormat -> Document a -> Writer aSource

Render a document to the Writer monad, using the given output format.

render_file :: Handle -> RenderFormat -> Document a -> IO aSource

Render a document to a file, using the given output format.

render_stdout :: RenderFormat -> Document a -> IO aSource

Render a document to standard output, using the given output format.

render_string :: RenderFormat -> Document a -> StringSource

Render a document to a string, using the given output format.