summaryrefslogtreecommitdiffstats
path: root/src/devices/gropdf
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-15 19:44:05 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-15 19:44:05 +0000
commitd318611dd6f23fcfedd50e9b9e24620b102ba96a (patch)
tree8b9eef82ca40fdd5a8deeabf07572074c236095d /src/devices/gropdf
parentInitial commit. (diff)
downloadgroff-upstream.tar.xz
groff-upstream.zip
Adding upstream version 1.23.0.upstream/1.23.0upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'src/devices/gropdf')
-rw-r--r--src/devices/gropdf/TODO31
-rw-r--r--src/devices/gropdf/gropdf.1.man1845
-rw-r--r--src/devices/gropdf/gropdf.am58
-rw-r--r--src/devices/gropdf/gropdf.pl3928
-rw-r--r--src/devices/gropdf/pdfmom.1.man229
-rw-r--r--src/devices/gropdf/pdfmom.pl150
6 files changed, 6241 insertions, 0 deletions
diff --git a/src/devices/gropdf/TODO b/src/devices/gropdf/TODO
new file mode 100644
index 0000000..12042c2
--- /dev/null
+++ b/src/devices/gropdf/TODO
@@ -0,0 +1,31 @@
+pspic.tmac
+----------
+
+Equiv for gropdf is pdfpic (which is dependent on a program pdfbb (to
+extract MediaBox (etc.) from the pdf) which is not written yet! Meanwhile
+you could use \X'pdf: pdfpic filename -L|R|C wid (hgt) (linelen)' (-R and -C
+require a linelen) Wid or hgt may be zero (in which case the same scaling as
+the other axis is used). The disadvantage of this call (over pdfpic macro)
+is that it is transparent to groff, after placing the image the current X/Y
+position remains what it was, so you need to do your own 'motion control'
+(like a .sp) to "step over" the image you just placed.
+
+psfig.tmac
+----------
+
+No equiv for gropdf.
+
+psatk.tmac
+----------
+
+No equiv for gropdf.
+
+-I : search -I directory for included files
+
+-w : set line width
+
+Another \X : \X'ps: exec 0 setlinejoin'\X'ps: exec 0 setlinecap' for mom
+
+Cater for fonts with >255 glyphs (currently accessing a glyph above 255
+(i.e. \N[260]) causes a fail). This will be fixed when font subsetting is
+implemented.
diff --git a/src/devices/gropdf/gropdf.1.man b/src/devices/gropdf/gropdf.1.man
new file mode 100644
index 0000000..d1d39bb
--- /dev/null
+++ b/src/devices/gropdf/gropdf.1.man
@@ -0,0 +1,1845 @@
+.TH gropdf @MAN1EXT@ "@MDATE@" "groff @VERSION@"
+.SH Name
+gropdf \-
+.I groff
+output driver for Portable Document Format
+.
+.
+.\" ====================================================================
+.\" Legal Terms
+.\" ====================================================================
+.\"
+.\" Copyright (C) 2011-2022 Free Software Foundation, Inc.
+.\"
+.\" Permission is granted to make and distribute verbatim copies of this
+.\" manual provided the copyright notice and this permission notice are
+.\" preserved on all copies.
+.\"
+.\" Permission is granted to copy and distribute modified versions of
+.\" this manual under the conditions for verbatim copying, provided that
+.\" the entire resulting derived work is distributed under the terms of
+.\" a permission notice identical to this one.
+.\"
+.\" Permission is granted to copy and distribute translations of this
+.\" manual into another language, under the above conditions for
+.\" modified versions, except that this permission notice may be
+.\" included in translations approved by the Free Software Foundation
+.\" instead of in the original English.
+.
+.
+.\" Save and disable compatibility mode (for, e.g., Solaris 10/11).
+.do nr *groff_gropdf_1_man_C \n[.cp]
+.cp 0
+.
+.\" Define fallback for groff 1.23's MR macro if the system lacks it.
+.nr do-fallback 0
+.if !\n(.f .nr do-fallback 1 \" mandoc
+.if \n(.g .if !d MR .nr do-fallback 1 \" older groff
+.if !\n(.g .nr do-fallback 1 \" non-groff *roff
+.if \n[do-fallback] \{\
+. de MR
+. ie \\n(.$=1 \
+. I \%\\$1
+. el \
+. IR \%\\$1 (\\$2)\\$3
+. .
+.\}
+.rr do-fallback
+.
+.
+.\" This macro definition is poor style from a portability standpoint,
+.\" but it's a good test and demonstration of the standard font
+.\" repertoire for the devices where it has any effect at all, and so
+.\" should be retained.
+.de FT
+. if '\\*(.T'ps' .ft \\$1
+. if '\\*(.T'pdf' .ft \\$1
+..
+.
+.\" ====================================================================
+.SH Synopsis
+.\" ====================================================================
+.
+.SY gropdf
+.RB [ \-dels ]
+.RB [ \-F\~\c
+.IR font-directory ]
+.RB [ \-I\~\c
+.IR inclusion-directory ]
+.RB [ \-p\~\c
+.IR paper-format ]
+\#.RB [ \-w\~\c
+\#.IR n ]
+.RB [ \-u
+.RI [ cmap-file ]]
+.RB [ \-y\~\c
+.IR foundry ]
+.RI [ file\~ .\|.\|.]
+.YS
+.
+.
+.SY gropdf
+.B \-\-help
+.YS
+.
+.
+.SY gropdf
+.B \-v
+.
+.SY gropdf
+.B \-\-version
+.YS
+.
+.
+.\" ====================================================================
+.SH Description
+.\" ====================================================================
+.
+The GNU
+.I roff
+PDF output driver translates the output of
+.MR @g@troff @MAN1EXT@
+into Portable Document Format.
+.
+Normally,
+.I gropdf
+is invoked by
+.MR groff @MAN1EXT@
+when the latter is given the
+.RB \[lq] \-T\~pdf \[rq]
+option.
+.
+(In this installation,
+.B @DEVICE@
+is the default output device.)
+.
+Use
+.IR groff 's
+.B \-P
+option to pass any options shown above to
+.IR gropdf .
+.
+If no
+.I file
+arguments are given,
+or if
+.I file
+is \[lq]\-\[rq],
+.I gropdf
+reads the standard input stream.
+.
+Output is written to the standard output stream.
+.
+.
+.P
+See section \[lq]Font installation\[rq] below for a guide to installing
+fonts for
+.IR gropdf .
+.
+.
+.\" ====================================================================
+.SH Options
+.\" ====================================================================
+.
+.B \-\-help
+displays a usage message,
+while
+.B \-v
+and
+.B \-\-version
+show version information;
+all exit afterward.
+.
+.
+.TP
+.B \-d
+Include debug information as comments within the PDF.
+.
+Also produces an uncompressed PDF.
+.
+.
+.TP
+.B \-e
+Forces
+.I gropdf
+to embed
+.I all
+fonts (even the 14 base PDF fonts).
+.
+.
+.TP
+.BI \-F " dir"
+Prepend directory
+.IR dir /dev name
+to the search path for font, and device description files;
+.I name
+is the name of the device, usually
+.BR pdf .
+.
+.TP
+.BI \-I\~ dir
+Search the directory
+.I dir
+for files named in
+.B \[rs]X\[aq]pdf: pdfpic\[aq]
+device control commands.
+.
+.B \-I
+may be specified more than once;
+each
+.I dir
+is searched in the given order.
+.
+To search the current working directory before others,
+add
+.RB \[lq] "\-I .\&" \[rq]
+at the desired place;
+it is otherwise searched last.
+.
+.
+.TP
+.B \-l
+Orient the document in landscape format.
+.
+.TP
+.BI \-p " paper-format"
+Set the physical dimensions of the output medium.
+.
+This overrides the
+.BR papersize ,
+.BR paperlength ,
+and
+.B paperwidth
+directives in the
+.I DESC
+file;
+it accepts the same arguments as the
+.B papersize
+directive.
+.
+See
+.MR groff_font @MAN5EXT@
+for details.
+.
+.
+.TP
+.B \-s
+Append a comment line to end of PDF showing statistics,
+i.e.\& number of pages in document.
+.
+Ghostscript's
+.B ps2pdf
+complains about this line if it is included, but works anyway.
+.
+.
+.TP
+.BR \-u \~[\c
+.IR cmap-file ]
+.I gropdf
+normally includes a ToUnicode CMap with any font created using
+.I text.enc
+as the encoding file,
+this makes it easier to search for words which contain ligatures.
+.
+You can include your own CMap by specifying a
+.I cmap-file
+or have no CMap at all by omitting the argument.
+.
+.
+.\" .TP
+.\" .BI \-w n
+.\" Lines should be drawn using a thickness of
+.\" .IR n \~\c
+.\" thousandths of an em.
+.\" .
+.\" If this option is not given, the line thickness defaults to
+.\" 0.04\~em.
+.\" .
+.\" .
+.TP
+.BI \-y " foundry"
+Set the foundry to use for selecting fonts of the same name.
+.
+.
+.\" ====================================================================
+.SH Usage
+.\" ====================================================================
+.
+The input to
+.I gropdf
+must be in the format output by
+.MR @g@troff @MAN1EXT@ .
+.
+This is described in
+.MR groff_out @MAN5EXT@ .
+.
+In addition, the device and font description files for the device used
+must meet certain requirements:
+.
+The resolution must be an integer multiple of\~72 times the
+.BR sizescale .
+.
+The
+.B pdf
+device uses a resolution of 72000 and a sizescale of 1000.
+.
+.
+.LP
+The device description file must contain a valid paper format;
+see
+.MR groff_font @MAN5EXT@ .
+.
+.I gropdf
+uses the same Type\~1 Adobe PostScript fonts as the
+.B grops
+device driver.
+.
+Although the PDF Standard allows the use of other font types (like
+TrueType) this implementation only accepts the Type\~1 PostScript
+font.
+.
+Fewer Type\~1 fonts are supported natively in PDF documents than the
+standard 35 fonts supported by
+.B grops
+and all PostScript printers, but all the fonts are available since any
+which aren't supported natively are automatically embedded in the
+PDF.
+.
+.
+.LP
+.I gropdf
+supports the concept of foundries,
+that is different versions of basically the same font.
+.
+During install a
+.I Foundry
+file controls where fonts are found and builds
+.I groff
+fonts from the files it discovers on your system.
+.
+.
+.LP
+Each font description file must contain a command
+.
+.IP
+.BI internalname\ psname
+.
+.LP
+which says that the PostScript name of the font is
+.IR psname .
+.
+Lines starting with
+.B #
+and blank lines are ignored.
+.
+The code for each character given in the font file must correspond
+to the code in the default encoding for the font.
+.
+This code can be used with the
+.B \[rs]N
+escape sequence in
+.B troff
+to select the character,
+even if the character does not have a
+.I groff
+name.
+.
+Every character in the font file must exist in the PostScript font, and
+the widths given in the font file must match the widths used
+in the PostScript font.
+.
+.
+.LP
+Note that
+.I gropdf
+is currently only able to display the first 256 glyphs in any font.
+This restriction will be lifted in a later version.
+.
+.
+.\" .LP
+.\" Note that
+.\" .B grops
+.\" is able to display all glyphs in a PostScript font, not only 256.
+.\" .I enc_file
+.\" (or the default encoding if no encoding file specified) just defines
+.\" the order of glyphs for the first 256 characters;
+.\" all other glyphs are accessed with additional encoding vectors which
+.\" .B grops
+.\" produces on the fly.
+.
+.
+.LP
+.I gropdf
+can automatically include the downloadable fonts necessary
+to print the document.
+.
+Fonts may be in PFA or PFB format.
+.LP
+.
+Any downloadable fonts which should, when required, be included by
+.I gropdf
+must be listed in the file
+.IR @FONTDIR@/\:\%devpdf/\:\%download ;
+this should consist of lines of the form
+.
+.IP
+.I
+foundry font filename
+.
+.LP
+where
+.I foundry
+is the foundry name or blank for the default foundry.
+.
+.I font
+is the PostScript name of the font,
+and
+.I filename
+is the name of the file containing the font;
+lines beginning with
+.B #
+and blank lines are ignored;
+fields must be separated by tabs
+(spaces are
+.B not
+allowed);
+.I filename
+is searched for using the same mechanism that is used
+for
+.I groff
+font metric files.
+.
+The
+.I download
+file itself is also sought using this mechanism.
+.
+Foundry names are usually a single character
+(such as \[oq]U\[cq] for the URW foundry)
+or empty for the default foundry.
+.
+This default uses the same fonts as
+.I ghostscript
+uses when it embeds fonts in a PDF file.
+.
+.
+.LP
+In the default setup there are styles called
+.BR R ,
+.BR I ,
+.BR B ,
+and
+.B BI
+mounted at font positions 1 to\~4.
+.
+The fonts are grouped into families
+.BR A ,
+.BR BM ,
+.BR C ,
+.BR H ,
+.BR HN ,
+.BR N ,
+.BR P ,
+and\~\c
+.B T
+having members in each of these styles:
+.
+.RS
+.TP
+.B AR
+.FT AR
+AvantGarde-Book
+.FT
+.
+.TQ
+.B AI
+.FT AI
+AvantGarde-BookOblique
+.FT
+.
+.TQ
+.B AB
+.FT AB
+AvantGarde-Demi
+.FT
+.
+.TQ
+.B ABI
+.FT ABI
+AvantGarde-DemiOblique
+.FT
+.
+.TQ
+.B BMR
+.FT BMR
+Bookman-Light
+.FT
+.
+.TQ
+.B BMI
+.FT BMI
+Bookman-LightItalic
+.FT
+.
+.TQ
+.B BMB
+.FT BMB
+Bookman-Demi
+.FT
+.
+.TQ
+.B BMBI
+.FT BMBI
+Bookman-DemiItalic
+.FT
+.
+.TQ
+.B CR
+.FT CR
+Courier
+.FT
+.
+.TQ
+.B CI
+.FT CI
+Courier-Oblique
+.FT
+.
+.TQ
+.B CB
+.FT CB
+Courier-Bold
+.FT
+.
+.TQ
+.B CBI
+.FT CBI
+Courier-BoldOblique
+.FT
+.
+.TQ
+.B HR
+.FT HR
+Helvetica
+.FT
+.
+.TQ
+.B HI
+.FT HI
+Helvetica-Oblique
+.FT
+.
+.TQ
+.B HB
+.FT HB
+Helvetica-Bold
+.FT
+.
+.TQ
+.B HBI
+.FT HBI
+Helvetica-BoldOblique
+.FT
+.
+.TQ
+.B HNR
+.FT HNR
+Helvetica-Narrow
+.FT
+.
+.TQ
+.B HNI
+.FT HNI
+Helvetica-Narrow-Oblique
+.FT
+.
+.TQ
+.B HNB
+.FT HNB
+Helvetica-Narrow-Bold
+.FT
+.
+.TQ
+.B HNBI
+.FT HNBI
+Helvetica-Narrow-BoldOblique
+.FT
+.
+.TQ
+.B NR
+.FT NR
+NewCenturySchlbk-Roman
+.FT
+.
+.TQ
+.B NI
+.FT NI
+NewCenturySchlbk-Italic
+.FT
+.
+.TQ
+.B NB
+.FT NB
+NewCenturySchlbk-Bold
+.FT
+.
+.TQ
+.B NBI
+.FT NBI
+NewCenturySchlbk-BoldItalic
+.FT
+.
+.TQ
+.B PR
+.FT PR
+Palatino-Roman
+.FT
+.
+.TQ
+.B PI
+.FT PI
+Palatino-Italic
+.FT
+.
+.TQ
+.B PB
+.FT PB
+Palatino-Bold
+.FT
+.
+.TQ
+.B PBI
+.FT PBI
+Palatino-BoldItalic
+.FT
+.
+.TQ
+.B TR
+.FT TR
+Times-Roman
+.FT
+.
+.TQ
+.B TI
+.FT TI
+Times-Italic
+.FT
+.
+.TQ
+.B TB
+.FT TB
+Times-Bold
+.FT
+.
+.TQ
+.B TBI
+.FT TBI
+Times-BoldItalic
+.FT
+.RE
+.
+.
+.LP
+There is also the following font which is not a member of a family:
+.
+.RS
+.TP
+.B ZCMI
+.FT ZCMI
+ZapfChancery-MediumItalic
+.FT
+.RE
+.
+.
+.LP
+There are also some special fonts called
+.B S
+for the PS Symbol font.
+.
+The lower case greek characters are automatically slanted (to match
+the SymbolSlanted font (SS) available to PostScript).
+.
+Zapf Dingbats is available as
+.BR ZD ;
+the \[lq]hand pointing left\[rq] glyph
+.RB ( \[rs][lh] )
+is available since it has been defined using the
+.B \[rs]X\[aq]pdf: xrev\[aq]
+device control command,
+which reverses the direction of letters within words.
+.
+.
+.LP
+The default color for
+.B \[rs]m
+and
+.B \[rs]M
+is black.
+.
+.
+.LP
+.I gropdf
+understands some of the device control commands supported by
+.MR grops 1 .
+.
+.
+.TP
+.B \[rs]X\[aq]ps: invis\[aq]
+Suppress output.
+.
+.
+.TP
+.B \[rs]X\[aq]ps: endinvis\[aq]
+Stop suppressing output.
+.
+.
+.TP
+.BI "\[rs]X\[aq]ps: exec gsave currentpoint 2 copy translate\~" n\~\c
+.B rotate neg exch neg exch translate\[aq]
+where
+.I n
+is the angle of rotation.
+.
+This is to support the
+.B align
+command in
+.MR @g@pic 1 .
+.
+.
+.TP
+.B \[rs]X\[aq]ps: exec grestore\[aq]
+Used by
+.MR @g@pic 1
+to restore state after rotation.
+.
+.
+.TP
+.BI "\[rs]X\[aq]ps: exec " "n\~" "setlinejoin\[aq]"
+where
+.I n
+can be one of the following values.
+.
+.
+.IP
+0 = Miter join
+.br
+1 = Round join
+.br
+2 = Bevel join
+.
+.
+.TP
+.BI "\[rs]X\[aq]ps: exec " "n " "setlinecap\[aq]"
+where
+.I n
+can be one of the following values.
+.
+.
+.IP
+0 = Butt cap
+.br
+1 = Round cap, and
+.br
+2 = Projecting square cap
+.
+.
+.LP
+.TP
+.BR "\[rs]X\[aq]ps:\~" .\|.\|.\& "\~pdfmark\[aq]"
+All the
+.I pdfmark
+macros installed by using
+.I \-m pdfmark
+or
+.I \-m mspdf
+(see documentation in
+.IR pdfmark.pdf ).
+.
+A subset of these macros are installed automatically when you use
+.B \-Tpdf
+so you should not need to use
+.RB \[lq] "\-m pdfmark" \[rq]
+to access most PDF functionality.
+.
+.
+.LP
+.I gropdf
+also supports a subset of the commands introduced in
+.IR present.tmac .
+.
+Specifically it supports:-
+.
+.
+.IP
+PAUSE
+.br
+BLOCKS
+.br
+BLOCKE
+.
+.
+.LP
+Which allows you to create presentation type PDFs.
+.
+Many of the other
+commands are already available in other macro packages.
+.
+.
+.LP
+These commands are implemented with
+.I groff
+X commands:-
+.
+.
+.LP
+.TP
+.B \[rs]X\[aq]ps: exec %%%%PAUSE\[aq]
+The section before this is treated as a block and is introduced using
+the current
+.B BLOCK
+transition setting
+(see
+.RB \[lq] "\[rs]X\[aq]pdf: transition\[aq]" \[rq]
+below).
+.
+Equivalently,
+.B \%.pdfpause
+is available as a macro.
+.TP
+.B \[rs]X\[aq]ps: exec %%%%BEGINONCE\[aq]
+Any text following this command (up to %%%%ENDONCE) is shown only once,
+the next %%%%PAUSE will remove it.
+If producing a non-presentation PDF, i.e.\&
+ignoring the pauses, see
+.I \%GROPDF_NOSLIDE
+below, this text is ignored.
+.LP
+.TP
+.B \[rs]X\[aq]ps: exec %%%%ENDONCE\[aq]
+This terminates the block defined by %%%%BEGINONCE.
+This pair of commands
+is what implements the \&.BLOCKS Once/.BLOCKE commands in
+.IR present.tmac .
+.
+.
+.LP
+The
+.I mom
+macro package already integrates these extensions,
+so you can build slides with
+.IR mom .
+.
+.
+.LP
+If you use
+.I present.tmac
+with
+.I gropdf
+there is no need to run the program
+.MR presentps @MAN1EXT@
+since the output will already be a presentation PDF.
+.
+.
+.LP
+All other
+.B ps:
+tags are silently ignored.
+.
+.
+.LP
+One
+.B \[rs]X
+device control command used by the DVI driver is also recognised.
+.
+.
+.TP
+.BI \[rs]X\[aq]papersize= paper-format \[aq]
+where the
+.I paper-format
+parameter is the same as that to the
+.B papersize
+directive.
+.
+See
+.MR groff_font @MAN5EXT@ .
+.
+This means that you can alter the page size at will within the PDF file
+being created by
+.IR gropdf .
+.
+If you do want to change the paper format,
+it must be done before you start creating the page.
+.
+.
+.LP
+.I gropdf
+supports several more device control features using the
+.B pdf:
+tag.
+.
+Some have counterpart
+.I convenience macros
+that take the same arguments and behave equivalently.
+.
+.
+.TP
+.BI "\[rs]X\[aq]pdf: pdfpic\~" file\~\c
+.IR "alignment width height line-length" \[aq]
+Place an image of the specified
+.I width
+containing the PDF drawing from file
+.I file
+of desired
+.I width
+and
+.I height
+(if
+.I height
+is missing or zero then it is scaled proportionally).
+.
+If
+.I alignment
+is
+.B \-L
+the drawing is left-aligned.
+.
+If it is
+.B \-C
+or
+.B \-R
+a
+.I line-length
+greater than the width of the drawing is required as well.
+.
+If
+.I width
+is specified as zero then the width is scaled in proportion to the
+height.
+.
+.\" .IP
+.\" See
+.\" .BR groff_tmac (@MAN7EXT@)
+.\" for a description of the
+.\" .B PSPIC
+.\" macro which provides a convenient high-level interface for inclusion
+.\" of PostScript graphics.
+.
+.TP
+.B \[rs]X\[aq]pdf: xrev\[aq]
+Toggle the reversal of glyph direction.
+.
+This feature works \[lq]letter by letter\[rq],
+that is,
+each letter in a word is reversed left-to-right,
+not the entire word.
+.
+One application is the reversal of glyphs in the Zapf Dingbats font.
+.
+To restore the normal glyph orientation,
+repeat the command.
+.
+.
+.TP
+.BI "\[rs]X\[aq]pdf: markstart " "/ANN-definition" \[aq]
+.TQ
+.B \[rs]X\[aq]pdf: markend\[aq]
+Macros that support PDF bookmarks use these calls internally to
+start and stop (respectively) the placement of the bookmark's
+.I hot spot;
+the user will have called
+.RB \[lq] .pdfhref\~L \[rq]
+with the text of the hot spot.
+.
+Normally,
+these are never used except from within the
+.I pdfmark
+macros.
+.
+.
+.TP
+.B \[rs]X\[aq]pdf: marksuspend\[aq]
+.TQ
+.B \[rs]X\[aq]pdf: markrestart\[aq]
+If you use a page location trap to produce a header or footer,
+or otherwise interrupt a document's text,
+you need to use these commands if a PDF
+.I hot spot
+crosses a trap boundary;
+otherwise any text output by the trap will be marked as part of the hot
+spot.
+.
+To prevent this error,
+place these device control commands or their corresponding
+convenience macros
+.B \%.pdfmarksuspend
+and
+.B \%.pdfmarkrestart
+at the start and end of the trap macro,
+respectively.
+.
+.
+.TP
+.BI "\[rs]X\[aq]pdf: pagename\~" name \[aq]
+Assign the current page a
+.IR name .
+.
+All documents bear two default names,
+.RB \[oq] top "\[cq] and \[oq]" bottom \[cq].
+.
+The convenience macro for this command is
+.BR \%.pdfpagename .
+.
+.
+.TP
+.BI "\[rs]X'pdf: switchtopage\~" "when name" \[aq]
+Normally each new page is appended to the end of the document,
+this command allows following pages to be inserted at a
+.I \[oq]named\[cq]
+position within the document (see pagename command above).
+.I \[oq]when\[cq]
+can be either
+.RI \[oq] after "\[cq] or \[oq]" before \[cq].
+If it is omitted it defaults to
+.RI \[oq] before \[cq].
+.
+It should be used at the end of the page before you want the switch to
+happen.
+.
+This allows pages such as a TOC to be moved to elsewhere in the
+document,
+but more esoteric uses are possible.
+.
+The convenience macro for this command is
+.BR \%.pdfswitchtopage .
+.
+.
+.TP
+.BI \[rs]X\[aq]pdf:\~transition\~ feature\~\c
+.IB "mode duration dimension motion direction scale bool" \[aq]
+where
+.I feature
+can be either SLIDE or BLOCK.
+When it is SLIDE the transition is used
+when a new slide is introduced to the screen,
+if BLOCK then this transition is used for the individual blocks which
+make up the slide.
+.
+.
+.IP
+.I mode
+is the transition type between slides:-
+.RS
+.IP
+.B Split
+- Two lines sweep across the screen, revealing the new page.
+The lines
+may be either horizontal or vertical and may move inward from the
+edges of the page or outward from the center, as specified by the
+.I dimension
+and
+.I motion
+entries, respectively.
+.br
+.B Blinds
+- Multiple lines, evenly spaced across the screen, synchronously
+sweep in the same direction to reveal the new page.
+The lines may be
+either horizontal or vertical, as specified by the
+.I dimension
+entry.
+Horizontal
+lines move downward; vertical lines move to the right.
+.br
+.B Box
+- A rectangular box sweeps inward from the edges of the page or
+outward from the center, as specified by the
+.I motion
+entry, revealing the new page.
+.br
+.B Wipe
+- A single line sweeps across the screen from one edge to the other in
+the direction specified by the
+.I direction
+entry, revealing the new page.
+.br
+.B Dissolve
+- The old page dissolves gradually to reveal the new one.
+.br
+.B Glitter
+- Similar to Dissolve,
+except that the effect sweeps across the page in a wide band moving from
+one side of the screen to the other in the direction specified by the
+.I direction
+entry.
+.br
+.B R
+- The new page simply replaces the old one with no special transition
+effect; the
+.I direction
+entry shall be ignored.
+.br
+.B Fly
+- (PDF 1.5) Changes are flown out or in (as specified by
+.IR motion ),
+in the
+direction specified by
+.IR direction ,
+to or from a location that is offscreen except
+when
+.I direction
+is
+.BR None .
+.br
+.B Push
+- (PDF 1.5) The old page slides off the screen while the new page
+slides in, pushing the old page out in the direction specified by
+.IR direction .
+.br
+.B Cover
+- (PDF 1.5) The new page slides on to the screen in the direction
+specified by
+.IR direction ,
+covering the old page.
+.br
+.B Uncover
+- (PDF 1.5) The old page slides off the screen in the direction
+specified by
+.IR direction ,
+uncovering the new page in the direction
+specified by
+.IR direction .
+.br
+.B Fade
+- (PDF 1.5) The new page gradually becomes visible through the
+old one.
+.LP
+.RE
+.IP
+.I duration
+is the length of the transition in seconds (default 1).
+.LP
+.IP
+.I dimension
+(Optional;
+.BR Split " and " Blinds
+transition styles only) The dimension in which the
+specified transition effect shall occur:
+.B H
+Horizontal, or
+.B V
+Vertical.
+.LP
+.IP
+.I motion
+(Optional;
+.BR Split ,
+.BR Box " and " Fly
+transition styles only) The direction of motion for
+the specified transition effect:
+.B I
+Inward from the edges of the page, or
+.B O
+Outward from the center of the page.
+.LP
+.IP
+.I direction
+(Optional;
+.BR Wipe ,
+.BR Glitter ,
+.BR Fly ,
+.BR Cover ,
+.BR Uncover " and " Push
+transition styles only)
+The direction in which the specified transition effect shall moves,
+expressed in degrees counterclockwise starting from a left-to-right
+direction.
+If the value is a number, it shall be one of:
+.B 0
+= Left to right,
+.B 90
+= Bottom to top (Wipe only),
+.B 180
+= Right to left (Wipe only),
+.B 270
+= Top to bottom,
+.B 315
+= Top-left to bottom-right (Glitter only)
+The value can be
+.BR None ,
+which is relevant only for the
+.B Fly
+transition when the value of
+.I scale
+is not 1.0.
+.LP
+.IP
+.I scale
+(Optional; PDF 1.5;
+.B Fly
+transition style only) The starting or ending scale at
+which the changes shall be drawn.
+If
+.I motion
+specifies an inward transition, the scale
+of the changes drawn shall progress from
+.I scale
+to 1.0 over the course of the
+transition.
+If
+.I motion
+specifies an outward transition, the scale of the changes drawn
+shall progress from 1.0 to
+.I scale
+over the course of the transition
+.LP
+.IP
+.I bool
+(Optional; PDF 1.5;
+.B Fly
+transition style only) If
+.BR true ,
+the area that shall be flown
+in is rectangular and opaque.
+.LP
+.IP
+This command can be used by calling the macro
+.B .pdftransition
+using the parameters described above.
+Any of the parameters may be
+replaced with a "." which signifies the parameter retains its
+previous value, also any trailing missing parameters are ignored.
+.LP
+.IP
+.B Note:
+not all PDF Readers support any or all these transitions.
+.LP
+.
+.
+.TP
+.BI "\eX\[aq]pdf: background\~" "cmd left top right bottom weight" \[aq]
+.TQ
+.B "\eX\[aq]pdf: background off\[aq]"
+.TQ
+.BI "\eX\[aq]pdf: background footnote\~" bottom \[aq]
+produces a background rectangle on the page,
+where
+.RS
+.TP
+.I cmd
+is the command,
+which can be any of
+.RB \[lq] page | fill | box \[rq]
+in combination.
+.
+Thus,
+.RB \[lq] pagefill \[rq]
+would draw a rectangle which covers the whole current page size
+(in which case the rest of the parameters can be omitted because the box
+dimensions are taken from the current media size).
+.
+.RB \[lq] boxfill \[rq],
+on the other hand,
+requires the given dimensions to place the box.
+.
+Including
+.RB \[lq] fill \[rq]
+in the command will paint the rectangle with the current fill colour
+(as with
+.BR \[rs]M[] )
+and including
+.RB \[lq] box \[rq]
+will give the rectangle a border in the current stroke colour
+(as with
+.BR \[rs]m[] ).
+.
+.
+.IP
+.I cmd
+may also be
+.RB \[lq] off \[rq]
+on its own,
+which will terminate drawing the current box.
+.
+If you have specified a page colour with
+.RB \[lq] pagefill \[rq],
+it is always the first box in the stack,
+and if you specify it again,
+it will replace the first entry.
+.
+Be aware that the
+.RB \[lq] pagefill \[rq]
+box renders the page opaque,
+so tools that \[lq]watermark\[rq] PDF pages are unlikely to be
+successful.
+.
+To return the background to transparent,
+issue an
+.RB \[lq] off \[rq]
+command with no other boxes open.
+.
+.
+.IP
+Finally,
+.I cmd
+may be
+.RB \[lq] footnote \[rq]
+followed by a new value for
+.IR bottom ,
+which will be used for all open boxes on the current page.
+This is to allow room for footnote areas that grow while a page is
+processed
+(to accommodate multiple footnotes,
+for instance).
+.
+(If the value is negative,
+it is used as an offset from the bottom of the page.)
+.
+.
+.TP
+.I left
+.TQ
+.I top
+.TQ
+.I right
+.TQ
+.I bottom
+are the coordinates of the box.
+.
+The
+.I top
+and
+.I bottom
+coordinates are the minimum and maximum for the box,
+since the actual start of the box is
+.IR groff 's
+drawing position when you issue the command,
+and the bottom of the box is the point where you turn the box
+.RB \[lq] off \[rq].
+.
+The top and bottom coordinates are used only if the box drawing extends
+onto the next page;
+ordinarily,
+they would be set to the header and footer margins.
+.
+.
+.TP
+.I weight
+provides the line width for the border if
+.RB \[lq] box \[rq]
+is included in the command.
+.
+.
+.P
+The convenience macro for this escape sequence is
+.BR .pdfbackground .
+.
+An
+.I sboxes
+macro file is also available;
+see
+.MR groff_tmac @MAN5EXT@ .
+.RE
+.
+.
+.\" ====================================================================
+.SS Macros
+.\" ====================================================================
+.
+.IR gropdf 's
+support macros in
+.I pdf\.tmac
+define the convenience macros described above.
+.
+Some features have no direct device control command counterpart.
+.
+.
+.\" pdfhref
+.
+.
+.TP
+.BI ".pdfinfo /" "field content"\~\c
+\&.\|.\|.
+Define PDF metadata.
+.
+.I field
+may be be one of
+.BR Title ,
+.BR Author ,
+.BR Subject ,
+.BR Keywords ,
+or another datum supported by the PDF standard or your reader.
+.
+.I field
+must be prefixed with a slash.
+.
+.
+.\" ====================================================================
+.SS "Importing graphics"
+.\" ====================================================================
+.
+.I gropdf
+supports only the inclusion of other PDF files for inline images.
+.
+Such a PDF file may,
+however,
+contain any of the graphic formats supported by
+the PDF standard,
+such as JPEG/JFIF,
+PNG,
+and GIF.
+.
+Any application that outputs PDF can thus be used to prepare files for
+embedding in documents processed by
+.I groff
+and
+.IR gropdf .
+.
+.
+.P
+The PDF file you wish to insert must be a single page and the drawing
+must just fit inside the media size of the PDF file.
+.
+In
+.MR inkscape 1
+or
+.MR gimp 1 ,
+for example,
+make sure the canvas size just fits the image.
+.
+.
+.P
+The PDF parser
+.I gropdf
+implements has not been rigorously tested with all applications that
+produce PDF.
+.
+If you find a single-page PDF which fails to import properly,
+try processing it with the
+.MR pdftk 1
+program.
+.
+.
+.RS
+.EX
+pdftk\~\c
+.I existing-file\~\c
+output\~\c
+.I new-file
+.EE
+.RE
+.
+You may find that
+.I new-file
+imports successfully.
+.
+.
+.\" ====================================================================
+.SS "TrueType and other font formats"
+.\" ====================================================================
+.
+.I gropdf
+does not yet support any font formats besides Adobe Type 1
+(PFA or PFB).
+.
+.
+.\" ====================================================================
+.SH "Font installation"
+.\" ====================================================================
+.
+The following is a step-by-step font installation guide for
+.I gropdf.
+.
+.
+.IP \[bu] 2n
+Convert your font to something
+.I groff
+understands.
+.
+This is a PostScript Type\~1 font in PFA or PFB format,
+together with an AFM file.
+.
+A PFA file begins as follows.
+.
+.RS
+.RS \" two RS calls to get inboard of IP indentation
+.EX
+%!PS\-AdobeFont\-1.0:
+.EE
+.RE \" but only one to get back to it
+.
+A PFB file contains this string as well,
+preceded by some non-printing bytes.
+.
+In the following steps,
+we will consider the use of CTAN's
+.UR https://\:ctan.org/\:tex\-archive/\:fonts/\:brushscr
+BrushScriptX-Italic
+.UE
+font in PFA format.
+.RE \" now restore left margin
+.
+.
+.IP \[bu]
+Convert the AFM file to a
+.I groff
+font description file with the
+.MR afmtodit @MAN1EXT@
+program.
+.
+For instance,
+.
+.RS
+.RS \" two RS calls to get inboard of IP indentation
+.EX
+$ \c
+.B afmtodit BrushScriptX\-Italic.afm text.map BSI
+.EE
+.RE \" but only one to get back to it
+.
+converts the Adobe Font Metric file
+.I BrushScriptX\-Italic.afm
+to the
+.I groff
+font description file
+.IR BSI .
+.RE \" now restore left margin
+.
+.
+.IP
+If you have a font family which provides regular upright (roman),
+bold,
+italic,
+and
+bold-italic styles,
+(where \[lq]italic\[rq] may be \[lq]oblique\[rq] or \[lq]slanted\[rq]),
+we recommend using
+.BR R ,
+.BR B ,
+.BR I ,
+and
+.BR BI ,
+respectively,
+as suffixes to the
+.I groff
+font family name to enable
+.IR groff 's
+font family and style selection features.
+.
+An example is
+.IR groff 's
+built-in support for Times:
+the font family
+name is abbreviated as
+.BR T ,
+and the
+.I groff
+font names are therefore
+.BR TR ,
+.BR TB ,
+.BR TI ,
+and
+.BR TBI .
+.
+In our example,
+however,
+the BrushScriptX font is available in a single style only,
+italic.
+.
+.
+.IP \[bu]
+Install the
+.I groff
+font description file(s) in a
+.I devpdf
+subdirectory in the search path that
+.I groff
+uses for device and font file descriptions.
+.
+See the
+.I GROFF_FONT_PATH
+entry in section \[lq]Environment\[rq] of
+.MR @g@troff @MAN1EXT@
+for the current value of the font search path.
+.
+While
+.I groff
+doesn't directly use AFM files,
+it is a good idea to store them alongside its font description files.
+.
+.
+.IP \[bu]
+Register fonts in the
+.I devpdf/download
+file so they can be located for embedding in PDF files
+.I gropdf
+generates.
+.
+Only the first
+.I download
+file encountered in the font search path is read.
+.
+If in doubt,
+copy the default
+.I download
+file
+(see section \[lq]Files\[rq] below)
+to the first directory in the font search path and add your fonts there.
+.
+The PostScript font name used by
+.I gropdf
+is stored in the
+.B internalname
+field in the
+.I groff
+font description file.
+.
+(This name does not necessarily resemble the font's file name.)
+.
+If the font in our example had originated from a foundry named
+.BR Z ,
+we would add the following line to
+.IR download .
+.
+.RS
+.RS \" two RS calls to get inboard of IP indentation
+.EX
+Z\[->]BrushScriptX\-Italic\[->]BrushScriptX\-Italic.pfa
+.EE
+.RE \" but only one to get back to it
+.
+A tab character,
+depicted as \[->],
+separates the fields.
+.
+The default foundry has no name:
+its field is empty and
+entries corresponding to it start with a tab character,
+as will the one in our example.
+.RE \" now restore left margin
+.
+.
+.IP \[bu]
+Test the selection and embedding of the new font.
+.
+.RS
+.RS \" two RS calls to get inboard of IP indentation
+.EX
+printf "\[rs]\[rs]f[BSI]Hello, world!\[rs]n" \
+| groff \-T pdf \-P \-e >hello.pdf
+see hello.pdf
+.EE
+.RE
+.RE
+.
+.
+.br
+.ne 5v
+.\" ====================================================================
+.SH Environment
+.\" ====================================================================
+.
+.TP
+.I GROFF_FONT_PATH
+A list of directories in which to seek the selected output device's
+directory of device and font description files.
+.
+If,
+in the
+.I download
+file,
+the font file has been specified with a full path,
+no directories are searched.
+.
+See
+.MR @g@troff @MAN1EXT@
+and
+.MR groff_font @MAN5EXT@ .
+.
+.
+.TP
+.I GROPDF_NOSLIDE
+If set and evaluates to a true value
+(to Perl),
+.\" XXX: The above is inconsistent with the way grotty(1) handles
+.\" "GROFF_NO_SGR".
+.I gropdf
+ignores commands specific to presentation PDFs,
+producing a normal PDF instead.
+.
+.
+.TP
+.I SOURCE_DATE_EPOCH
+A timestamp
+(expressed as seconds since the Unix epoch)
+to use as the output creation timestamp in place of the current time.
+.
+The time is converted to human-readable form using Perl's
+.I \%localtime()
+function and recorded in a PDF comment.
+.
+.
+.TP
+.I TZ
+The time zone to use when converting the current time
+(or value of
+.IR SOURCE_DATE_EPOCH )
+to human-readable form;
+see
+.MR tzset 3 .
+.
+.
+.\" ====================================================================
+.SH Files
+.\" ====================================================================
+.
+.TP
+.I @FONTDIR@/\:\%devpdf/\:DESC
+describes the
+.B pdf
+output device.
+.
+.
+.TP
+.IR @FONTDIR@/\:\%devpdf/ F
+describes the font known
+.RI as\~ F
+on device
+.BR pdf .
+.
+.
+.TP
+.IR @FONTDIR@/\:\%devpdf/\:U\- F
+describes the font
+from the URW foundry
+(versus the Adobe default)
+known
+.RI as\~ F
+on device
+.BR pdf .
+.
+.
+.TP
+.I @FONTDIR@/\:\%devpdf/\%download
+lists fonts available for embedding within the PDF document
+(by analogy to the
+.B ps
+device's downloadable font support).
+.
+.
+.\" XXX: Why are we shipping this but not BuildFoundries.pl?
+.TP
+.I @FONTDIR@/\:\%devpdf/\%Foundry
+is a data file used by the
+.I groff
+build system to locate PostScript Type\~1 fonts.
+.
+.
+.TP
+.I @FONTDIR@/\:\%devpdf/\:enc/\:\%text\:.enc
+describes the encoding scheme used by most PostScript Type\~1 fonts;
+the
+.B \%encoding
+directive of
+font description files for the
+.B pdf
+device refers to it.
+.
+.
+.TP
+.I @MACRODIR@/\:pdf\:.tmac
+defines macros for use with the
+.B pdf
+output device.
+.
+It is automatically loaded by
+.I troffrc
+when the
+.B pdf
+output device is selected.
+.
+.
+.TP
+.I @MACRODIR@/\:\%pdfpic\:.tmac
+defines the
+.B PDFPIC
+macro for embedding images in a document;
+see
+.MR groff_tmac @MAN5EXT@ .
+.
+It is automatically loaded by
+.I troffrc.
+.\"
+.\"
+.\" .TP
+.\" .B @MACRODIR@/pspic.tmac
+.\" Definition of
+.\" .B PSPIC
+.\" macro,
+.\" automatically loaded by
+.\" .BR ps.tmac .
+.\" .
+.
+.
+.\" ====================================================================
+.SH Authors
+.\" ====================================================================
+.
+.I gropdf
+was written and is maintained by
+.MT deri@\:chuzzlewit\:.myzen\:.co\:.uk
+Deri James
+.ME .
+.
+.
+.\" ====================================================================
+.SH "See also"
+.\" ====================================================================
+.
+.TP
+.I @DOCDIR@/\:\%sboxes/\:\%msboxes\:.ms
+.TQ
+.I @DOCDIR@/\:\%sboxes/\:\%msboxes\:.pdf
+\[lq]Using PDF boxes with
+.I groff
+and the
+.I ms
+macros\[rq],
+by Deri James.
+.
+.
+.TP
+.I present.tmac
+is part of
+.UR https://\:bob\:.diertens\:.org/\:corner/\:useful/\:gpresent/
+.I gpresent
+.UE ,
+a software package by Bob Diertens that works with
+.I groff
+to produce presentations
+(\[lq]foils\[rq],
+or \[lq]slide decks\[rq]).
+.
+.
+.P
+.MR afmtodit @MAN1EXT@ ,
+.MR groff @MAN1EXT@ ,
+.MR @g@troff @MAN1EXT@ ,
+.MR groff_font @MAN5EXT@ ,
+.MR groff_out @MAN5EXT@
+.\" Not actually referenced in above discussion.
+.\" .BR \%pfbtops (@MAN1EXT@),
+.\" .BR \%groff_tmac (@MAN5EXT@),
+.
+.
+.\" Clean up.
+.rm FT
+.
+.\" Restore compatibility mode (for, e.g., Solaris 10/11).
+.cp \n[*groff_gropdf_1_man_C]
+.do rr *groff_gropdf_1_man_C
+.
+.
+.\" Local Variables:
+.\" fill-column: 72
+.\" mode: nroff
+.\" End:
+.\" vim: set filetype=groff textwidth=72:
diff --git a/src/devices/gropdf/gropdf.am b/src/devices/gropdf/gropdf.am
new file mode 100644
index 0000000..3dbd865
--- /dev/null
+++ b/src/devices/gropdf/gropdf.am
@@ -0,0 +1,58 @@
+# Copyright (C) 2011-2020 Free Software Foundation, Inc.
+# Written by Deri James <deri@chuzzlewit.myzen.co.uk>
+# Automake migration by Bertrand Garrigues
+#
+# This file is part of groff.
+#
+# groff is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# groff is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+# for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+gropdf_dir = $(top_srcdir)/src/devices/gropdf
+
+bin_SCRIPTS += gropdf pdfmom
+EXTRA_DIST += \
+ src/devices/gropdf/TODO \
+ src/devices/gropdf/gropdf.pl \
+ src/devices/gropdf/pdfmom.pl \
+ src/devices/gropdf/gropdf.1.man \
+ src/devices/gropdf/pdfmom.1.man
+
+man1_MANS += \
+ src/devices/gropdf/gropdf.1 \
+ src/devices/gropdf/pdfmom.1
+
+gropdf: $(gropdf_dir)/gropdf.pl $(SH_DEPS_SED_SCRIPT)
+ $(AM_V_GEN)$(RM) $@ \
+ && sed -f $(SH_DEPS_SED_SCRIPT) \
+ -e "s|[@]VERSION[@]|$(VERSION)|" \
+ -e "s|[@]PERL[@]|$(PERL)|" \
+ -e "s|[@]GROFF_FONT_DIR[@]|$(fontpath)|" \
+ -e "s|[@]RT_SEP[@]|$(RT_SEP)|" $(gropdf_dir)/gropdf.pl \
+ >$@ \
+ && chmod +x $@
+
+pdfmom: $(gropdf_dir)/pdfmom.pl $(SH_DEPS_SED_SCRIPT)
+ $(AM_V_GEN)$(RM) $@ \
+ && sed -f $(SH_DEPS_SED_SCRIPT) \
+ -e "s|[@]VERSION[@]|$(VERSION)|" \
+ -e "s|[@]RT_SEP[@]|$(RT_SEP)|" \
+ -e "s|[@]PERL[@]|$(PERL)|" $(gropdf_dir)/pdfmom.pl \
+ >$@ \
+ && chmod +x $@
+
+
+# Local Variables:
+# fill-column: 72
+# mode: makefile-automake
+# End:
+# vim: set autoindent filetype=automake textwidth=72:
diff --git a/src/devices/gropdf/gropdf.pl b/src/devices/gropdf/gropdf.pl
new file mode 100644
index 0000000..c65a105
--- /dev/null
+++ b/src/devices/gropdf/gropdf.pl
@@ -0,0 +1,3928 @@
+#!@PERL@
+#
+# gropdf : PDF post processor for groff
+#
+# Copyright (C) 2011-2020 Free Software Foundation, Inc.
+# Written by Deri James <deri@chuzzlewit.myzen.co.uk>
+#
+# This file is part of groff.
+#
+# groff is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# groff is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+# for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+use Getopt::Long qw(:config bundling);
+
+use constant
+{
+ WIDTH => 0,
+ CHRCODE => 1,
+ PSNAME => 2,
+ ASSIGNED => 3,
+ USED => 4,
+};
+
+my $prog=$0;
+
+my $gotzlib=0;
+
+my $rc = eval
+{
+ require Compress::Zlib;
+ Compress::Zlib->import();
+ 1;
+};
+
+if($rc)
+{
+ $gotzlib=1;
+}
+else
+{
+ Warn("Perl module 'Compress::Zlib' not available; cannot compress"
+ . " this PDF");
+}
+
+my %cfg;
+
+$cfg{GROFF_VERSION}='@VERSION@';
+$cfg{GROFF_FONT_PATH}='@GROFF_FONT_DIR@';
+$cfg{RT_SEP}='@RT_SEP@';
+binmode(STDOUT);
+
+my @obj; # Array of PDF objects
+my $objct=0; # Count of Objects
+my $fct=0; # Output count
+my %fnt; # Used fonts
+my $lct=0; # Input Line Count
+my $src_name='';
+my %env; # Current environment
+my %fontlst; # Fonts Loaded
+my $rot=0; # Portrait
+my %desc; # Contents of DESC
+my %download; # Contents of downlopad file
+my $pages; # Pointer to /Pages object
+my $devnm='devpdf';
+my $cpage; # Pointer to current pages
+my $cpageno=0; # Object no of current page
+my $cat; # Pointer to catalogue
+my $dests; # Pointer to Dests
+my @mediabox=(0,0,595,842);
+my @defaultmb=(0,0,595,842);
+my $stream=''; # Current Text/Graphics stream
+my $cftsz=10; # Current font sz
+my $cft; # Current Font
+my $lwidth=1; # current linewidth
+my $linecap=1;
+my $linejoin=1;
+my $textcol=''; # Current groff text
+my $fillcol=''; # Current groff fill
+my $curfill=''; # Current PDF fill
+my $strkcol='';
+my $curstrk='';
+my @lin=(); # Array holding current line of text
+my @ahead=(); # Buffer used to hol the next line
+my $mode='g'; # Graphic (g) or Text (t) mode;
+my $xpos=0; # Current X position
+my $ypos=0; # Current Y position
+my $tmxpos=0;
+my $kernadjust=0;
+my $curkern=0;
+my $widtbl; # Pointer to width table for current font size
+my $origwidtbl; # Pointer to width table
+my $krntbl; # Pointer to kern table
+my $matrix="1 0 0 1";
+my $whtsz; # Current width of a space
+my $poschg=0; # V/H pending
+my $fontchg=0; # font change pending
+my $tnum=2; # flatness of B-Spline curve
+my $tden=3; # flatness of B-Spline curve
+my $linewidth=40;
+my $w_flg=0;
+my $nomove=0;
+my $pendmv=0;
+my $gotT=0;
+my $suppress=0; # Suppress processing?
+my %incfil; # Included Files
+my @outlev=([0,undef,0,0]); # Structure pdfmark /OUT entries
+my $curoutlev=\@outlev;
+my $curoutlevno=0; # Growth point for @curoutlev
+my $Foundry='';
+my $xrev=0; # Reverse x direction of font
+my $matrixchg=0;
+my $wt=-1;
+my $thislev=1;
+my $mark=undef;
+my $suspendmark=undef;
+my $boxmax=0;
+my %missing; # fonts in download files which are not found/readable
+
+
+
+my $n_flg=1;
+my $pginsert=-1; # Growth point for kids array
+my %pgnames; # 'names' of pages for switchtopage
+my @outlines=(); # State of Bookmark Outlines at end of each page
+my $custompaper=0; # Has there been an X papersize
+my $textenccmap=''; # CMap for groff text.enc encoding
+my @XOstream=();
+my @PageAnnots={};
+my $noslide=0;
+my $transition={PAGE => {Type => '/Trans', S => '', D => 1, Dm => '/H', M => '/I', Di => 0, SS => 1.0, B => 0},
+ BLOCK => {Type => '/Trans', S => '', D => 1, Dm => '/H', M => '/I', Di => 0, SS => 1.0, B => 0}};
+my $firstpause=0;
+my $present=0;
+my @bgstack; # Stack of background boxes
+my $bgbox=''; # Draw commands for boxes on this page
+
+$noslide=1 if exists($ENV{GROPDF_NOSLIDE}) and $ENV{GROPDF_NOSLIDE};
+
+my %ppsz=(
+ 'ledger'=>[1224,792],
+ 'legal'=>[612,1008],
+ 'letter'=>[612,792],
+ 'a0'=>[2384,3370],
+ 'a1'=>[1684,2384],
+ 'a2'=>[1191,1684],
+ 'a3'=>[842,1191],
+ 'a4'=>[595,842],
+ 'a5'=>[420,595],
+ 'a6'=>[297,420],
+ 'a7'=>[210,297],
+ 'a8'=>[148,210],
+ 'a9'=>[105,148],
+ 'a10'=>[73,105],
+ 'b0'=>[2835,4008],
+ 'b1'=>[2004,2835],
+ 'b2'=>[1417,2004],
+ 'b3'=>[1001,1417],
+ 'b4'=>[709,1001],
+ 'b5'=>[499,709],
+ 'b6'=>[354,499],
+ 'c0'=>[2599,3677],
+ 'c1'=>[1837,2599],
+ 'c2'=>[1298,1837],
+ 'c3'=>[918,1298],
+ 'c4'=>[649,918],
+ 'c5'=>[459,649],
+ 'c6'=>[323,459],
+ 'com10'=>[297,684],
+);
+
+my $ucmap=<<'EOF';
+/CIDInit /ProcSet findresource begin
+12 dict begin
+begincmap
+/CIDSystemInfo
+<< /Registry (Adobe)
+/Ordering (UCS)
+/Supplement 0
+>> def
+/CMapName /Adobe-Identity-UCS def
+/CMapType 2 def
+1 begincodespacerange
+<0000> <FFFF>
+endcodespacerange
+2 beginbfrange
+<008b> <008f> [<00660066> <00660069> <0066006c> <006600660069> <00660066006C>]
+<00ad> <00ad> <002d>
+endbfrange
+endcmap
+CMapName currentdict /CMap defineresource pop
+end
+end
+EOF
+
+sub usage
+{
+ my $stream = *STDOUT;
+ my $had_error = shift;
+ $stream = *STDERR if $had_error;
+ print $stream
+"usage: $prog [-dels] [-F font-directory] [-I inclusion-directory]" .
+" [-p paper-format] [-u [cmap-file]] [-y foundry] [file ...]\n" .
+"usage: $prog {-v | --version}\n" .
+"usage: $prog --help\n";
+ if (!$had_error)
+ {
+ print $stream "\n" .
+"Translate the output of troff(1) into Portable Document Format.\n" .
+"See the gropdf(1) manual page.\n";
+ }
+ exit($had_error);
+}
+
+my $fd;
+my $frot;
+my $fpsz;
+my $embedall=0;
+my $debug=0;
+my $want_help=0;
+my $version=0;
+my $stats=0;
+my $unicodemap;
+my @idirs;
+
+if (!GetOptions('F=s' => \$fd, 'I=s' => \@idirs, 'l' => \$frot,
+ 'p=s' => \$fpsz, 'd!' => \$debug, 'help' => \$want_help,
+ 'v' => \$version, 'version' => \$version,
+ 'e' => \$embedall, 'y=s' => \$Foundry, 's' => \$stats,
+ 'u:s' => \$unicodemap))
+{
+ &usage(1);
+}
+
+unshift(@idirs,'.');
+
+&usage(0) if ($want_help);
+
+if ($version)
+{
+ print "GNU gropdf (groff) version $cfg{GROFF_VERSION}\n";
+ exit;
+}
+
+if (defined($unicodemap))
+{
+ if ($unicodemap eq '')
+ {
+ $ucmap='';
+ }
+ elsif (-r $unicodemap)
+ {
+ local $/;
+ open(F,"<$unicodemap") or Die("failed to open '$unicodemap'");
+ ($ucmap)=(<F>);
+ close(F);
+ }
+ else
+ {
+ Warn("failed to find '$unicodemap'; ignoring");
+ }
+}
+
+# Search for 'font directory': paths in -f opt, shell var
+# GROFF_FONT_PATH, default paths
+
+my $fontdir=$cfg{GROFF_FONT_PATH};
+$fontdir=$ENV{GROFF_FONT_PATH}.$cfg{RT_SEP}.$fontdir if exists($ENV{GROFF_FONT_PATH});
+$fontdir=$fd.$cfg{RT_SEP}.$fontdir if defined($fd);
+
+$rot=90 if $frot;
+$matrix="0 1 -1 0" if $frot;
+
+LoadDownload();
+LoadDesc();
+
+my $unitwidth=$desc{unitwidth};
+
+$env{FontHT}=0;
+$env{FontSlant}=0;
+MakeMatrix();
+
+my $possiblesizes = $desc{papersize};
+$possiblesizes = $fpsz if $fpsz;
+my $papersz;
+for $papersz ( split(" ", lc($possiblesizes).' #duff#') )
+{
+ # No valid papersize found?
+ if ($papersz eq '#duff#')
+ {
+ Warn("ignoring unrecognized paper format(s) '$possiblesizes'");
+ last;
+ }
+
+ # Check for "/etc/papersize"
+ elsif (substr($papersz,0,1) eq '/' and -r $papersz)
+ {
+ if (open(P,"<$papersz"))
+ {
+ while (<P>)
+ {
+ chomp;
+ s/# .*//;
+ next if $_ eq '';
+ $papersz=lc($_);
+ last;
+ }
+ close(P);
+ }
+ }
+
+ # Allow height,width specified directly in centimeters, inches, or points.
+ if ($papersz=~m/([\d.]+)([cipP]),([\d.]+)([cipP])/)
+ {
+ @defaultmb=@mediabox=(0,0,ToPoints($3,$4),ToPoints($1,$2));
+ last;
+ }
+ # Look $papersz up as a name such as "a4" or "letter".
+ elsif (exists($ppsz{$papersz}))
+ {
+ @defaultmb=@mediabox=(0,0,$ppsz{$papersz}->[0],$ppsz{$papersz}->[1]);
+ last;
+ }
+ # Check for a landscape version
+ elsif (substr($papersz,-1) eq 'l' and exists($ppsz{substr($papersz,0,-1)}))
+ {
+ # Note 'legal' ends in 'l' but will be caught above
+ @defaultmb=@mediabox=(0,0,$ppsz{substr($papersz,0,-1)}->[1],$ppsz{substr($papersz,0,-1)}->[0]);
+ last;
+ }
+
+ # If we get here, $papersz was invalid, so try the next one.
+}
+
+my (@dt)=localtime($ENV{SOURCE_DATE_EPOCH} || time);
+my $dt=PDFDate(\@dt);
+
+my %info=('Creator' => "(groff version $cfg{GROFF_VERSION})",
+ 'Producer' => "(gropdf version $cfg{GROFF_VERSION})",
+ 'ModDate' => "($dt)",
+ 'CreationDate' => "($dt)");
+map { $_="< ".$_."\0" } @ARGV;
+
+while (<>)
+{
+ chomp;
+ s/\r$//;
+ $lct++;
+
+ do # The ahead buffer behaves like 'ungetc'
+ {{
+ if (scalar(@ahead))
+ {
+ $_=shift(@ahead);
+ }
+
+
+ my $cmd=substr($_,0,1);
+ next if $cmd eq '#'; # just a comment
+ my $lin=substr($_,1);
+
+ while ($cmd eq 'w')
+ {
+ $cmd=substr($lin,0,1);
+ $lin=substr($lin,1);
+ $w_flg=1 if $gotT;
+ }
+
+ $lin=~s/^\s+//;
+# $lin=~s/\s#.*?$//; # remove comment
+ $stream.="\% $_\n" if $debug;
+
+ do_x($lin),next if ($cmd eq 'x');
+ next if $suppress;
+ do_p($lin),next if ($cmd eq 'p');
+ do_f($lin),next if ($cmd eq 'f');
+ do_s($lin),next if ($cmd eq 's');
+ do_m($lin),next if ($cmd eq 'm');
+ do_D($lin),next if ($cmd eq 'D');
+ do_V($lin),next if ($cmd eq 'V');
+ do_v($lin),next if ($cmd eq 'v');
+ do_t($lin),next if ($cmd eq 't');
+ do_u($lin),next if ($cmd eq 'u');
+ do_C($lin),next if ($cmd eq 'C');
+ do_c($lin),next if ($cmd eq 'c');
+ do_N($lin),next if ($cmd eq 'N');
+ do_h($lin),next if ($cmd eq 'h');
+ do_H($lin),next if ($cmd eq 'H');
+ do_n($lin),next if ($cmd eq 'n');
+
+ my $tmp=scalar(@ahead);
+ }} until scalar(@ahead) == 0;
+
+}
+
+exit 0 if $lct==0;
+
+if ($cpageno > 0)
+{
+ my $trans='BLOCK';
+
+ $trans='PAGE' if $firstpause;
+
+ if (scalar(@XOstream))
+ {
+ MakeXO() if $stream;
+ $stream=join("\n",@XOstream)."\n";
+ }
+
+ my %t=%{$transition->{$trans}};
+ $cpage->{MediaBox}=\@mediabox if $custompaper;
+ $cpage->{Trans}=FixTrans(\%t) if $t{S};
+
+ if ($#PageAnnots >= 0)
+ {
+ @{$cpage->{Annots}}=@PageAnnots;
+ }
+
+ if ($#bgstack > -1 or $bgbox)
+ {
+ my $box="q 1 0 0 1 0 0 cm ";
+
+ foreach my $bg (@bgstack)
+ {
+ # 0=$bgtype # 1=stroke 2=fill. 4=page
+ # 1=$strkcol
+ # 2=$fillcol
+ # 3=(Left,Top,Right,bottom,LineWeight)
+ # 4=Start ypos
+ # 5=Endypos
+ # 6=Line Weight
+
+ my $pg=$bg->[3] || \@mediabox;
+
+ $bg->[5]=$pg->[3]; # box is continuing to next page
+ $box.=DrawBox($bg);
+ $bg->[4]=$pg->[1]; # will continue from page top
+ }
+
+ $stream=$box.$bgbox."Q\n".$stream;
+ $bgbox='';
+ }
+
+ $boxmax=0;
+ PutObj($cpageno);
+ OutStream($cpageno+1);
+}
+
+$cat->{PageMode}='/FullScreen' if $present;
+
+PutOutlines(\@outlev);
+
+PutObj(1);
+
+my $info=BuildObj(++$objct,\%info);
+
+PutObj($objct);
+
+foreach my $fontno (sort keys %fontlst)
+{
+ my $o=$fontlst{$fontno}->{FNT};
+
+ foreach my $ch (@{$o->{NO}})
+ {
+ my $psname=$o->{NAM}->{$ch->[1]}->[PSNAME] || '/.notdef';
+ my $wid=$o->{NAM}->{$ch->[1]}->[WIDTH] || 0;
+
+ push(@{$o->{DIFF}},$psname);
+ push(@{$o->{WIDTH}},$wid);
+ last if $#{$o->{DIFF}} >= 256;
+ }
+ unshift(@{$o->{DIFF}},0);
+ my $p=GetObj($fontlst{$fontno}->{OBJ});
+
+ if (exists($p->{LastChar}) and $p->{LastChar} > 255)
+ {
+ $p->{LastChar} = 255;
+ splice(@{$o->{DIFF}},257);
+ splice(@{$o->{WIDTH}},257);
+ }
+}
+
+foreach my $o (3..$objct)
+{
+ PutObj($o) if (!exists($obj[$o]->{XREF}));
+}
+
+#my $encrypt=BuildObj(++$objct,{'Filter' => '/Standard', 'V' => 1, 'R' => 2, 'P' => 252});
+#PutObj($objct);
+PutObj(2);
+
+my $xrefct=$fct;
+
+$objct+=1;
+print "xref\n0 $objct\n0000000000 65535 f \n";
+
+foreach my $xr (@obj)
+{
+ next if !defined($xr);
+ printf("%010d 00000 n \n",$xr->{XREF});
+}
+
+print "trailer\n<<\n/Info $info\n/Root 1 0 R\n/Size $objct\n>>\nstartxref\n$fct\n\%\%EOF\n";
+print "\% Pages=$pages->{Count}\n" if $stats;
+
+
+sub MakeMatrix
+{
+ my $fontxrev=shift||0;
+ my @mat=($frot)?(0,1,-1,0):(1,0,0,1);
+
+ if (!$frot)
+ {
+ if ($env{FontHT} != 0)
+ {
+ $mat[3]=sprintf('%.3f',$env{FontHT}/$cftsz);
+ }
+
+ if ($env{FontSlant} != 0)
+ {
+ my $slant=$env{FontSlant};
+ $slant*=$env{FontHT}/$cftsz if $env{FontHT} != 0;
+ my $ang=rad($slant);
+
+ $mat[2]=sprintf('%.3f',sin($ang)/cos($ang));
+ }
+
+ if ($fontxrev)
+ {
+ $mat[0]=-$mat[0];
+ }
+ }
+
+ $matrix=join(' ',@mat);
+ $matrixchg=1;
+}
+
+sub PutOutlines
+{
+ my $o=shift;
+ my $outlines;
+
+ if ($#{$o} > 0)
+ {
+ # We've got Outlines to deal with
+ my $openct=$curoutlev->[0]->[2];
+
+ while ($thislev-- > 1)
+ {
+ my $nxtoutlev=$curoutlev->[0]->[1];
+ $nxtoutlev->[0]->[2]+=$openct if $curoutlev->[0]->[3]==1;
+ $openct=0 if $nxtoutlev->[0]->[3]==-1;
+ $curoutlev=$nxtoutlev;
+ }
+
+ $cat->{Outlines}=BuildObj(++$objct,{'Count' => abs($o->[0]->[0])+$o->[0]->[2]});
+ $outlines=$obj[$objct]->{DATA};
+ }
+ else
+ {
+ return;
+ }
+
+ SetOutObj($o);
+
+ $outlines->{First}=$o->[1]->[2];
+ $outlines->{Last}=$o->[$#{$o}]->[2];
+
+ LinkOutObj($o,$cat->{Outlines});
+}
+
+sub SetOutObj
+{
+ my $o=shift;
+
+ for my $j (1..$#{$o})
+ {
+ my $ono=BuildObj(++$objct,$o->[$j]->[0]);
+ $o->[$j]->[2]=$ono;
+
+ SetOutObj($o->[$j]->[1]) if $#{$o->[$j]->[1]} > -1;
+ }
+}
+
+sub LinkOutObj
+{
+ my $o=shift;
+ my $parent=shift;
+
+ for my $j (1..$#{$o})
+ {
+ my $op=GetObj($o->[$j]->[2]);
+
+ $op->{Next}=$o->[$j+1]->[2] if ($j < $#{$o});
+ $op->{Prev}=$o->[$j-1]->[2] if ($j > 1);
+ $op->{Parent}=$parent;
+
+ if ($#{$o->[$j]->[1]} > -1)
+ {
+ $op->{Count}=$o->[$j]->[1]->[0]->[2]*$o->[$j]->[1]->[0]->[3];# if exists($op->{Count}) and $op->{Count} > 0;
+ $op->{First}=$o->[$j]->[1]->[1]->[2];
+ $op->{Last}=$o->[$j]->[1]->[$#{$o->[$j]->[1]}]->[2];
+ LinkOutObj($o->[$j]->[1],$o->[$j]->[2]);
+ }
+ }
+}
+
+sub GetObj
+{
+ my $ono=shift;
+ ($ono)=split(' ',$ono);
+ return($obj[$ono]->{DATA});
+}
+
+
+
+sub PDFDate
+{
+ my $dt=shift;
+ return(sprintf("D:%04d%02d%02d%02d%02d%02d%+03d'00'",$dt->[5]+1900,$dt->[4]+1,$dt->[3],$dt->[2],$dt->[1],$dt->[0],( localtime time() + 3600*( 12 - (gmtime)[2] ) )[2] - 12));
+}
+
+sub ToPoints
+{
+ my $num=shift;
+ my $unit=shift;
+
+ if ($unit eq 'i')
+ {
+ return($num*72);
+ }
+ elsif ($unit eq 'c')
+ {
+ return int($num*72/2.54);
+ }
+ elsif ($unit eq 'm') # millimetres
+ {
+ return int($num*72/25.4);
+ }
+ elsif ($unit eq 'p')
+ {
+ return($num);
+ }
+ elsif ($unit eq 'P')
+ {
+ return($num*6);
+ }
+ elsif ($unit eq 'z')
+ {
+ return($num/$unitwidth);
+ }
+ else
+ {
+ Die("invalid scaling unit '$unit'");
+ }
+}
+
+sub LoadDownload
+{
+ my $f;
+ my $found=0;
+
+ my (@dirs)=split($cfg{RT_SEP},$fontdir);
+
+ foreach my $dir (@dirs)
+ {
+ $f=undef;
+ OpenFile(\$f,$dir,"download");
+ next if !defined($f);
+ $found++;
+
+ while (<$f>)
+ {
+ chomp;
+ s/#.*$//;
+ next if $_ eq '';
+ my ($foundry,$name,$file)=split(/\t+/);
+ if (substr($file,0,1) eq '*')
+ {
+ next if !$embedall;
+ $file=substr($file,1);
+ }
+
+ my $pth=$file;
+ $pth=$dir."/$devnm/$file" if substr($file,0,1) ne '/';
+
+ if (!-r $pth)
+ {
+ $missing{"$foundry $name"}="$dir/$devnm";
+ next;
+ }
+
+ $download{"$foundry $name"}=$file if !exists($download{"$foundry $name"});
+ }
+
+ close($f);
+ }
+
+ Die("failed to open 'download' file") if !$found;
+}
+
+sub OpenFile
+{
+ my $f=shift;
+ my $dirs=shift;
+ my $fnm=shift;
+
+ if (substr($fnm,0,1) eq '/' or substr($fnm,1,1) eq ':') # dos
+ {
+ return if -r "$fnm" and open($$f,"<$fnm");
+ }
+
+ my (@dirs)=split($cfg{RT_SEP},$dirs);
+
+ foreach my $dir (@dirs)
+ {
+ last if -r "$dir/$devnm/$fnm" and open($$f,"<$dir/$devnm/$fnm");
+ }
+}
+
+sub LoadDesc
+{
+ my $f;
+
+ OpenFile(\$f,$fontdir,"DESC");
+ Die("failed to open device description file 'DESC'")
+ if !defined($f);
+
+ while (<$f>)
+ {
+ chomp;
+ s/#.*$//;
+ next if $_ eq '';
+ my ($name,$prms)=split(' ',$_,2);
+ $desc{lc($name)}=$prms;
+ }
+
+ close($f);
+
+ foreach my $directive ('unitwidth', 'res', 'sizescale')
+ {
+ Die("device description file 'DESC' missing mandatory directive"
+ . " '$directive'") if !exists($desc{$directive});
+ }
+
+ foreach my $directive ('unitwidth', 'res', 'sizescale')
+ {
+ my $val=$desc{$directive};
+ Die("device description file 'DESC' directive '$directive'"
+ . " value must be positive; got '$val'")
+ if ($val !~ m/^\d+$/ or $val <= 0);
+ }
+
+ if (exists($desc{'hor'}))
+ {
+ my $hor=$desc{'hor'};
+ Die("device horizontal motion quantum must be 1, got '$hor'")
+ if ($hor != 1);
+ }
+
+ if (exists($desc{'vert'}))
+ {
+ my $vert=$desc{'vert'};
+ Die("device vertical motion quantum must be 1, got '$vert'")
+ if ($vert != 1);
+ }
+
+ my ($res,$ss)=($desc{'res'},$desc{'sizescale'});
+ Die("device resolution must be a multiple of 72*sizescale, got"
+ . " '$res' ('sizescale'=$ss)") if (($res % ($ss * 72)) != 0);
+}
+
+sub rad { $_[0]*3.14159/180 }
+
+my $InPicRotate=0;
+
+sub do_x
+{
+ my $l=shift;
+ my ($xcmd,@xprm)=split(' ',$l);
+ $xcmd=substr($xcmd,0,1);
+
+ if ($xcmd eq 'T')
+ {
+ Warn("expecting a PDF pipe (got $xprm[0])")
+ if $xprm[0] ne substr($devnm,3);
+ }
+ elsif ($xcmd eq 'f') # Register Font
+ {
+ $xprm[1]="${Foundry}-$xprm[1]" if $Foundry ne '';
+ LoadFont($xprm[0],$xprm[1]);
+ }
+ elsif ($xcmd eq 'F') # Source File (for errors)
+ {
+ $env{SourceFile}=$xprm[0];
+ }
+ elsif ($xcmd eq 'H') # FontHT
+ {
+ $xprm[0]/=$unitwidth;
+ $xprm[0]=0 if $xprm[0] == $cftsz;
+ $env{FontHT}=$xprm[0];
+ MakeMatrix();
+ }
+ elsif ($xcmd eq 'S') # FontSlant
+ {
+ $env{FontSlant}=$xprm[0];
+ MakeMatrix();
+ }
+ elsif ($xcmd eq 'i') # Initialise
+ {
+ if ($objct == 0)
+ {
+ $objct++;
+ @defaultmb=@mediabox;
+ BuildObj($objct,{'Pages' => BuildObj($objct+1,
+ {'Kids' => [],
+ 'Count' => 0,
+ 'Type' => '/Pages',
+ 'Rotate' => $rot,
+ 'MediaBox' => \@defaultmb,
+ 'Resources' =>
+ {'Font' => {},
+ 'ProcSet' => ['/PDF', '/Text', '/ImageB', '/ImageC', '/ImageI']}
+ }
+ ),
+ 'Type' => '/Catalog'});
+
+ $cat=$obj[$objct]->{DATA};
+ $objct++;
+ $pages=$obj[2]->{DATA};
+ Put("%PDF-1.4\n\x25\xe2\xe3\xcf\xd3\n");
+ }
+ }
+ elsif ($xcmd eq 'X')
+ {
+ # There could be extended args
+ do
+ {{
+ LoadAhead(1);
+ if (substr($ahead[0],0,1) eq '+')
+ {
+ $l.="\n".substr($ahead[0],1);
+ shift(@ahead);
+ }
+ }} until $#ahead==0;
+
+ ($xcmd,@xprm)=split(' ',$l);
+ $xcmd=substr($xcmd,0,1);
+
+ if ($xprm[0]=~m/^(.+:)(.+)/)
+ {
+ splice(@xprm,1,0,$2);
+ $xprm[0]=$1;
+ }
+
+ my $par=join(' ',@xprm[1..$#xprm]);
+
+ if ($xprm[0] eq 'ps:')
+ {
+ if ($xprm[1] eq 'invis')
+ {
+ $suppress=1;
+ }
+ elsif ($xprm[1] eq 'endinvis')
+ {
+ $suppress=0;
+ }
+ elsif ($par=~m/exec gsave currentpoint 2 copy translate (.+) rotate neg exch neg exch translate/)
+ {
+ # This is added by gpic to rotate a single object
+
+ my $theta=-rad($1);
+
+ IsGraphic();
+ my ($curangle,$hyp)=RtoP($xpos,GraphY($ypos));
+ my ($x,$y)=PtoR($theta+$curangle,$hyp);
+ my ($tx, $ty) = ($xpos - $x, GraphY($ypos) - $y);
+ if ($frot) {
+ ($tx, $ty) = ($tx * sin($theta) + $ty * -cos($theta),
+ $tx * -cos($theta) + $ty * -sin($theta));
+ }
+ $stream.="q\n".sprintf("%.3f %.3f %.3f %.3f %.3f %.3f cm",cos($theta),sin($theta),-sin($theta),cos($theta),$tx,$ty)."\n";
+ $InPicRotate=1;
+ }
+ elsif ($par=~m/exec grestore/ and $InPicRotate)
+ {
+ IsGraphic();
+ $stream.="Q\n";
+ $InPicRotate=0;
+ }
+ elsif ($par=~m/exec (\d) setlinejoin/)
+ {
+ IsGraphic();
+ $linejoin=$1;
+ $stream.="$linejoin j\n";
+ }
+ elsif ($par=~m/exec (\d) setlinecap/)
+ {
+ IsGraphic();
+ $linecap=$1;
+ $stream.="$linecap J\n";
+ }
+ elsif ($par=~m/exec %%%%PAUSE/i and !$noslide)
+ {
+ my $trans='BLOCK';
+
+ if ($firstpause)
+ {
+ $trans='PAGE';
+ $firstpause=0;
+ }
+ MakeXO();
+ NewPage($trans);
+ $present=1;
+ }
+ elsif ($par=~m/exec %%%%BEGINONCE/)
+ {
+ if ($noslide)
+ {
+ $suppress=1;
+ }
+ else
+ {
+ my $trans='BLOCK';
+
+ if ($firstpause)
+ {
+ $trans='PAGE';
+ $firstpause=0;
+ }
+ MakeXO();
+ NewPage($trans);
+ $present=1;
+ }
+ }
+ elsif ($par=~m/exec %%%%ENDONCE/)
+ {
+ if ($noslide)
+ {
+ $suppress=0;
+ }
+ else
+ {
+ MakeXO();
+ NewPage('BLOCK');
+ $cat->{PageMode}='/FullScreen';
+ pop(@XOstream);
+ }
+ }
+ elsif ($par=~m/\[(.+) pdfmark/)
+ {
+ my $pdfmark=$1;
+ $pdfmark=~s((\d{4,6}) u)(sprintf("%.1f",$1/$desc{sizescale}))eg;
+ $pdfmark=~s(\\\[u00(..)\])(chr(hex($1)))eg;
+ $pdfmark=~s/\\n/\n/g;
+
+ if ($pdfmark=~m/(.+) \/DOCINFO\s*$/s)
+ {
+ my @xwds=split(/ /,"<< $1 >>");
+ my $docinfo=ParsePDFValue(\@xwds);
+
+ foreach my $k (sort keys %{$docinfo})
+ {
+ $info{$k}=$docinfo->{$k} if $k ne 'Producer';
+ }
+ }
+ elsif ($pdfmark=~m/(.+) \/DOCVIEW\s*$/)
+ {
+ my @xwds=split(' ',"<< $1 >>");
+ my $docview=ParsePDFValue(\@xwds);
+
+ foreach my $k (sort keys %{$docview})
+ {
+ $cat->{$k}=$docview->{$k} if !exists($cat->{$k});
+ }
+ }
+ elsif ($pdfmark=~m/(.+) \/DEST\s*$/)
+ {
+ my @xwds=split(' ',"<< $1 >>");
+ my $dest=ParsePDFValue(\@xwds);
+ $dest->{View}->[1]=GraphY($dest->{View}->[1]*-1);
+ unshift(@{$dest->{View}},"$cpageno 0 R");
+
+ if (!defined($dests))
+ {
+ $cat->{Dests}=BuildObj(++$objct,{});
+ $dests=$obj[$objct]->{DATA};
+ }
+
+ my $k=substr($dest->{Dest},1);
+ $dests->{$k}=$dest->{View};
+ }
+ elsif ($pdfmark=~m/(.+) \/ANN\s*$/)
+ {
+ my $l=$1;
+ $l=~s/Color/C/;
+ $l=~s/Action/A/;
+ $l=~s/Title/T/;
+ $l=~s'/Subtype /URI'/S /URI';
+ my @xwds=split(' ',"<< $l >>");
+ my $annotno=BuildObj(++$objct,ParsePDFValue(\@xwds));
+ my $annot=$obj[$objct];
+ $annot->{DATA}->{Type}='/Annot';
+ FixRect($annot->{DATA}->{Rect}); # Y origin to ll
+ FixPDFColour($annot->{DATA});
+ push(@PageAnnots,$annotno);
+ }
+ elsif ($pdfmark=~m/(.+) \/OUT\s*$/)
+ {
+ my $t=$1;
+ $t=~s/\\\) /\\\\\) /g;
+ $t=~s/\\e/\\\\/g;
+ $t=~m/(^.*\/Title \()(.*)(\).*)/;
+ my ($pre,$title,$post)=($1,$2,$3);
+ $title=~s/(?<!\\)\(/\\\(/g;
+ $title=~s/(?<!\\)\)/\\\)/g;
+ my @xwds=split(' ',"<< $pre$title$post >>");
+ my $out=ParsePDFValue(\@xwds);
+
+ my $this=[$out,[]];
+
+ if (exists($out->{Level}))
+ {
+ my $lev=abs($out->{Level});
+ my $levsgn=sgn($out->{Level});
+ delete($out->{Level});
+
+ if ($lev > $thislev)
+ {
+ my $thisoutlev=$curoutlev->[$#{$curoutlev}]->[1];
+ $thisoutlev->[0]=[0,$curoutlev,0,$levsgn];
+ $curoutlev=$thisoutlev;
+ $curoutlevno=$#{$curoutlev};
+ $thislev++;
+ }
+ elsif ($lev < $thislev)
+ {
+ my $openct=$curoutlev->[0]->[2];
+
+ while ($thislev > $lev)
+ {
+ my $nxtoutlev=$curoutlev->[0]->[1];
+ $nxtoutlev->[0]->[2]+=$openct if $curoutlev->[0]->[3]==1;
+ $openct=0 if $nxtoutlev->[0]->[3]==-1;
+ $curoutlev=$nxtoutlev;
+ $thislev--;
+ }
+
+ $curoutlevno=$#{$curoutlev};
+ }
+
+# push(@{$curoutlev},$this);
+ splice(@{$curoutlev},++$curoutlevno,0,$this);
+ $curoutlev->[0]->[2]++;
+ }
+ else
+ {
+ # This code supports old pdfmark.tmac, unused by pdf.tmac
+ while ($curoutlev->[0]->[0] == 0 and defined($curoutlev->[0]->[1]))
+ {
+ $curoutlev=$curoutlev->[0]->[1];
+ }
+
+ $curoutlev->[0]->[0]--;
+ $curoutlev->[0]->[2]++;
+ push(@{$curoutlev},$this);
+
+
+ if (exists($out->{Count}) and $out->{Count} != 0)
+ {
+ push(@{$this->[1]},[abs($out->{Count}),$curoutlev,0,sgn($out->{Count})]);
+ $curoutlev=$this->[1];
+
+ if ($out->{Count} > 0)
+ {
+ my $p=$curoutlev;
+
+ while (defined($p))
+ {
+ $p->[0]->[2]+=$out->{Count};
+ $p=$p->[0]->[1];
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ elsif (lc($xprm[0]) eq 'pdf:')
+ {
+ if (lc($xprm[1]) eq 'import')
+ {
+ my $fil=$xprm[2];
+ my $llx=$xprm[3];
+ my $lly=$xprm[4];
+ my $urx=$xprm[5];
+ my $ury=$xprm[6];
+ my $wid=GetPoints($xprm[7]);
+ my $hgt=GetPoints($xprm[8])||-1;
+ my $mat=[1,0,0,1,0,0];
+
+ if (!exists($incfil{$fil}))
+ {
+ if ($fil=~m/\.pdf$/)
+ {
+ $incfil{$fil}=LoadPDF($fil,$mat,$wid,$hgt,"import");
+ }
+ elsif ($fil=~m/\.swf$/)
+ {
+ my $xscale=$wid/($urx-$llx+1);
+ my $yscale=($hgt<=0)?$xscale:($hgt/($ury-$lly+1));
+ $hgt=($ury-$lly+1)*$yscale;
+
+ if ($rot)
+ {
+ $mat->[3]=$xscale;
+ $mat->[0]=$yscale;
+ }
+ else
+ {
+ $mat->[0]=$xscale;
+ $mat->[3]=$yscale;
+ }
+
+ $incfil{$fil}=LoadSWF($fil,[$llx,$lly,$urx,$ury],$mat);
+ }
+ else
+ {
+ Warn("unrecognized 'import' file type '$fil'");
+ return undef;
+ }
+ }
+
+ if (defined($incfil{$fil}))
+ {
+ IsGraphic();
+ if ($fil=~m/\.pdf$/)
+ {
+ my $bbox=$incfil{$fil}->[1];
+ my $xscale=d3($wid/($bbox->[2]-$bbox->[0]+1));
+ my $yscale=d3(($hgt<=0)?$xscale:($hgt/($bbox->[3]-$bbox->[1]+1)));
+ $wid=($bbox->[2]-$bbox->[0])*$xscale;
+ $hgt=($bbox->[3]-$bbox->[1])*$yscale;
+ $ypos+=$hgt;
+ $stream.="q $xscale 0 0 $yscale ".PutXY($xpos,$ypos)." cm";
+ $stream.=" 0 1 -1 0 0 0 cm" if $rot;
+ $stream.=" /$incfil{$fil}->[0] Do Q\n";
+ }
+ elsif ($fil=~m/\.swf$/)
+ {
+ $stream.=PutXY($xpos,$ypos)." m /$incfil{$fil} Do\n";
+ }
+ }
+ }
+ elsif (lc($xprm[1]) eq 'pdfpic')
+ {
+ my $fil=$xprm[2];
+ my $flag=uc($xprm[3]||'-L');
+ my $wid=GetPoints($xprm[4])||-1;
+ my $hgt=GetPoints($xprm[5]||-1);
+ my $ll=GetPoints($xprm[6]||0);
+ my $mat=[1,0,0,1,0,0];
+
+ if (!exists($incfil{$fil}))
+ {
+ $incfil{$fil}=LoadPDF($fil,$mat,$wid,$hgt,"pdfpic");
+ }
+
+ if (defined($incfil{$fil}))
+ {
+ IsGraphic();
+ my $bbox=$incfil{$fil}->[1];
+ $wid=($bbox->[2]-$bbox->[0]) if $wid <= 0;
+ my $xscale=d3($wid/($bbox->[2]-$bbox->[0]));
+ my $yscale=d3(($hgt<=0)?$xscale:($hgt/($bbox->[3]-$bbox->[1])));
+ $xscale=($wid<=0)?$yscale:$xscale;
+ $xscale=$yscale if $yscale < $xscale;
+ $yscale=$xscale if $xscale < $yscale;
+ $wid=($bbox->[2]-$bbox->[0])*$xscale;
+ $hgt=($bbox->[3]-$bbox->[1])*$yscale;
+
+ if ($flag eq '-C' and $ll > $wid)
+ {
+ $xpos+=int(($ll-$wid)/2);
+ }
+ elsif ($flag eq '-R' and $ll > $wid)
+ {
+ $xpos+=$ll-$wid;
+ }
+
+ $ypos+=$hgt;
+ $stream.="q $xscale 0 0 $yscale ".PutXY($xpos,$ypos)." cm";
+ $stream.=" 0 1 -1 0 0 0 cm" if $rot;
+ $stream.=" /$incfil{$fil}->[0] Do Q\n";
+ }
+ }
+ elsif (lc($xprm[1]) eq 'xrev')
+ {
+ $xrev=!$xrev;
+ }
+ elsif (lc($xprm[1]) eq 'markstart')
+ {
+ $mark={'rst' => ($xprm[2]+$xprm[4])/$unitwidth, 'rsb' => ($xprm[3]-$xprm[4])/$unitwidth, 'xpos' => $xpos-($xprm[4]/$unitwidth),
+ 'ypos' => $ypos, 'lead' => $xprm[4]/$unitwidth, 'pdfmark' => join(' ',@xprm[5..$#xprm])};
+ }
+ elsif (lc($xprm[1]) eq 'markend')
+ {
+ PutHotSpot($xpos) if defined($mark);
+ $mark=undef;
+ }
+ elsif (lc($xprm[1]) eq 'marksuspend')
+ {
+ $suspendmark=$mark;
+ $mark=undef;
+ }
+ elsif (lc($xprm[1]) eq 'markrestart')
+ {
+ $mark=$suspendmark;
+ $suspendmark=undef;
+ }
+ elsif (lc($xprm[1]) eq 'pagename')
+ {
+ if ($pginsert > -1)
+ {
+ $pgnames{$xprm[2]}=$pages->{Kids}->[$pginsert];
+ }
+ else
+ {
+ $pgnames{$xprm[2]}='top';
+ }
+ }
+ elsif (lc($xprm[1]) eq 'switchtopage')
+ {
+ my $ba=$xprm[2];
+ my $want=$xprm[3];
+
+ if ($pginsert > -1)
+ {
+ if (!defined($want) or $want eq '')
+ {
+ # no before/after
+ $want=$ba;
+ $ba='before';
+ }
+
+ if (!defined($ba) or $ba eq '' or $want eq 'bottom')
+ {
+ $pginsert=$#{$pages->{Kids}};
+ }
+ elsif ($want eq 'top')
+ {
+ $pginsert=-1;
+ }
+ else
+ {
+ if (exists($pgnames{$want}))
+ {
+ my $ref=$pgnames{$want};
+
+ if ($ref eq 'top')
+ {
+ $pginsert=-1;
+ }
+ else
+ {
+ FIND: while (1)
+ {
+ foreach my $j (0..$#{$pages->{Kids}})
+ {
+ if ($ref eq $pages->{Kids}->[$j])
+ {
+ if ($ba eq 'before')
+ {
+ $pginsert=$j-1;
+ last FIND;
+ }
+ elsif ($ba eq 'after')
+ {
+ $pginsert=$j;
+ last FIND;
+ }
+ else
+ {
+ # XXX: indentation wince
+ Warn(
+"expected 'switchtopage' parameter to be one of"
+. "'top|bottom|before|after', got '$ba'");
+ last FIND;
+ }
+ }
+
+ }
+
+ Warn("cannot find page ref '$ref'");
+ last FIND
+
+ }
+ }
+ }
+ else
+ {
+ Warn("cannot find page named '$want'");
+ }
+ }
+
+ if ($pginsert < 0)
+ {
+ ($curoutlev,$curoutlevno,$thislev)=(\@outlev,0,1);
+ }
+ else
+ {
+ ($curoutlev,$curoutlevno,$thislev)=(@{$outlines[$pginsert]});
+ }
+ }
+ }
+ elsif (lc($xprm[1]) eq 'transition' and !$noslide)
+ {
+ if (uc($xprm[2]) eq 'PAGE' or uc($xprm[2] eq 'SLIDE'))
+ {
+ $transition->{PAGE}->{S}='/'.ucfirst($xprm[3]) if $xprm[3] and $xprm[3] ne '.';
+ $transition->{PAGE}->{D}=$xprm[4] if $xprm[4] and $xprm[4] ne '.';
+ $transition->{PAGE}->{Dm}='/'.$xprm[5] if $xprm[5] and $xprm[5] ne '.';
+ $transition->{PAGE}->{M}='/'.$xprm[6] if $xprm[6] and $xprm[6] ne '.';
+ $xprm[7]='/None' if $xprm[7] and uc($xprm[7]) eq 'NONE';
+ $transition->{PAGE}->{Di}=$xprm[7] if $xprm[7] and $xprm[7] ne '.';
+ $transition->{PAGE}->{SS}=$xprm[8] if $xprm[8] and $xprm[8] ne '.';
+ $transition->{PAGE}->{B}=$xprm[9] if $xprm[9] and $xprm[9] ne '.';
+ }
+ elsif (uc($xprm[2]) eq 'BLOCK')
+ {
+ $transition->{BLOCK}->{S}='/'.ucfirst($xprm[3]) if $xprm[3] and $xprm[3] ne '.';
+ $transition->{BLOCK}->{D}=$xprm[4] if $xprm[4] and $xprm[4] ne '.';
+ $transition->{BLOCK}->{Dm}='/'.$xprm[5] if $xprm[5] and $xprm[5] ne '.';
+ $transition->{BLOCK}->{M}='/'.$xprm[6] if $xprm[6] and $xprm[6] ne '.';
+ $xprm[7]='/None' if $xprm[7] and uc($xprm[7]) eq 'NONE';
+ $transition->{BLOCK}->{Di}=$xprm[7] if $xprm[7] and $xprm[7] ne '.';
+ $transition->{BLOCK}->{SS}=$xprm[8] if $xprm[8] and $xprm[8] ne '.';
+ $transition->{BLOCK}->{B}=$xprm[9] if $xprm[9] and $xprm[9] ne '.';
+ }
+
+ $present=1;
+ }
+ elsif (lc($xprm[1]) eq 'background')
+ {
+ splice(@xprm,0,2);
+ my $type=shift(@xprm);
+# print STDERR "ypos=$ypos\n";
+
+ if (lc($type) eq 'off')
+ {
+ my $sptr=$#bgstack;
+ if ($sptr > -1)
+ {
+ if ($sptr == 0 and $bgstack[0]->[0] & 4)
+ {
+ pop(@bgstack);
+ }
+ else
+ {
+ $bgstack[$sptr]->[5]=GraphY($ypos);
+ $bgbox=DrawBox(pop(@bgstack)).$bgbox;
+ }
+ }
+ }
+ elsif (lc($type) eq 'footnote')
+ {
+ my $t=GetPoints($xprm[0]);
+ $boxmax=($t<0)?abs($t):GraphY($t);
+ }
+ else
+ {
+ my $bgtype=0;
+
+ foreach (@xprm)
+ {
+ $_=GetPoints($_);
+ }
+
+ $bgtype|=2 if $type=~m/box/i;
+ $bgtype|=1 if $type=~m/fill/i;
+ $bgtype|=4 if $type=~m/page/i;
+ $bgtype=5 if $bgtype==4;
+ my $bgwt=$xprm[4];
+ $bgwt=$xprm[0] if !defined($bgwt) and $#xprm == 0;
+ my (@bg)=(@xprm);
+ my $bg=\@bg;
+
+ if (!defined($bg[3]) or $bgtype & 4)
+ {
+ $bg=undef;
+ }
+ else
+ {
+ FixRect($bg);
+ }
+
+ if ($bgtype)
+ {
+ if ($bgtype & 4)
+ {
+ shift(@bgstack) if $#bgstack >= 0 and $bgstack[0]->[0] & 4;
+ unshift(@bgstack,[$bgtype,$strkcol,$fillcol,$bg,GraphY($ypos),GraphY($bg[3]||0),$bgwt || 0.4]);
+ }
+ else
+ {
+ push(@bgstack,[$bgtype,$strkcol,$fillcol,$bg,GraphY($ypos),GraphY($bg[3]||0),$bgwt || 0.4]);
+ }
+ }
+ }
+ }
+ }
+ elsif (lc(substr($xprm[0],0,9)) eq 'papersize')
+ {
+ my ($px,$py)=split(',',substr($xprm[0],10));
+ $px=GetPoints($px);
+ $py=GetPoints($py);
+ @mediabox=(0,0,$px,$py);
+ my @mb=@mediabox;
+ $matrixchg=1;
+ $custompaper=1;
+ $cpage->{MediaBox}=\@mb;
+ }
+ }
+}
+
+sub FixPDFColour
+{
+ my $o=shift;
+ my $a=$o->{C};
+ my @r=();
+ my $c=$a->[0];
+
+ if ($#{$a}==3)
+ {
+ if ($c > 1)
+ {
+ foreach my $j (0..2)
+ {
+ push(@r,sprintf("%1.3f",$a->[$j]/0xffff));
+ }
+
+ $o->{C}=\@r;
+ }
+ }
+ elsif (substr($c,0,1) eq '#')
+ {
+ if (length($c) == 7)
+ {
+ foreach my $j (0..2)
+ {
+ push(@r,sprintf("%1.3f",hex(substr($c,$j*2+1,2))/0xff));
+ }
+
+ $o->{C}=\@r;
+ }
+ elsif (length($c) == 14)
+ {
+ foreach my $j (0..2)
+ {
+ push(@r,sprintf("%1.3f",hex(substr($c,$j*4+2,4))/0xffff));
+ }
+
+ $o->{C}=\@r;
+ }
+ }
+}
+
+sub PutHotSpot
+{
+ my $endx=shift;
+ my $l=$mark->{pdfmark};
+ $l=~s/Color/C/;
+ $l=~s/Action/A/;
+ $l=~s'/Subtype /URI'/S /URI';
+ $l=~s(\\\[u00(..)\])(chr(hex($1)))eg;
+ my @xwds=split(' ',"<< $l >>");
+ my $annotno=BuildObj(++$objct,ParsePDFValue(\@xwds));
+ my $annot=$obj[$objct];
+ $annot->{DATA}->{Type}='/Annot';
+ $annot->{DATA}->{Rect}=[$mark->{xpos},$mark->{ypos}-$mark->{rsb},$endx+$mark->{lead},$mark->{ypos}-$mark->{rst}];
+ FixPDFColour($annot->{DATA});
+ FixRect($annot->{DATA}->{Rect}); # Y origin to ll
+ push(@PageAnnots,$annotno);
+}
+
+sub sgn
+{
+ return(1) if $_[0] > 0;
+ return(-1) if $_[0] < 0;
+ return(0);
+}
+
+sub FixRect
+{
+ my $rect=shift;
+
+ return if !defined($rect);
+ $rect->[1]=GraphY($rect->[1]);
+ $rect->[3]=GraphY($rect->[3]);
+
+ if ($rot)
+ {
+ ($rect->[0],$rect->[1])=Rotate($rect->[0],$rect->[1]);
+ ($rect->[2],$rect->[3])=Rotate($rect->[2],$rect->[3]);
+ }
+}
+
+sub Rotate
+{
+ my ($tx,$ty)=(@_);
+ my $theta=rad($rot);
+
+ ($tx,$ty)=(d3($tx * cos(-$theta) - $ty * sin(-$theta)),
+ d3($tx * sin( $theta) + $ty * cos( $theta)));
+ return($tx,$ty);
+}
+
+sub GetPoints
+{
+ my $val=shift;
+
+ $val=ToPoints($1,$2) if ($val and $val=~m/(-?[\d.]+)([cipnz])/);
+
+ return $val;
+}
+
+# Although the PDF reference mentions XObject/Form as a way of
+# incorporating an external PDF page into the current PDF, it seems not
+# to work with any current PDF reader (although I am told (by Leonard
+# Rosenthol, who helped author the PDF ISO standard) that Acroread 9
+# does support it, empirical observation shows otherwise!!). So... do
+# it the hard way - full PDF parser and merge required objects!!!
+
+# sub BuildRef
+# {
+# my $fil=shift;
+# my $bbox=shift;
+# my $mat=shift;
+# my $wid=($bbox->[2]-$bbox->[0])*$mat->[0];
+# my $hgt=($bbox->[3]-$bbox->[1])*$mat->[3];
+#
+# if (!open(PDF,"<$fil"))
+# {
+# Warn("failed to open '$fil'");
+# return(undef);
+# }
+#
+# my (@f)=(<PDF>);
+#
+# close(PDF);
+#
+# $objct++;
+# my $xonm="XO$objct";
+#
+# $pages->{'Resources'}->{'XObject'}->{$xonm}=BuildObj($objct,{'Type' => '/XObject',
+# 'Subtype' => '/Form',
+# 'BBox' => $bbox,
+# 'Matrix' => $mat,
+# 'Resources' => $pages->{'Resources'},
+# 'Ref' => {'Page' => '1',
+# 'F' => BuildObj($objct+1,{'Type' => '/Filespec',
+# 'F' => "($fil)",
+# 'EF' => {'F' => BuildObj($objct+2,{'Type' => '/EmbeddedFile'})}
+# })
+# }
+# });
+#
+# $obj[$objct]->{STREAM}="q 1 0 0 1 0 0 cm
+# q BT
+# 1 0 0 1 0 0 Tm
+# .5 g .5 G
+# /F5 20 Tf
+# (Proxy) Tj
+# ET Q
+# 0 0 m 72 0 l s
+# Q\n";
+#
+# # $obj[$objct]->{STREAM}=PutXY($xpos,$ypos)." m ".PutXY($xpos+$wid,$ypos)." l ".PutXY($xpos+$wid,$ypos+$hgt)." l ".PutXY($xpos,$ypos+$hgt)." l f\n";
+# $obj[$objct+2]->{STREAM}=join('',@f);
+# PutObj($objct);
+# PutObj($objct+1);
+# PutObj($objct+2);
+# $objct+=2;
+# return($xonm);
+# }
+
+sub LoadSWF
+{
+ my $fil=shift;
+ my $bbox=shift;
+ my $mat=shift;
+ my $wid=($bbox->[2]-$bbox->[0])*$mat->[0];
+ my $hgt=($bbox->[3]-$bbox->[1])*$mat->[3];
+ my (@path)=split('/',$fil);
+ my $node=pop(@path);
+
+ if (!open(PDF,"<$fil"))
+ {
+ Warn("failed to open SWF '$fil'");
+ return(undef);
+ }
+
+ my (@f)=(<PDF>);
+
+ close(PDF);
+
+ $objct++;
+ my $xonm="XO$objct";
+
+ $pages->{'Resources'}->{'XObject'}->{$xonm}=BuildObj($objct,{'Type' => '/XObject', 'BBox' => $bbox, 'Matrix' => $mat, 'FormType' => 1, 'Subtype' => '/Form', 'Length' => 0, 'Type' => "/XObject"});
+ $obj[$objct]->{STREAM}='';
+ PutObj($objct);
+ $objct++;
+ my $asset=BuildObj($objct,{'EF' => {'F' => BuildObj($objct+1,{})},
+ 'F' => "($node)",
+ 'Type' => '/Filespec',
+ 'UF' => "($node)"});
+
+ PutObj($objct);
+ $objct++;
+ $obj[$objct]->{STREAM}=join('',@f);
+ PutObj($objct);
+ $objct++;
+ my $config=BuildObj($objct,{'Instances' => [BuildObj($objct+1,{'Params' => { 'Binding' => '/Background'}, 'Asset' => $asset})],
+ 'Subtype' => '/Flash'});
+
+ PutObj($objct);
+ $objct++;
+ PutObj($objct);
+ $objct++;
+
+ my ($x,$y)=split(' ',PutXY($xpos,$ypos));
+
+ push(@{$cpage->{Annots}},BuildObj($objct,{'RichMediaContent' => {'Subtype' => '/Flash', 'Configurations' => [$config], 'Assets' => {'Names' => [ "($node)", $asset ] }},
+ 'P' => "$cpageno 0 R",
+ 'RichMediaSettings' => { 'Deactivation' => { 'Condition' => '/PI',
+ 'Type' => '/RichMediaDeactivation'},
+ 'Activation' => { 'Condition' => '/PV',
+ 'Type' => '/RichMediaActivation'}},
+ 'F' => 68,
+ 'Subtype' => '/RichMedia',
+ 'Type' => '/Annot',
+ 'Rect' => "[ $x $y ".($x+$wid)." ".($y+$hgt)." ]",
+ 'Border' => [0,0,0]}));
+
+ PutObj($objct);
+
+ return $xonm;
+}
+
+sub OpenInc
+{
+ my $fn=shift;
+ my $fnm=$fn;
+ my $F;
+
+ if (substr($fnm,0,1) eq '/' or substr($fnm,1,1) eq ':') # dos
+ {
+ if (-r $fnm and open($F,"<$fnm"))
+ {
+ return($F,$fnm);
+ }
+ }
+ else
+ {
+ foreach my $dir (@idirs)
+ {
+ $fnm="$dir/$fn";
+
+ if (-r "$fnm" and open($F,"<$fnm"))
+ {
+ return($F,$fnm);
+ }
+ }
+ }
+
+ return(undef,$fn);
+}
+
+sub LoadPDF
+{
+ my $pdfnm=shift;
+ my $mat=shift;
+ my $wid=shift;
+ my $hgt=shift;
+ my $type=shift;
+ my $pdf;
+ my $pdftxt='';
+ my $strmlen=0;
+ my $curobj=-1;
+ my $instream=0;
+ my $cont;
+ my $adj=0;
+ my $keepsep=$/;
+
+ my ($PD,$PDnm)=OpenInc($pdfnm);
+
+ if (!defined($PD))
+ {
+ Warn("failed to open PDF '$pdfnm'");
+ return undef;
+ }
+
+ my $hdr=<$PD>;
+
+ $/="\r",$adj=1 if (length($hdr) > 10);
+
+ while (<$PD>)
+ {
+ chomp;
+
+ s/\n//;
+
+ if (m/endstream(\s+.*)?$/)
+ {
+ $instream=0;
+ $_="endstream";
+ $_.=$1 if defined($1)
+ }
+
+ next if $instream;
+
+ if (m'/Length\s+(\d+)(\s+\d+\s+R)?')
+ {
+ if (!defined($2))
+ {
+ $strmlen=$1;
+ }
+ else
+ {
+ $strmlen=0;
+ }
+ }
+
+ if (m'^(\d+) \d+ obj')
+ {
+ $curobj=$1;
+ $pdf->[$curobj]->{OBJ}=undef;
+ }
+
+ if (m'stream\s*$' and ! m/^endstream/)
+ {
+ if ($curobj > -1)
+ {
+ $pdf->[$curobj]->{STREAMPOS}=[tell($PD)+$adj,$strmlen];
+ seek($PD,$strmlen,1);
+ $instream=1;
+ }
+ else
+ {
+ Warn("parsing PDF '$pdfnm' failed");
+ return undef;
+ }
+ }
+
+ s/%.*?$//;
+ $pdftxt.=$_.' ';
+ }
+
+ close($PD);
+
+ open(PD,"<$PDnm");
+# $pdftxt=~s/\]/ \]/g;
+ my (@pdfwds)=split(' ',$pdftxt);
+ my $wd;
+ my $root;
+
+ while ($wd=nextwd(\@pdfwds),length($wd))
+ {
+ if ($wd=~m/\d+/ and defined($pdfwds[1]) and $pdfwds[1]=~m/^obj(.*)/)
+ {
+ $curobj=$wd;
+ shift(@pdfwds); shift(@pdfwds);
+ unshift(@pdfwds,$1) if defined($1) and length($1);
+ $pdf->[$curobj]->{OBJ}=ParsePDFObj(\@pdfwds);
+ my $o=$pdf->[$curobj];
+
+ if (ref($o->{OBJ}) eq 'HASH' and exists($o->{OBJ}->{Type}) and $o->{OBJ}->{Type} eq '/ObjStm')
+ {
+ LoadStream($o,$pdf);
+ my $pos=$o->{OBJ}->{First};
+ my $s=$o->{STREAM};
+ my @o=split(' ',substr($s,0,$pos));
+ substr($s,0,$pos)='';
+ push(@o,-1,length($s));
+
+ for (my $j=0; $j<=$#o-2; $j+=2)
+ {
+ my @w=split(' ',substr($s,$o[$j+1],$o[$j+3]-$o[$j+1]));
+ $pdf->[$o[$j]]->{OBJ}=ParsePDFObj(\@w);
+ }
+
+ $pdf->[$curobj]=undef;
+ }
+
+ $root=$curobj if ref($pdf->[$curobj]->{OBJ}) eq 'HASH' and exists($pdf->[$curobj]->{OBJ}->{Type}) and $pdf->[$curobj]->{OBJ}->{Type} eq '/XRef';
+ }
+ elsif ($wd eq 'trailer' and !exists($pdf->[0]->{OBJ}))
+ {
+ $pdf->[0]->{OBJ}=ParsePDFObj(\@pdfwds);
+ }
+ else
+ {
+# print "Skip '$wd'\n";
+ }
+ }
+
+ $pdf->[0]=$pdf->[$root] if !defined($pdf->[0]);
+ my $catalog=${$pdf->[0]->{OBJ}->{Root}};
+ my $page=FindPage(1,$pdf);
+ my $xobj=++$objct;
+
+ # Load the streamas
+
+ foreach my $o (@{$pdf})
+ {
+ if (exists($o->{STREAMPOS}) and !exists($o->{STREAM}))
+ {
+ LoadStream($o,$pdf);
+ }
+ }
+
+ close(PD);
+
+ # Find BBox
+ my $BBox;
+ my $insmap={};
+
+ foreach my $k (qw( ArtBox TrimBox BleedBox CropBox MediaBox ))
+ {
+ $BBox=FindKey($pdf,$page,$k);
+ last if $BBox;
+ }
+
+ $BBox=[0,0,595,842] if !defined($BBox);
+
+ $wid=($BBox->[2]-$BBox->[0]+1) if $wid==0;
+ my $xscale=d3(abs($wid)/($BBox->[2]-$BBox->[0]+1));
+ my $yscale=d3(($hgt<=0)?$xscale:(abs($hgt)/($BBox->[3]-$BBox->[1]+1)));
+ $hgt=($BBox->[3]-$BBox->[1]+1)*$yscale;
+
+ if ($type eq "import")
+ {
+ $mat->[0]=$xscale;
+ $mat->[3]=$yscale;
+ }
+
+ # Find Resource
+
+ my $res=FindKey($pdf,$page,'Resources');
+ my $xonm="XO$xobj";
+
+ # Map inserted objects to current PDF
+
+ MapInsValue($pdf,$page,'',$insmap,$xobj,$pdf->[$page]->{OBJ});
+#
+# Many PDFs include 'Resources' at the 'Page' level but if 'Resources' is held at a higher level (i.e 'Pages')
+# then we need to include its objects as well.
+#
+ MapInsValue($pdf,$page,'',$insmap,$xobj,$res) if !exists($pdf->[$page]->{OBJ}->{Resources});
+
+ # Copy Resources
+
+ my %incres=%{$res};
+
+ $incres{ProcSet}=['/PDF', '/Text', '/ImageB', '/ImageC', '/ImageI'];
+
+ ($mat->[4],$mat->[5])=split(' ',PutXY($xpos,$ypos));
+ $pages->{'Resources'}->{'XObject'}->{$xonm}=BuildObj($xobj,{'Type' => '/XObject', 'BBox' => $BBox, 'Name' => "/$xonm", 'FormType' => 1, 'Subtype' => '/Form', 'Length' => 0, 'Type' => "/XObject", 'Resources' => \%incres});
+
+ if ($BBox->[0] != 0 or $BBox->[1] != 0)
+ {
+ my (@matrix)=(1,0,0,1,-$BBox->[0],-$BBox->[1]);
+ $obj[$xobj]->{DATA}->{Matrix}=\@matrix;
+ }
+
+ BuildStream($xobj,$pdf,$pdf->[$page]->{OBJ}->{Contents});
+
+ $/=$keepsep;
+ return([$xonm,$BBox] );
+}
+
+sub LoadStream
+{
+ my $o=shift;
+ my $pdf=shift;
+ my $l;
+
+ $l=$o->{OBJ}->{Length} if exists($o->{OBJ}->{Length});
+
+ $l=$pdf->[$$l]->{OBJ} if (defined($l) && ref($l) eq 'OBJREF');
+
+ Die("unable to determine length of stream \@$o->{STREAMPOS}->[0]")
+ if !defined($l);
+
+ sysseek(PD,$o->{STREAMPOS}->[0],0);
+ Warn("failed to read all of the stream")
+ if $l != sysread(PD,$o->{STREAM},$l);
+
+ if ($gotzlib and exists($o->{OBJ}->{'Filter'}) and $o->{OBJ}->{'Filter'} eq '/FlateDecode')
+ {
+ $o->{STREAM}=Compress::Zlib::uncompress($o->{STREAM});
+ delete($o->{OBJ }->{'Filter'});
+ }
+}
+
+sub BuildStream
+{
+ my $xobj=shift;
+ my $pdf=shift;
+ my $val=shift;
+ my $strm='';
+ my $objs;
+ my $refval=ref($val);
+
+ if ($refval eq 'OBJREF')
+ {
+ push(@{$objs}, $val);
+ }
+ elsif ($refval eq 'ARRAY')
+ {
+ $objs=$val;
+ }
+ else
+ {
+ Warn("unexpected 'Contents'");
+ }
+
+ foreach my $o (@{$objs})
+ {
+ $strm.="\n" if $strm;
+ $strm.=$pdf->[$$o]->{STREAM} if exists($pdf->[$$o]->{STREAM});
+ }
+
+ $obj[$xobj]->{STREAM}=$strm;
+}
+
+
+sub MapInsHash
+{
+ my $pdf=shift;
+ my $o=shift;
+ my $insmap=shift;
+ my $parent=shift;
+ my $val=shift;
+
+
+ foreach my $k (sort keys(%{$val}))
+ {
+ MapInsValue($pdf,$o,$k,$insmap,$parent,$val->{$k}) if $k ne 'Contents';
+ }
+}
+
+sub MapInsValue
+{
+ my $pdf=shift;
+ my $o=shift;
+ my $k=shift;
+ my $insmap=shift;
+ my $parent=shift;
+ my $val=shift;
+ my $refval=ref($val);
+
+ if ($refval eq 'OBJREF')
+ {
+ if ($k ne 'Parent')
+ {
+ if (!exists($insmap->{IMP}->{$$val}))
+ {
+ $objct++;
+ $insmap->{CUR}->{$objct}=$$val;
+ $insmap->{IMP}->{$$val}=$objct;
+ $obj[$objct]->{DATA}=$pdf->[$$val]->{OBJ};
+ $obj[$objct]->{STREAM}=$pdf->[$$val]->{STREAM} if exists($pdf->[$$val]->{STREAM});
+ MapInsValue($pdf,$$val,'',$insmap,$o,$pdf->[$$val]->{OBJ});
+ }
+
+ $$val=$insmap->{IMP}->{$$val};
+ }
+ else
+ {
+ $$val=$parent;
+ }
+ }
+ elsif ($refval eq 'ARRAY')
+ {
+ foreach my $v (@{$val})
+ {
+ MapInsValue($pdf,$o,'',$insmap,$parent,$v)
+ }
+ }
+ elsif ($refval eq 'HASH')
+ {
+ MapInsHash($pdf,$o,$insmap,$parent,$val);
+ }
+
+}
+
+sub FindKey
+{
+ my $pdf=shift;
+ my $page=shift;
+ my $k=shift;
+
+ if (exists($pdf->[$page]->{OBJ}->{$k}))
+ {
+ my $val=$pdf->[$page]->{OBJ}->{$k};
+ $val=$pdf->[$$val]->{OBJ} if ref($val) eq 'OBJREF';
+ return($val);
+ }
+ else
+ {
+ if (exists($pdf->[$page]->{OBJ}->{Parent}))
+ {
+ return(FindKey($pdf,${$pdf->[$page]->{OBJ}->{Parent}},$k));
+ }
+ }
+
+ return(undef);
+}
+
+sub FindPage
+{
+ my $wantpg=shift;
+ my $pdf=shift;
+ my $catalog=${$pdf->[0]->{OBJ}->{Root}};
+ my $pages=${$pdf->[$catalog]->{OBJ}->{Pages}};
+
+ return(NextPage($pdf,$pages,\$wantpg));
+}
+
+sub NextPage
+{
+ my $pdf=shift;
+ my $pages=shift;
+ my $wantpg=shift;
+ my $ret;
+
+ if ($pdf->[$pages]->{OBJ}->{Type} eq '/Pages')
+ {
+ foreach my $kid (@{$pdf->[$pages]->{OBJ}->{Kids}})
+ {
+ $ret=NextPage($pdf,$$kid,$wantpg);
+ last if $$wantpg<=0;
+ }
+ }
+ elsif ($pdf->[$pages]->{OBJ}->{Type} eq '/Page')
+ {
+ $$wantpg--;
+ $ret=$pages;
+ }
+
+ return($ret);
+}
+
+sub nextwd
+{
+ my $pdfwds=shift;
+
+ my $wd=shift(@{$pdfwds});
+
+ return('') if !defined($wd);
+
+ if ($wd=~m/^(.*?)(<<|>>|(?:(?<!\\)\[|\]))(.*)/)
+ {
+ if (defined($1) and length($1))
+ {
+ unshift(@{$pdfwds},$3) if defined($3) and length($3);
+ unshift(@{$pdfwds},$2);
+ $wd=$1;
+ }
+ else
+ {
+ unshift(@{$pdfwds},$3) if defined($3) and length($3);
+ $wd=$2;
+ }
+ }
+
+ return($wd);
+}
+
+sub ParsePDFObj
+{
+
+ my $pdfwds=shift;
+ my $rtn;
+ my $wd;
+
+ while ($wd=nextwd($pdfwds),length($wd))
+ {
+ if ($wd eq 'stream' or $wd eq 'endstream')
+ {
+ next;
+ }
+ elsif ($wd eq 'endobj' or $wd eq 'startxref')
+ {
+ last;
+ }
+ else
+ {
+ unshift(@{$pdfwds},$wd);
+ $rtn=ParsePDFValue($pdfwds);
+ }
+ }
+
+ return($rtn);
+}
+
+sub ParsePDFHash
+{
+ my $pdfwds=shift;
+ my $rtn={};
+ my $wd;
+
+ while ($wd=nextwd($pdfwds),length($wd))
+ {
+ if ($wd eq '>>')
+ {
+ last;
+ }
+
+ my (@w)=split('/',$wd,3);
+
+ if ($w[0])
+ {
+ Warn("PDF Dict Key '$wd' does not start with '/'");
+ exit 1;
+ }
+ else
+ {
+ unshift(@{$pdfwds},"/$w[2]") if $w[2];
+ $wd=$w[1];
+ (@w)=split('\(',$wd,2);
+ $wd=$w[0];
+ unshift(@{$pdfwds},"($w[1]") if defined($w[1]);
+ (@w)=split('\<',$wd,2);
+ $wd=$w[0];
+ unshift(@{$pdfwds},"<$w[1]") if defined($w[1]);
+
+ $rtn->{$wd}=ParsePDFValue($pdfwds);
+ }
+ }
+
+ return($rtn);
+}
+
+sub ParsePDFValue
+{
+ my $pdfwds=shift;
+ my $rtn;
+ my $wd=nextwd($pdfwds);
+
+ if ($wd=~m/^\d+$/ and $pdfwds->[0]=~m/^\d+$/ and $pdfwds->[1]=~m/^R(\]|\>|\/)?/)
+ {
+ shift(@{$pdfwds});
+ if (defined($1) and length($1))
+ {
+ $pdfwds->[0]=substr($pdfwds->[0],1);
+ }
+ else
+ {
+ shift(@{$pdfwds});
+ }
+ return(bless(\$wd,'OBJREF'));
+ }
+
+ if ($wd eq '<<')
+ {
+ return(ParsePDFHash($pdfwds));
+ }
+
+ if ($wd eq '[')
+ {
+ return(ParsePDFArray($pdfwds));
+ }
+
+ if ($wd=~m/(.*?)(\(.*)$/)
+ {
+ if (defined($1) and length($1))
+ {
+ unshift(@{$pdfwds},$2);
+ $wd=$1;
+ }
+ else
+ {
+ return(ParsePDFString($wd,$pdfwds));
+ }
+ }
+
+ if ($wd=~m/(.*?)(\<.*)$/)
+ {
+ if (defined($1) and length($1))
+ {
+ unshift(@{$pdfwds},$2);
+ $wd=$1;
+ }
+ else
+ {
+ return(ParsePDFHexString($wd,$pdfwds));
+ }
+ }
+
+ if ($wd=~m/(.+?)(\/.*)$/)
+ {
+ if (defined($2) and length($2))
+ {
+ unshift(@{$pdfwds},$2);
+ $wd=$1;
+ }
+ }
+
+ return($wd);
+}
+
+sub ParsePDFString
+{
+ my $wd=shift;
+ my $rtn='';
+ my $pdfwds=shift;
+ my $lev=0;
+
+ while (length($wd))
+ {
+ $rtn.=' ' if length($rtn);
+
+ while ($wd=~m/(?<!\\)\(/g) {$lev++;}
+ while ($wd=~m/(?<!\\)\)/g) {$lev--;}
+
+
+ if ($lev<=0 and $wd=~m/^(.*?\))([^)]+)$/)
+ {
+ unshift(@{$pdfwds},$2) if defined($2) and length($2);
+ $wd=$1;
+ }
+
+ $rtn.=$wd;
+
+ last if $lev <= 0;
+
+ $wd=nextwd($pdfwds);
+ }
+
+ return($rtn);
+}
+
+sub ParsePDFHexString
+{
+ my $wd=shift;
+ my $rtn='';
+ my $pdfwds=shift;
+ my $lev=0;
+
+ if ($wd=~m/^(<.+?>)(.*)/)
+ {
+ unshift(@{$pdfwds},$2) if defined($2) and length($2);
+ $rtn=$1;
+ }
+
+ return($rtn);
+}
+
+sub ParsePDFArray
+{
+ my $pdfwds=shift;
+ my $rtn=[];
+ my $wd;
+
+ while (1)
+ {
+ $wd=ParsePDFValue($pdfwds);
+ last if $wd eq ']' or length($wd)==0;
+ push(@{$rtn},$wd);
+ }
+
+ return($rtn);
+}
+
+sub Warn
+{
+ Msg(0,(@_));
+}
+
+sub Die
+{
+ Msg(1,(@_));
+}
+
+sub Msg
+{
+ my ($fatal,$msg)=@_;
+
+ print STDERR "$prog:";
+ print STDERR "$env{SourceFile}:" if exists($env{SourceFile});
+ print STDERR " ";
+
+ if ($fatal)
+ {
+ print STDERR "fatal error: ";
+ }
+ else
+ {
+ print STDERR "warning: ";
+ }
+
+ print STDERR "$msg\n";
+ exit 1 if $fatal;
+}
+
+sub PutXY
+{
+ my ($x,$y)=(@_);
+
+ if ($frot)
+ {
+ return(d3($y)." ".d3($x));
+ }
+ else
+ {
+ $y=$mediabox[3]-$y;
+ return(d3($x)." ".d3($y));
+ }
+}
+
+sub GraphY
+{
+ my $y=shift;
+
+ if ($frot)
+ {
+ return($y);
+ }
+ else
+ {
+ return($mediabox[3]-$y);
+ }
+}
+
+sub Put
+{
+ my $msg=shift;
+
+ print $msg;
+ $fct+=length($msg);
+}
+
+sub PutObj
+{
+ my $ono=shift;
+ my $msg="$ono 0 obj ";
+ $obj[$ono]->{XREF}=$fct;
+ if (exists($obj[$ono]->{STREAM}))
+ {
+ if ($gotzlib && !$debug && !exists($obj[$ono]->{DATA}->{'Filter'}))
+ {
+ $obj[$ono]->{STREAM}=Compress::Zlib::compress($obj[$ono]->{STREAM});
+ $obj[$ono]->{DATA}->{'Filter'}='/FlateDecode';
+ }
+
+ $obj[$ono]->{DATA}->{'Length'}=length($obj[$ono]->{STREAM});
+ }
+ PutField(\$msg,$obj[$ono]->{DATA});
+ PutStream(\$msg,$ono) if exists($obj[$ono]->{STREAM});
+ Put($msg."endobj\n");
+}
+
+sub PutStream
+{
+ my $msg=shift;
+ my $ono=shift;
+
+ # We could 'flate' here
+ $$msg.="stream\n$obj[$ono]->{STREAM}endstream\n";
+}
+
+sub PutField
+{
+ my $pmsg=shift;
+ my $fld=shift;
+ my $term=shift||"\n";
+ my $typ=ref($fld);
+
+ if ($typ eq '')
+ {
+ $$pmsg.="$fld$term";
+ }
+ elsif ($typ eq 'ARRAY')
+ {
+ $$pmsg.='[';
+ foreach my $cell (@{$fld})
+ {
+ PutField($pmsg,$cell,' ');
+ }
+ $$pmsg.="]$term";
+ }
+ elsif ($typ eq 'HASH')
+ {
+ $$pmsg.='<< ';
+ foreach my $key (sort keys %{$fld})
+ {
+ $$pmsg.="/$key ";
+ PutField($pmsg,$fld->{$key});
+ }
+ $$pmsg.=">>$term";
+ }
+ elsif ($typ eq 'OBJREF')
+ {
+ $$pmsg.="$$fld 0 R$term";
+ }
+}
+
+sub BuildObj
+{
+ my $ono=shift;
+ my $val=shift;
+
+ $obj[$ono]->{DATA}=$val;
+
+ return("$ono 0 R ");
+}
+
+sub LoadFont
+{
+ my $fontno=shift;
+ my $fontnm=shift;
+ my $ofontnm=$fontnm;
+
+ return $fontlst{$fontno}->{OBJ} if (exists($fontlst{$fontno}));
+
+ my $f;
+ OpenFile(\$f,$fontdir,"$fontnm");
+
+ if (!defined($f) and $Foundry)
+ {
+ # Try with no foundry
+ $fontnm=~s/.*?-//;
+ OpenFile(\$f,$fontdir,$fontnm);
+ }
+
+ Die("unable to open font '$ofontnm' for mounting") if !defined($f);
+
+ my $foundry='';
+ $foundry=$1 if $fontnm=~m/^(.*?)-/;
+ my $stg=1;
+ my %fnt;
+ my @fntbbox=(0,0,0,0);
+ my $capheight=0;
+ my $lastchr=0;
+ my $lastnm;
+ my $t1flags=0;
+ my $fixwid=-1;
+ my $ascent=0;
+ my $charset='';
+
+ while (<$f>)
+ {
+ chomp;
+
+ s/^ +//;
+ s/^#.*// if $stg == 1;
+ next if $_ eq '';
+
+ if ($stg == 1)
+ {
+ my ($key,$val)=split(' ',$_,2);
+
+ $key=lc($key);
+ $stg=2,next if $key eq 'kernpairs';
+ $stg=3,next if lc($_) eq 'charset';
+
+ $fnt{$key}=$val
+ }
+ elsif ($stg == 2)
+ {
+ $stg=3,next if lc($_) eq 'charset';
+
+ my ($ch1,$ch2,$k)=split;
+# $fnt{KERN}->{$ch1}->{$ch2}=$k;
+ }
+ else
+ {
+ my (@r)=split;
+ my (@p)=split(',',$r[1]);
+
+ if ($r[1] eq '"')
+ {
+ $fnt{NAM}->{$r[0]}=[@{$fnt{NAM}->{$lastnm}}];
+ next;
+ }
+
+ $r[3]=oct($r[3]) if substr($r[3],0,1) eq '0';
+ $r[0]='u0020' if $r[3] == 32;
+ $r[0]="u00".hex($r[3]) if $r[0] eq '---';
+# next if $r[3] >255;
+ $r[4]=$r[0] if !defined($r[4]);
+ $fnt{NAM}->{$r[0]}=[$p[0],$r[3],'/'.$r[4],$r[3],0];
+ $fnt{NO}->[$r[3]]=[$r[0],$r[0]];
+ $lastnm=$r[0];
+ $lastchr=$r[3] if $r[3] > $lastchr;
+ $fixwid=$p[0] if $fixwid == -1;
+ $fixwid=-2 if $fixwid > 0 and $p[0] != $fixwid;
+
+ $fntbbox[1]=-$p[2] if defined($p[2]) and -$p[2] < $fntbbox[1];
+ $fntbbox[2]=$p[0] if $p[0] > $fntbbox[2];
+ $fntbbox[3]=$p[1] if defined($p[1]) and $p[1] > $fntbbox[3];
+ $ascent=$p[1] if defined($p[1]) and $p[1] > $ascent and $r[3] >= 32 and $r[3] < 128;
+ $charset.='/'.$r[4] if defined($r[4]);
+ $capheight=$p[1] if length($r[4]) == 1 and $r[4] ge 'A' and $r[4] le 'Z' and $p[1] > $capheight;
+ }
+ }
+
+ close($f);
+
+ foreach my $j (0..$lastchr)
+ {
+ $fnt{NO}->[$j]=['',''] if !defined($fnt{NO}->[$j]);
+ }
+
+ my $fno=0;
+ my $slant=0;
+ $fnt{DIFF}=[];
+ $fnt{WIDTH}=[];
+ $fnt{NAM}->{''}=[0,-1,'/.notdef',-1,0];
+ $slant=-$fnt{'slant'} if exists($fnt{'slant'});
+ $fnt{'spacewidth'}=700 if !exists($fnt{'spacewidth'});
+
+ $t1flags|=2**0 if $fixwid > -1;
+ $t1flags|=(exists($fnt{'special'}))?2**2:2**5;
+ $t1flags|=2**6 if $slant != 0;
+ my $fontkey="$foundry $fnt{internalname}";
+
+ if (exists($download{$fontkey}))
+ {
+ # Not a Base Font
+ my ($l1,$l2,$l3,$t1stream)=GetType1($download{$fontkey});
+ Warn("incorrect font format for '$fontkey' ($l1)")
+ if !defined($t1stream);
+ $fno=++$objct;
+ $fontlst{$fontno}->{OBJ}=BuildObj($objct,
+ {'Type' => '/Font',
+ 'Subtype' => '/Type1',
+ 'BaseFont' => '/'.$fnt{internalname},
+ 'Widths' => $fnt{WIDTH},
+ 'FirstChar' => 0,
+ 'LastChar' => $lastchr,
+ 'Encoding' => BuildObj($objct+1,
+ {'Type' => '/Encoding',
+ 'Differences' => $fnt{DIFF}
+ }
+ ),
+ 'FontDescriptor' => BuildObj($objct+2,
+ {'Type' => '/FontDescriptor',
+ 'FontName' => '/'.$fnt{internalname},
+ 'Flags' => $t1flags,
+ 'FontBBox' => \@fntbbox,
+ 'ItalicAngle' => $slant,
+ 'Ascent' => $ascent,
+ 'Descent' => $fntbbox[1],
+ 'CapHeight' => $capheight,
+ 'StemV' => 0,
+# 'CharSet' => "($charset)",
+ 'FontFile' => BuildObj($objct+3,
+ {'Length1' => $l1,
+ 'Length2' => $l2,
+ 'Length3' => $l3
+ }
+ )
+ }
+ )
+ }
+ );
+
+ $objct+=3;
+ $fontlst{$fontno}->{NM}='/F'.$fontno;
+ $pages->{'Resources'}->{'Font'}->{'F'.$fontno}=$fontlst{$fontno}->{OBJ};
+ $fontlst{$fontno}->{FNT}=\%fnt;
+ $obj[$objct]->{STREAM}=$t1stream;
+
+ }
+ else
+ {
+ if (exists($missing{$fontkey}))
+ {
+ Warn("The download file in '$missing{$fontkey}' "
+ . " has erroneous entry for '$fnt{internalname} ($ofontnm)'");
+ }
+ else
+ {
+ Warn("unable to embed font file for '$fnt{internalname}'"
+ . " ($ofontnm) (missing entry in 'download' file?)")
+ if $embedall;
+ }
+ $fno=++$objct;
+ $fontlst{$fontno}->{OBJ}=BuildObj($objct,
+ {'Type' => '/Font',
+ 'Subtype' => '/Type1',
+ 'BaseFont' => '/'.$fnt{internalname},
+ 'Widths' => $fnt{WIDTH},
+ 'FirstChar' => 0,
+ 'LastChar' => $lastchr,
+ 'Encoding' => BuildObj($objct+1,
+ {'Type' => '/Encoding',
+ 'Differences' => $fnt{DIFF}
+ }
+ ),
+ 'FontDescriptor' => BuildObj($objct+2,
+ {'Type' => '/FontDescriptor',
+ 'FontName' => '/'.$fnt{internalname},
+ 'Flags' => $t1flags,
+ 'FontBBox' => \@fntbbox,
+ 'ItalicAngle' => $slant,
+ 'Ascent' => $ascent,
+ 'Descent' => $fntbbox[1],
+ 'CapHeight' => $capheight,
+ 'StemV' => 0,
+ 'CharSet' => "($charset)",
+ }
+ )
+ }
+ );
+
+ $objct+=2;
+ $fontlst{$fontno}->{NM}='/F'.$fontno;
+ $pages->{'Resources'}->{'Font'}->{'F'.$fontno}=$fontlst{$fontno}->{OBJ};
+ $fontlst{$fontno}->{FNT}=\%fnt;
+ }
+
+ if (defined($fnt{encoding}) and $fnt{encoding} eq 'text.enc' and $ucmap ne '')
+ {
+ if ($textenccmap eq '')
+ {
+ $textenccmap = BuildObj($objct+1,{});
+ $objct++;
+ $obj[$objct]->{STREAM}=$ucmap;
+ }
+ $obj[$fno]->{DATA}->{'ToUnicode'}=$textenccmap;
+ }
+
+# PutObj($fno);
+# PutObj($fno+1);
+# PutObj($fno+2) if defined($obj[$fno+2]);
+# PutObj($fno+3) if defined($obj[$fno+3]);
+}
+
+sub GetType1
+{
+ my $file=shift;
+ my ($l1,$l2,$l3); # Return lengths
+ my ($head,$body,$tail); # Font contents
+ my $f;
+
+ OpenFile(\$f,$fontdir,"$file");
+ Die("unable to open font '$file' for embedding") if !defined($f);
+
+ $head=GetChunk($f,1,"currentfile eexec");
+ $body=GetChunk($f,2,"00000000") if !eof($f);
+ $tail=GetChunk($f,3,"cleartomark") if !eof($f);
+
+ $l1=length($head);
+ $l2=length($body);
+ $l3=length($tail);
+
+ return($l1,$l2,$l3,"$head$body$tail");
+}
+
+sub GetChunk
+{
+ my $F=shift;
+ my $segno=shift;
+ my $ascterm=shift;
+ my ($type,$hdr,$chunk,@msg);
+ binmode($F);
+ my $enc="ascii";
+
+ while (1)
+ {
+ # There may be multiple chunks of the same type
+
+ my $ct=read($F,$hdr,2);
+
+ if ($ct==2)
+ {
+ if (substr($hdr,0,1) eq "\x80")
+ {
+ # binary chunk
+
+ my $chunktype=ord(substr($hdr,1,1));
+ $enc="binary";
+
+ if (defined($type) and $type != $chunktype)
+ {
+ seek($F,-2,1);
+ last;
+ }
+
+ $type=$chunktype;
+ return if $chunktype == 3;
+
+ $ct=read($F,$hdr,4);
+ Die("failed to read binary segment length") if $ct != 4;
+ my $sl=unpack('V',$hdr);
+ my $data;
+ my $chk=read($F,$data,$sl);
+ Die("failed to read binary segment") if $chk != $sl;
+ $chunk.=$data;
+ }
+ else
+ {
+ # ascii chunk
+
+ my $hex=0;
+ seek($F,-2,1);
+ my $ct=0;
+
+ while (1)
+ {
+ my $lin=<$F>;
+
+ last if !$lin;
+
+ $hex=1,$enc.=" hex" if $segno == 2 and !$ct and $lin=~m/^[A-F0-9a-f]{4,4}/;
+
+ if ($segno !=2 and $lin=~m/^(.*$ascterm\n?)(.*)/)
+ {
+ $chunk.=$1;
+ seek($F,-length($2)-1,1) if $2;
+ last;
+ }
+ elsif ($segno == 2 and $lin=~m/^(.*?)($ascterm.*)/)
+ {
+ $chunk.=$1;
+ seek($F,-length($2)-1,1) if $2;
+ last;
+ }
+
+ chomp($lin), $lin=pack('H*',$lin) if $hex;
+ $chunk.=$lin; $ct++;
+ }
+
+ last;
+ }
+ }
+ else
+ {
+ push(@msg,"Failed to read 2 header bytes");
+ }
+ }
+
+ return $chunk;
+}
+
+sub OutStream
+{
+ my $ono=shift;
+
+ IsGraphic();
+ $stream.="Q\n";
+ $obj[$ono]->{STREAM}=$stream;
+ $obj[$ono]->{DATA}->{Length}=length($stream);
+ $stream='';
+ PutObj($ono);
+}
+
+sub do_p
+{
+ my $trans='BLOCK';
+
+ $trans='PAGE' if $firstpause;
+ NewPage($trans);
+ @XOstream=();
+ @PageAnnots=();
+ $firstpause=1;
+}
+
+sub FixTrans
+{
+ my $t=shift;
+ my $style=$t->{S};
+
+ if ($style)
+ {
+ delete($t->{Dm}) if $style ne '/Split' and $style ne '/Blinds';
+ delete($t->{M}) if !($style eq '/Split' or $style eq '/Box' or $style eq '/Fly');
+ delete($t->{Di}) if !($style eq '/Wipe' or $style eq '/Glitter' or $style eq '/Fly' or $style eq '/Cover' or $style eq '/Uncover' or $style eq '/Push') or ($style eq '/Fly' and $t->{Di} eq '/None' and $t->{SS} != 1);
+ delete($t->{SS}) if !($style eq '/Fly');
+ delete($t->{B}) if !($style eq '/Fly');
+ }
+
+ return($t);
+}
+
+sub NewPage
+{
+ my $trans=shift;
+ # Start of pages
+
+ if ($cpageno > 0)
+ {
+ if ($#XOstream>=0)
+ {
+ MakeXO() if $stream;
+ $stream=join("\n",@XOstream,'');
+ }
+
+ my %t=%{$transition->{$trans}};
+ $cpage->{MediaBox}=\@mediabox if $custompaper;
+ $cpage->{Trans}=FixTrans(\%t) if $t{S};
+
+ if ($#PageAnnots >= 0)
+ {
+ @{$cpage->{Annots}}=@PageAnnots;
+ }
+
+ if ($#bgstack > -1 or $bgbox)
+ {
+ my $box="q 1 0 0 1 0 0 cm ";
+
+ foreach my $bg (@bgstack)
+ {
+ # 0=$bgtype # 1=stroke 2=fill. 4=page
+ # 1=$strkcol
+ # 2=$fillcol
+ # 3=(Left,Top,Right,bottom,LineWeight)
+ # 4=Start ypos
+ # 5=Endypos
+ # 6=Line Weight
+
+ my $pg=$bg->[3] || \@defaultmb;
+
+ $bg->[5]=$pg->[3]; # box is continuing to next page
+ $box.=DrawBox($bg);
+ $bg->[4]=$pg->[1]; # will continue from page top
+ }
+
+ $stream=$box.$bgbox."Q\n".$stream;
+ $bgbox='';
+ $boxmax=0;
+ }
+
+ PutObj($cpageno);
+ OutStream($cpageno+1);
+ }
+
+ $cpageno=++$objct;
+
+ my $thispg=BuildObj($objct,
+ {'Type' => '/Page',
+ 'Group' => {'CS' => '/DeviceRGB', 'S' => '/Transparency'},
+ 'Parent' => '2 0 R',
+ 'Contents' => [ BuildObj($objct+1,
+ {'Length' => 0}
+ ) ],
+ }
+ );
+
+ splice(@{$pages->{Kids}},++$pginsert,0,$thispg);
+ splice(@outlines,$pginsert,0,[$curoutlev,$#{$curoutlev}+1,$thislev]);
+
+ $objct+=1;
+ $cpage=$obj[$cpageno]->{DATA};
+ $pages->{'Count'}++;
+ $stream="q 1 0 0 1 0 0 cm\n$linejoin J\n$linecap j\n0.4 w\n";
+ $stream.=$strkcol."\n", $curstrk=$strkcol if $strkcol ne '';
+ $mode='g';
+ $curfill='';
+# @mediabox=@defaultmb;
+}
+
+sub DrawBox
+{
+ my $bg=shift;
+ my $res='';
+ my $pg=$bg->[3] || \@mediabox;
+ $bg->[4]=$pg->[1], $bg->[5]=$pg->[3] if $bg->[0] & 4;
+ my $bot=$bg->[5];
+ $bot=$boxmax if $boxmax > $bot;
+ my $wid=$pg->[2]-$pg->[0];
+ my $dep=$bot-$bg->[4];
+
+ $res="$bg->[1] $bg->[2] $bg->[6] w\n";
+ $res.="$pg->[0] $bg->[4] $wid $dep re f " if $bg->[0] & 1;
+ $res.="$pg->[0] $bg->[4] $wid $dep re s " if $bg->[0] & 2;
+ return("$res\n");
+}
+
+sub MakeXO
+{
+ $stream.="%mode=$mode\n";
+ IsGraphic();
+ $stream.="Q\n";
+ my $xobj=++$objct;
+ my $xonm="XO$xobj";
+ $pages->{'Resources'}->{'XObject'}->{$xonm}=BuildObj($xobj,{'Type' => '/XObject', 'BBox' => \@mediabox, 'Name' => "/$xonm", 'FormType' => 1, 'Subtype' => '/Form', 'Length' => 0, 'Type' => "/XObject"});
+ $obj[$xobj]->{STREAM}=$stream;
+ $stream='';
+ push(@XOstream,"q") if $#XOstream==-1;
+ push(@XOstream,"/$xonm Do");
+}
+
+sub do_f
+{
+ my $par=shift;
+ my $fnt=$fontlst{$par}->{FNT};
+
+# IsText();
+ $cft="$par";
+ $fontchg=1;
+# $stream.="/F$cft $cftsz Tf\n" if $cftsz;
+ $widtbl=CacheWid($par);
+ $origwidtbl=[];
+
+ foreach my $w (@{$fnt->{NO}})
+ {
+ push(@{$origwidtbl},$fnt->{NAM}->{$w->[1]}->[WIDTH]);
+ }
+
+# $krntbl=$fnt->{KERN};
+}
+
+sub CacheWid
+{
+ my $par=shift;
+
+ if (!defined($fontlst{$par}->{CACHE}->{$cftsz}))
+ {
+ $fontlst{$par}->{CACHE}->{$cftsz}=BuildCache($fontlst{$par}->{FNT});
+ }
+
+ return($fontlst{$par}->{CACHE}->{$cftsz});
+}
+
+sub BuildCache
+{
+ my $fnt=shift;
+ my @cwid;
+ $origwidtbl=[];
+
+ foreach my $w (@{$fnt->{NO}})
+ {
+ my $wid=(defined($w) and defined($w->[1]))?$fnt->{NAM}->{$w->[1]}->[WIDTH]:0;
+ push(@cwid,$wid*$cftsz);
+ push(@{$origwidtbl},$wid);
+ }
+
+ return(\@cwid);
+}
+
+sub IsText
+{
+ if ($mode eq 'g')
+ {
+ $xpos+=$pendmv/$unitwidth;
+ $stream.="q BT\n$matrix ".PutXY($xpos,$ypos)." Tm\n";
+ $poschg=0;
+ $fontchg=0;
+ $pendmv=0;
+ $matrixchg=0;
+ $tmxpos=$xpos;
+ $stream.=$textcol."\n", $curfill=$textcol if $textcol ne $curfill;
+ if (defined($cft))
+ {
+ $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz;
+ $stream.="/F$cft $cftsz Tf\n";
+ }
+ $stream.="$curkern Tc\n";
+ }
+
+ if ($poschg or $matrixchg)
+ {
+ PutLine(0) if $matrixchg;
+ $stream.="$matrix ".PutXY($xpos,$ypos)." Tm\n", $poschg=0;
+ $tmxpos=$xpos;
+ $matrixchg=0;
+ $stream.="$curkern Tc\n";
+ }
+
+ if ($fontchg)
+ {
+ PutLine(0);
+ $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz;
+ $stream.="/F$cft $cftsz Tf\n" if $cftsz and defined($cft);
+ $fontchg=0;
+ }
+
+ $mode='t';
+}
+
+sub IsGraphic
+{
+ if ($mode eq 't')
+ {
+ PutLine();
+ $stream.="ET Q\n";
+ $xpos+=($pendmv-$nomove)/$unitwidth;
+ $pendmv=0;
+ $nomove=0;
+ $stream.=$strkcol."\n", $curstrk=$strkcol if $strkcol ne $curstrk;
+ $curfill=$fillcol;
+ }
+ $mode='g';
+}
+
+sub do_s
+{
+ my $par=shift;
+ $par/=$unitwidth;
+
+ if ($par != $cftsz and defined($cft))
+ {
+ PutLine();
+ $cftsz=$par;
+ Set_LWidth() if $lwidth < 1;
+# $stream.="/F$cft $cftsz Tf\n";
+ $fontchg=1;
+ $widtbl=CacheWid($cft);
+ }
+ else
+ {
+ $cftsz=$par;
+ Set_LWidth() if $lwidth < 1;
+ }
+}
+
+sub Set_LWidth
+{
+ IsGraphic();
+ $stream.=((($desc{res}/(72*$desc{sizescale}))*$linewidth*$cftsz)/1000)." w\n";
+ return;
+}
+
+sub do_m
+{
+ # Groff uses /m[] for text & graphic stroke, and /M[] (DF?) for graphic fill.
+ # PDF uses G/RG/K for graphic stroke, and g/rg/k for text & graphic fill.
+ #
+ # This means that we must maintain g/rg/k state separately for text colour & graphic fill (this is
+ # probably why 'gs' maintains separate graphic states for text & graphics when distilling PS -> PDF).
+ #
+ # To facilitate this:-
+ #
+ # $textcol = current groff stroke colour
+ # $fillcol = current groff fill colour
+ # $curfill = current PDF fill colour
+
+ my $par=shift;
+ my $mcmd=substr($par,0,1);
+
+ $par=substr($par,1);
+ $par=~s/^ +//;
+
+# IsGraphic();
+
+ $textcol=set_col($mcmd,$par,0);
+ $strkcol=set_col($mcmd,$par,1);
+
+ if ($mode eq 't')
+ {
+ PutLine();
+ $stream.=$textcol."\n";
+ $curfill=$textcol;
+ }
+ else
+ {
+ $stream.="$strkcol\n";
+ $curstrk=$strkcol;
+ }
+}
+
+sub set_col
+{
+ my $mcmd=shift;
+ my $par=shift;
+ my $upper=shift;
+ my @oper=('g','k','rg');
+
+ @oper=('G','K','RG') if $upper;
+
+ if ($mcmd eq 'd')
+ {
+ # default colour
+ return("0 $oper[0]");
+ }
+
+ my (@c)=split(' ',$par);
+
+ if ($mcmd eq 'c')
+ {
+ # Text CMY
+ return(d3($c[0]/65535).' '.d3($c[1]/65535).' '.d3($c[2]/65535)." 0 $oper[1]");
+ }
+ elsif ($mcmd eq 'k')
+ {
+ # Text CMYK
+ return(d3($c[0]/65535).' '.d3($c[1]/65535).' '.d3($c[2]/65535).' '.d3($c[3]/65535)." $oper[1]");
+ }
+ elsif ($mcmd eq 'g')
+ {
+ # Text Grey
+ return(d3($c[0]/65535)." $oper[0]");
+ }
+ elsif ($mcmd eq 'r')
+ {
+ # Text RGB0
+ return(d3($c[0]/65535).' '.d3($c[1]/65535).' '.d3($c[2]/65535)." $oper[2]");
+ }
+}
+
+sub do_D
+{
+ my $par=shift;
+ my $Dcmd=substr($par,0,1);
+
+ $par=substr($par,1);
+ $xpos+=$pendmv/$unitwidth;
+ $pendmv=0;
+
+ IsGraphic();
+
+ if ($Dcmd eq 'F')
+ {
+ my $mcmd=substr($par,0,1);
+
+ $par=substr($par,1);
+ $par=~s/^ +//;
+
+ $fillcol=set_col($mcmd,$par,0);
+ $stream.="$fillcol\n";
+ $curfill=$fillcol;
+ }
+ elsif ($Dcmd eq 'f')
+ {
+ my $mcmd=substr($par,0,1);
+
+ $par=substr($par,1);
+ $par=~s/^ +//;
+ ($par)=split(' ',$par);
+
+ if ($par >= 0 and $par <= 1000)
+ {
+ $fillcol=set_col('g',int((1000-$par)*65535/1000),0);
+ }
+ else
+ {
+ $fillcol=lc($textcol);
+ }
+
+ $stream.="$fillcol\n";
+ $curfill=$fillcol;
+ }
+ elsif ($Dcmd eq '~')
+ {
+ # B-Spline
+ my (@p)=split(' ',$par);
+ my ($nxpos,$nypos);
+
+ foreach my $p (@p) { $p/=$unitwidth; }
+ $stream.=PutXY($xpos,$ypos)." m\n";
+ $xpos+=($p[0]/2);
+ $ypos+=($p[1]/2);
+ $stream.=PutXY($xpos,$ypos)." l\n";
+
+ for (my $i=0; $i < $#p-1; $i+=2)
+ {
+ $nxpos=(($p[$i]*$tnum)/(2*$tden));
+ $nypos=(($p[$i+1]*$tnum)/(2*$tden));
+ $stream.=PutXY(($xpos+$nxpos),($ypos+$nypos))." ";
+ $nxpos=($p[$i]/2 + ($p[$i+2]*($tden-$tnum))/(2*$tden));
+ $nypos=($p[$i+1]/2 + ($p[$i+3]*($tden-$tnum))/(2*$tden));
+ $stream.=PutXY(($xpos+$nxpos),($ypos+$nypos))." ";
+ $nxpos=(($p[$i]-$p[$i]/2) + $p[$i+2]/2);
+ $nypos=(($p[$i+1]-$p[$i+1]/2) + $p[$i+3]/2);
+ $stream.=PutXY(($xpos+$nxpos),($ypos+$nypos))." c\n";
+ $xpos+=$nxpos;
+ $ypos+=$nypos;
+ }
+
+ $xpos+=($p[$#p-1]-$p[$#p-1]/2);
+ $ypos+=($p[$#p]-$p[$#p]/2);
+ $stream.=PutXY($xpos,$ypos)." l\nS\n";
+ $poschg=1;
+ }
+ elsif ($Dcmd eq 'p' or $Dcmd eq 'P')
+ {
+ # Polygon
+ my (@p)=split(' ',$par);
+ my ($nxpos,$nypos);
+
+ foreach my $p (@p) { $p/=$unitwidth; }
+ $stream.=PutXY($xpos,$ypos)." m\n";
+
+ for (my $i=0; $i < $#p; $i+=2)
+ {
+ $xpos+=($p[$i]);
+ $ypos+=($p[$i+1]);
+ $stream.=PutXY($xpos,$ypos)." l\n";
+ }
+
+ if ($Dcmd eq 'p')
+ {
+ $stream.="s\n";
+ }
+ else
+ {
+ $stream.="f\n";
+ }
+ $poschg=1;
+ }
+ elsif ($Dcmd eq 'c')
+ {
+ # Stroke circle
+ $par=substr($par,1);
+ my (@p)=split(' ',$par);
+
+ DrawCircle($p[0],$p[0]);
+ $stream.="s\n";
+ $poschg=1;
+ }
+ elsif ($Dcmd eq 'C')
+ {
+ # Fill circle
+ $par=substr($par,1);
+ my (@p)=split(' ',$par);
+
+ DrawCircle($p[0],$p[0]);
+ $stream.="f\n";
+ $poschg=1;
+ }
+ elsif ($Dcmd eq 'e')
+ {
+ # Stroke ellipse
+ $par=substr($par,1);
+ my (@p)=split(' ',$par);
+
+ DrawCircle($p[0],$p[1]);
+ $stream.="s\n";
+ $poschg=1;
+ }
+ elsif ($Dcmd eq 'E')
+ {
+ # Fill ellipse
+ $par=substr($par,1);
+ my (@p)=split(' ',$par);
+
+ DrawCircle($p[0],$p[1]);
+ $stream.="f\n";
+ $poschg=1;
+ }
+ elsif ($Dcmd eq 'l')
+ {
+ # Line To
+ $par=substr($par,1);
+ my (@p)=split(' ',$par);
+
+ foreach my $p (@p) { $p/=$unitwidth; }
+ $stream.=PutXY($xpos,$ypos)." m\n";
+ $xpos+=$p[0];
+ $ypos+=$p[1];
+ $stream.=PutXY($xpos,$ypos)." l\n";
+
+ $stream.="S\n";
+ $poschg=1;
+ }
+ elsif ($Dcmd eq 't')
+ {
+ # Line Thickness
+ $par=substr($par,1);
+ my (@p)=split(' ',$par);
+
+ foreach my $p (@p) { $p/=$unitwidth; }
+ # $xpos+=$p[0]*100; # WTF!!!
+ #int lw = ((font::res/(72*font::sizescale))*linewidth*env->size)/1000;
+ $p[0]=(($desc{res}/(72*$desc{sizescale}))*$linewidth*$cftsz)/1000 if $p[0] < 0;
+ $lwidth=$p[0];
+ $stream.="$p[0] w\n";
+ $poschg=1;
+ $xpos+=$lwidth;
+ }
+ elsif ($Dcmd eq 'a')
+ {
+ # Arc
+ $par=substr($par,1);
+ my (@p)=split(' ',$par);
+ my $rad180=3.14159;
+ my $rad360=$rad180*2;
+ my $rad90=$rad180/2;
+
+ foreach my $p (@p) { $p/=$unitwidth; }
+
+ # Documentation is wrong. Groff does not use Dh1,Dv1 as centre of the circle!
+
+ my $centre=adjust_arc_centre(\@p);
+
+ # Using formula here : http://www.tinaja.com/glib/bezcirc2.pdf
+ # First calculate angle between start and end point
+
+ my ($startang,$r)=RtoP(-$centre->[0],$centre->[1]);
+ my ($endang,$r2)=RtoP(($p[0]+$p[2])-$centre->[0],-($p[1]+$p[3]-$centre->[1]));
+ $endang+=$rad360 if $endang < $startang;
+ my $totang=($endang-$startang)/4; # do it in 4 pieces
+
+ # Now 1 piece
+
+ my $x0=cos($totang/2);
+ my $y0=sin($totang/2);
+ my $x3=$x0;
+ my $y3=-$y0;
+ my $x1=(4-$x0)/3;
+ my $y1=((1-$x0)*(3-$x0))/(3*$y0);
+ my $x2=$x1;
+ my $y2=-$y1;
+
+ # Rotate to start position and draw 4 pieces
+
+ foreach my $j (0..3)
+ {
+ PlotArcSegment($totang/2+$startang+$j*$totang,$r,$xpos+$centre->[0],GraphY($ypos+$centre->[1]),$x0,$y0,$x1,$y1,$x2,$y2,$x3,$y3);
+ }
+
+ $xpos+=$p[0]+$p[2];
+ $ypos+=$p[1]+$p[3];
+
+ $poschg=1;
+ }
+}
+
+sub deg
+{
+ return int($_[0]*180/3.14159);
+}
+
+sub adjust_arc_centre
+{
+ # Taken from geometry.cpp
+
+ # We move the center along a line parallel to the line between
+ # the specified start point and end point so that the center
+ # is equidistant between the start and end point.
+ # It can be proved (using Lagrange multipliers) that this will
+ # give the point nearest to the specified center that is equidistant
+ # between the start and end point.
+
+ my $p=shift;
+ my @c;
+ my $x = $p->[0] + $p->[2]; # (x, y) is the end point
+ my $y = $p->[1] + $p->[3];
+ my $n = $x*$x + $y*$y;
+ if ($n != 0)
+ {
+ $c[0]= $p->[0];
+ $c[1] = $p->[1];
+ my $k = .5 - ($c[0]*$x + $c[1]*$y)/$n;
+ $c[0] += $k*$x;
+ $c[1] += $k*$y;
+ return(\@c);
+ }
+ else
+ {
+ return(undef);
+ }
+}
+
+
+sub PlotArcSegment
+{
+ my ($ang,$r,$transx,$transy,$x0,$y0,$x1,$y1,$x2,$y2,$x3,$y3)=@_;
+ my $cos=cos($ang);
+ my $sin=sin($ang);
+ my @mat=($cos,$sin,-$sin,$cos,0,0);
+ my $lw=$lwidth/$r;
+
+ $stream.="q $r 0 0 $r $transx $transy cm ".join(' ',@mat)." cm $lw w $x0 $y0 m $x1 $y1 $x2 $y2 $x3 $y3 c S Q\n";
+}
+
+sub DrawCircle
+{
+ my $hd=shift;
+ my $vd=shift;
+ my $hr=$hd/2/$unitwidth;
+ my $vr=$vd/2/$unitwidth;
+ my $kappa=0.5522847498;
+ $hd/=$unitwidth;
+ $vd/=$unitwidth;
+
+
+ $stream.=PutXY(($xpos+$hd),$ypos)." m\n";
+ $stream.=PutXY(($xpos+$hd),($ypos+$vr*$kappa))." ".PutXY(($xpos+$hr+$hr*$kappa),($ypos+$vr))." ".PutXY(($xpos+$hr),($ypos+$vr))." c\n";
+ $stream.=PutXY(($xpos+$hr-$hr*$kappa),($ypos+$vr))." ".PutXY(($xpos),($ypos+$vr*$kappa))." ".PutXY(($xpos),($ypos))." c\n";
+ $stream.=PutXY(($xpos),($ypos-$vr*$kappa))." ".PutXY(($xpos+$hr-$hr*$kappa),($ypos-$vr))." ".PutXY(($xpos+$hr),($ypos-$vr))." c\n";
+ $stream.=PutXY(($xpos+$hr+$hr*$kappa),($ypos-$vr))." ".PutXY(($xpos+$hd),($ypos-$vr*$kappa))." ".PutXY(($xpos+$hd),($ypos))." c\n";
+ $xpos+=$hd;
+
+ $poschg=1;
+}
+
+sub FindCircle
+{
+ my ($x1,$y1,$x2,$y2,$x3,$y3)=@_;
+ my ($Xo, $Yo);
+
+ my $x=$x2+$x3;
+ my $y=$y2+$y3;
+ my $n=$x**2+$y**2;
+
+ if ($n)
+ {
+ my $k=.5-($x2*$x + $y2*$y)/$n;
+ return(sqrt($n),$x2+$k*$x,$y2+$k*$y);
+ }
+ else
+ {
+ return(-1);
+ }
+
+}
+
+sub PtoR
+{
+ my ($theta,$r)=@_;
+
+ return($r*cos($theta),$r*sin($theta));
+}
+
+sub RtoP
+{
+ my ($x,$y)=@_;
+
+ return(atan2($y,$x),sqrt($x**2+$y**2));
+}
+
+sub PutLine
+{
+
+ my $f=shift;
+
+ IsText() if !defined($f);
+
+ return if (scalar(@lin) == 0) or (!defined($lin[0]->[0]) and $#lin == 0);
+
+# $stream.="% --- wht=$whtsz, pend=$pendmv, nomv=$nomove\n" if $debug;
+ $pendmv-=$nomove;
+ $lin[$#lin]->[1]=-$pendmv/$cftsz if ($pendmv != 0);
+
+ foreach my $wd (@lin)
+ {
+ next if !defined($wd->[0]);
+ $wd->[0]=~s/\\/\\\\/g;
+ $wd->[0]=~s/\(/\\(/g;
+ $wd->[0]=~s/\)/\\)/g;
+ $wd->[0]=~s/!\|!\|/\\/g;
+ $wd->[1]=d3($wd->[1]);
+ }
+
+ if (0)
+ {
+ if (scalar(@lin) == 1 and (!defined($lin[0]->[1]) or $lin[0]->[1] == 0))
+ {
+ $stream.="($lin[0]->[0]) Tj\n";
+ }
+ else
+ {
+ $stream.="[";
+
+ foreach my $wd (@lin)
+ {
+ $stream.="($wd->[0]) " if defined($wd->[0]);
+ $stream.="$wd->[1] " if defined($wd->[1]) and $wd->[1] != 0;
+ }
+
+ $stream.="] TJ\n";
+ }
+ }
+ else
+ {
+ if (scalar(@lin) == 1 and (!defined($lin[0]->[1]) or $lin[0]->[1] == 0))
+ {
+ $stream.="0 Tw ($lin[0]->[0]) Tj\n";
+ }
+ else
+ {
+ if ($wt>=-1 or $#lin == 0 or $lin[0]->[1]>=0)
+ {
+ $stream.="0 Tw [";
+
+ foreach my $wd (@lin)
+ {
+ $stream.="($wd->[0]) " if defined($wd->[0]);
+ $stream.="$wd->[1] " if defined($wd->[1]) and $wd->[1] != 0;
+ }
+
+ $stream.="] TJ\n";
+ }
+ else
+ {
+ # $stream.="\%dg 0 Tw [";
+ #
+ # foreach my $wd (@lin)
+ # {
+ # $stream.="($wd->[0]) " if defined($wd->[0]);
+ # $stream.="$wd->[1] " if defined($wd->[1]) and $wd->[1] != 0;
+ # }
+ #
+ # $stream.="] TJ\n";
+ #
+ # my $wt=$lin[0]->[1]||0;
+
+ # while ($wt < -$whtsz/$cftsz)
+ # {
+ # $wt+=$whtsz/$cftsz;
+ # }
+
+ $stream.=sprintf( "%.3f Tw ",-($whtsz+$wt*$cftsz)/$unitwidth-$curkern );
+ if (!defined($lin[0]->[0]) and defined($lin[0]->[1]))
+ {
+ $stream.="[ $lin[0]->[1] (";
+ shift @lin;
+ }
+ else
+ {
+ $stream.="[(";
+ }
+
+ foreach my $wd (@lin)
+ {
+ my $wwt=$wd->[1]||0;
+
+ while ($wwt <= $wt+.1)
+ {
+ $wwt-=$wt;
+ $wd->[0].=' ';
+ }
+
+ if (abs($wwt) < .1 or $wwt == 0)
+ {
+ $stream.="$wd->[0]" if defined($wd->[0]);
+ }
+ else
+ {
+ $wwt=sprintf("%.3f",$wwt);
+ $stream.="$wd->[0]) $wwt (" if defined($wd->[0]);
+ }
+ }
+ $stream.=")] TJ\n";
+ }
+ }
+ }
+
+ @lin=();
+ $xpos+=$pendmv/$unitwidth;
+ $pendmv=0;
+ $nomove=0;
+ $wt=-1;
+}
+
+sub d3
+{
+ return(sprintf("%.3f",shift || 0));
+}
+
+sub LoadAhead
+{
+ my $no=shift;
+
+ foreach my $j (1..$no)
+ {
+ my $lin=<>;
+ chomp($lin);
+ $lin=~s/\r$//;
+ $lct++;
+
+ push(@ahead,$lin);
+ $stream.="%% $lin\n" if $debug;
+ }
+}
+
+sub do_V
+{
+ my $par=shift;
+
+ if ($mode eq 't')
+ {
+ PutLine();
+ }
+ else
+ {
+ $xpos+=$pendmv/$unitwidth;
+ $pendmv=0;
+ }
+
+ $ypos=$par/$unitwidth;
+
+ LoadAhead(1);
+
+ if (substr($ahead[0],0,1) eq 'H')
+ {
+ $xpos=substr($ahead[0],1)/$unitwidth;
+
+ $nomove=$pendmv=0;
+ @ahead=();
+
+ }
+
+ $poschg=1;
+}
+
+sub do_v
+{
+ my $par=shift;
+
+ PutLine() if $mode eq 't';
+
+ $ypos+=$par/$unitwidth;
+
+ $poschg=1;
+}
+
+sub TextWid
+{
+ my $txt=shift;
+ my $fnt=shift;
+ my $w=0;
+ my $ck=0;
+
+ foreach my $c (split('',$txt))
+ {
+ my $cn=ord($c);
+ $widtbl->[$cn]=$origwidtbl->[$cn]*$cftsz if !defined($widtbl->[$cn]);
+ $w+=$widtbl->[$cn];
+ }
+
+ $ck=length($txt)*$curkern;
+
+ return(($w/$unitwidth)+$ck);
+}
+
+sub do_t
+{
+ my $par=shift;
+ my $fnt=$fontlst{$cft}->{FNT};
+
+ if ($kernadjust != $curkern)
+ {
+ PutLine();
+ $stream.="$kernadjust Tc\n";
+ $curkern=$kernadjust;
+ }
+
+ my $par2=$par;
+ $par2=~s/^!\|!\|(\d\d\d)/chr(oct($1))/e;
+
+ foreach my $j (0..length($par2)-1)
+ {
+ my $cn=ord(substr($par2,$j,1));
+ my $chnm=$fnt->{NAM}->{$fnt->{NO}->[$cn]->[1]};
+
+ if ($chnm->[USED]==0)
+ {
+ $chnm->[USED]=1;
+ }
+ elsif ($fnt->{NO}->[$cn]->[0] ne $fnt->{NO}->[$cn]->[1])
+ {
+ # A glyph has already been remapped to this char, so find a spare
+
+ my $cn2=RemapChr($cn,$fnt,$fnt->{NO}->[$cn]->[0]);
+ $stream.="% MMM Remap $cn to $cn2\n" if $debug;
+
+ if ($cn2)
+ {
+ substr($par2,$j,1)=chr($cn2);
+
+ if ($par=~m/^!\|!\|(\d\d\d)/)
+ {
+ substr($par,4,3)=sprintf("%03o",$cn2);
+ }
+ else
+ {
+ substr($par,$j,1)=chr($cn2);
+ }
+ }
+ }
+ }
+ my $wid=TextWid($par2,$fnt);
+
+ $par=reverse(split('',$par)) if $xrev and $par!~m/^!\|!\|(\d\d\d)/;
+
+ if ($n_flg and defined($mark))
+ {
+ $mark->{ypos}=$ypos;
+ $mark->{xpos}=$xpos;
+ }
+
+ $n_flg=0;
+ IsText();
+
+ $xpos+=$wid;
+ $xpos+=($pendmv-$nomove)/$unitwidth;
+
+ $stream.="% == '$par'=$wid 'xpos=$xpos\n" if $debug;
+
+ # $pendmv = 'h' move since last 't'
+ # $nomove = width of char(s) added by 'C', 'N' or 'c'
+ # $w-flg = 'w' seen since last t
+
+ if ($fontchg)
+ {
+ PutLine();
+ $whtsz=$fontlst{$cft}->{FNT}->{spacewidth}*$cftsz;
+ $stream.="/F$cft $cftsz Tf\n", $fontchg=0 if $fontchg && defined($cft);
+ }
+
+ $gotT=1;
+
+ $stream.="% --- wht=$whtsz, pend=$pendmv, nomv=$nomove\n" if $debug;
+
+# if ($w_flg && $#lin > -1)
+# {
+# $lin[$#lin]->[0].=' ';
+# $pendmv-=$whtsz;
+# $dontglue=1 if $pendmv==0;
+# }
+
+ $wt=-$pendmv/$cftsz if $w_flg and $wt==-1;
+ $pendmv-=$nomove;
+ $nomove=0;
+ $w_flg=0;
+
+ if ($xrev)
+ {
+ PutLine(0) if $#lin > -1;
+ MakeMatrix(1);
+ $stream.="$matrix ".PutXY($xpos,$ypos)." Tm\n", $poschg=0;
+ $stream.="$curkern Tc\n";
+ $stream.="0 Tw ";
+ $stream.="($par) Tj\n";
+ MakeMatrix();
+ $stream.="$matrix ".PutXY($xpos,$ypos)." Tm\n", $poschg=0;
+ $matrixchg=0;
+ $stream.="$curkern Tc\n";
+ return;
+ }
+
+ if ($pendmv)
+ {
+ if ($#lin == -1)
+ {
+ push(@lin,[undef,-$pendmv/$cftsz]);
+ }
+ else
+ {
+ $lin[$#lin]->[1]=-$pendmv/$cftsz;
+ }
+
+ push(@lin,[$par,undef]);
+# $xpos+=$pendmv/$unitwidth;
+ $pendmv=0
+ }
+ else
+ {
+ if ($#lin == -1)
+ {
+ push(@lin,[$par,undef]);
+ }
+ else
+ {
+ $lin[$#lin]->[0].=$par;
+ }
+ }
+}
+
+sub do_u
+{
+ my $par=shift;
+
+ $par=m/([+-]?\d+) (.*)/;
+ $kernadjust=$1/$unitwidth;
+ do_t($2);
+ $kernadjust=0;
+}
+
+sub do_h
+{
+ $pendmv+=shift;
+}
+
+sub do_H
+{
+ my $par=shift;
+
+ if ($mode eq 't')
+ {
+ PutLine();
+ }
+ else
+ {
+ $xpos+=$pendmv/$unitwidth;
+ $pendmv=0;
+ }
+
+ my $newx=$par/$unitwidth;
+ $stream.=sprintf("%.3f",$newx-$tmxpos)." 0 Td\n" if $mode eq 't';
+ $tmxpos=$xpos=$newx;
+ $pendmv=$nomove=0;
+}
+
+sub do_C
+{
+ my $par=shift;
+
+ my ($par2,$nm)=FindChar($par);
+
+ do_t($par2);
+ $nomove=$fontlst{$cft}->{FNT}->{NAM}->{$par}->[WIDTH]*$cftsz ;
+}
+
+sub FindChar
+{
+ my $chnm=shift;
+ my $fnt=$fontlst{$cft}->{FNT};
+
+ if (exists($fnt->{NAM}->{$chnm}))
+ {
+ my $ch=$fnt->{NAM}->{$chnm}->[ASSIGNED];
+ $ch=RemapChr($ch,$fnt,$chnm) if ($ch > 255);
+ $fnt->{NAM}->{$chnm}->[USED]=0 if $fnt->{NO}->[$ch]->[1] eq $chnm;
+
+ return(($ch<32)?sprintf("!|!|%03o",$ch):chr($ch),$widtbl->[$ch]);
+ }
+ else
+ {
+ return(' ');
+ }
+}
+
+sub RemapChr
+{
+ my $ch=shift;
+ my $fnt=shift;
+ my $chnm=shift;
+ my $unused=0;
+
+ foreach my $un (0..$#{$fnt->{NO}})
+ {
+ next if $un >= 139 and $un <= 144;
+ $unused=$un,last if $fnt->{NO}->[$un]->[1] eq '';
+ }
+
+ if (!$unused)
+ {
+ foreach my $un (128..255)
+ {
+ next if $un >= 139 and $un <= 144;
+ my $glyph=$fnt->{NO}->[$un]->[1];
+ $unused=$un,last if $fnt->{NAM}->{$glyph}->[USED] == 0;
+ }
+ }
+
+ if ($unused && $unused <= 255)
+ {
+ my $glyph=$fnt->{NO}->[$unused]->[1];
+ delete($fontlst{$cft}->{CACHE}->{$cftsz});
+ $fnt->{NAM}->{$chnm}->[ASSIGNED]=$unused;
+ $fnt->{NAM}->{$chnm}->[USED]=1;
+ $fnt->{NO}->[$unused]->[1]=$chnm;
+ $widtbl=CacheWid($cft);
+
+ $stream.="% AAA Assign $chnm ($ch) to $unused\n" if $debug;
+
+ $ch=$unused;
+ return($ch);
+ }
+ else
+ {
+ Warn("too many glyphs used in font '$cft'");
+ return(32);
+ }
+}
+
+sub do_c
+{
+ my $par=shift;
+
+ push(@ahead,substr($par,1));
+ $par=substr($par,0,1);
+ my $ch=ord($par);
+ do_N($ch);
+}
+
+sub do_N
+{
+ my $par=shift;
+ my $fnt=$fontlst{$cft}->{FNT};
+
+ if (!defined($fnt->{NO}->[$par]))
+ {
+ Warn("no chr($par) in font $fnt->{internalname}");
+ return;
+ }
+
+ my $chnm=$fnt->{NO}->[$par]->[0];
+ do_C($chnm);
+}
+
+sub do_n
+{
+ $gotT=0;
+ PutLine(0);
+ $pendmv=$nomove=0;
+ $n_flg=1;
+ @lin=();
+ PutHotSpot($xpos) if defined($mark);
+}
+
+1;
+
+# Local Variables:
+# fill-column: 72
+# mode: CPerl
+# End:
+# vim: set cindent noexpandtab shiftwidth=4 softtabstop=4 textwidth=72:
diff --git a/src/devices/gropdf/pdfmom.1.man b/src/devices/gropdf/pdfmom.1.man
new file mode 100644
index 0000000..08d789c
--- /dev/null
+++ b/src/devices/gropdf/pdfmom.1.man
@@ -0,0 +1,229 @@
+.TH pdfmom @MAN1EXT@ "@MDATE@" "groff @VERSION@"
+.SH Name
+pdfmom \- produce PDF documents using the
+.I mom
+macro package for
+.I groff
+.
+.
+.\" ====================================================================
+.\" Legal Terms
+.\" ====================================================================
+.\"
+.\" Copyright (C) 2012-2020 Free Software Foundation, Inc.
+.\"
+.\" Permission is granted to make and distribute verbatim copies of this
+.\" manual provided the copyright notice and this permission notice are
+.\" preserved on all copies.
+.\"
+.\" Permission is granted to copy and distribute modified versions of
+.\" this manual under the conditions for verbatim copying, provided that
+.\" the entire resulting derived work is distributed under the terms of
+.\" a permission notice identical to this one.
+.\"
+.\" Permission is granted to copy and distribute translations of this
+.\" manual into another language, under the above conditions for
+.\" modified versions, except that this permission notice may be
+.\" included in translations approved by the Free Software Foundation
+.\" instead of in the original English.
+.
+.
+.\" Save and disable compatibility mode (for, e.g., Solaris 10/11).
+.do nr *groff_pdfmom_1_man_C \n[.cp]
+.cp 0
+.
+.\" Define fallback for groff 1.23's MR macro if the system lacks it.
+.nr do-fallback 0
+.if !\n(.f .nr do-fallback 1 \" mandoc
+.if \n(.g .if !d MR .nr do-fallback 1 \" older groff
+.if !\n(.g .nr do-fallback 1 \" non-groff *roff
+.if \n[do-fallback] \{\
+. de MR
+. ie \\n(.$=1 \
+. I \%\\$1
+. el \
+. IR \%\\$1 (\\$2)\\$3
+. .
+.\}
+.rr do-fallback
+.
+.
+.\" ====================================================================
+.SH Synopsis
+.\" ====================================================================
+.
+.SY pdfmom
+.RB [ \-Tpdf ]
+.RI [ groff-options ]
+.RI [ file\~ .\|.\|.]
+.YS
+.
+.
+.SY pdfmom
+.B \-Tps
+.RI [ pdfroff-options ]
+.RI [ groff-options ]
+.RI [ file\~ .\|.\|.]
+.YS
+.
+.
+.SY pdfmom
+.B \-v
+.
+.SY pdfmom
+.B \-\-version
+.YS
+.
+.
+.\" ====================================================================
+.SH Description
+.\" ====================================================================
+.
+.I pdfmom
+is a wrapper around
+.MR groff @MAN1EXT@
+that facilitates the production of PDF documents from files
+formatted with the
+.I mom
+macros.
+.
+.
+.P
+.I pdfmom
+prints to the standard output,
+so output must usually be redirected to a destination file.
+.
+The size of the final PDF can be reduced by piping the output
+through
+.MR ps2pdf 1 .
+.
+.
+.P
+If called with the
+.B \-Tpdf
+option (which is the default),
+.I pdfmom
+processes files using
+.IR groff 's
+native PDF driver,
+.MR gropdf @MAN1EXT@ .
+.
+If
+.B \-Tps
+is given,
+processing is passed over to
+.IR pdfroff ,
+which uses
+.IR groff 's
+PostScript driver.
+.
+In either case,
+multiple runs of the source file are performed in order to satisfy any
+forward references in the document.
+.
+.
+.P
+.I pdfmom
+accepts all the same options as
+.IR groff .
+.
+If
+.B \-Tps
+is given,
+the options associated with
+.I pdfroff
+are accepted as well.
+.
+When
+.I pdfmom
+calls
+.IR pdfroff ,
+the options
+.RB \[lq] "\-mpdfmark \-mom \-\-no\-toc" \[rq]
+options are implied and should not be given on the command line.
+.
+Equally,
+it is not necessary to supply the
+.B \-mom
+or
+.B "\-m\~mom"
+options when
+.B \-Tps
+is absent.
+.
+.
+.P
+PDF integration with the
+.I mom
+macros is discussed in full in the manual
+\[lq]Producing PDFs with
+.I groff
+and
+.IR mom \[rq],
+which was itself produced with
+.IR pdfmom .
+.
+.
+.P
+If called with the
+.B \-v
+or
+.B \-\-version
+options,
+.I pdfmom
+displays its version information and exits.
+.
+.
+.\" ====================================================================
+.SH Authors
+.\" ====================================================================
+.
+.I pdfmom
+was written by
+.MT deri@\:chuzzlewit\:.myzen\:.co\:.uk
+Deri James
+.ME
+and
+.MT peter@\:schaffter\:.ca
+Peter Schaffter
+.ME ,
+and is maintained by James.
+.
+.
+.\" ====================================================================
+.SH "See also"
+.\" ====================================================================
+.
+.TP
+.I @PDFDOCDIR@/\:mom\-pdf.pdf
+\[lq]Producing PDFs with
+.I groff
+and
+.IR mom \[rq],
+by Deri James and Peter Schaffter.
+.
+This file,
+together with its source,
+.IR mom\-pdf.mom ,
+is part of the
+.I groff
+distribution.
+.
+.
+.P
+.MR groff @MAN1EXT@ ,
+.MR gropdf @MAN1EXT@ ,
+.MR pdfroff @MAN1EXT@ ,
+.MR ps2pdf 1
+.
+.
+.\" Restore compatibility mode (for, e.g., Solaris 10/11).
+.cp \n[*groff_pdfmom_1_man_C]
+.do rr *groff_pdfmom_1_man_C
+.
+.
+.\" Local Variables:
+.\" fill-column: 72
+.\" mode: nroff
+.\" End:
+.\" vim: set filetype=groff textwidth=72:
diff --git a/src/devices/gropdf/pdfmom.pl b/src/devices/gropdf/pdfmom.pl
new file mode 100644
index 0000000..89977d4
--- /dev/null
+++ b/src/devices/gropdf/pdfmom.pl
@@ -0,0 +1,150 @@
+#!@PERL@
+#
+# pdfmom : Frontend to run groff -mom to produce PDFs
+# Deri James : Friday 16 Mar 2012
+#
+
+# Copyright (C) 2012-2020 Free Software Foundation, Inc.
+# Written by Deri James <deri@chuzzlewit.myzen.co.uk>
+#
+# This file is part of groff.
+#
+# groff is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# groff is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+# for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use warnings;
+use File::Temp qw/tempfile/;
+my @cmd;
+my $dev='pdf';
+my $preconv='';
+my $readstdin=1;
+my $RT_SEP='@RT_SEP@';
+
+$ENV{PATH}=$ENV{GROFF_BIN_PATH}.$RT_SEP.$ENV{PATH} if exists($ENV{GROFF_BIN_PATH});
+$ENV{TMPDIR}=$ENV{GROFF_TMPDIR} if exists($ENV{GROFF_TMPDIR});
+
+while (my $c=shift)
+{
+ $c=~s/(?<!\\)"/\\"/g;
+
+ if (substr($c,0,2) eq '-T')
+ {
+ if (length($c) > 2)
+ {
+ $dev=substr($c,2);
+ }
+ else
+ {
+ $dev=shift;
+ }
+ next;
+ }
+ elsif (substr($c,0,2) eq '-K')
+ {
+ if (length($c) > 2)
+ {
+ $preconv=$c;
+ }
+ else
+ {
+ $preconv=$c;
+ $preconv.=shift;
+ }
+ next;
+ }
+ elsif (substr($c,0,2) eq '-k')
+ {
+ $preconv=$c;
+ next;
+ }
+ elsif ($c eq '-z' or $c eq '-Z')
+ {
+ $dev=$c;
+ next;
+ }
+ elsif ($c eq '-v' or $c eq '--version')
+ {
+ print "GNU pdfmom (groff) version @VERSION@\n";
+ exit;
+ }
+ elsif (substr($c,0,1) eq '-')
+ {
+ if (length($c) > 1)
+ {
+ push(@cmd,"\"$c\"");
+ push(@cmd,"'".(shift)."'") if length($c)==2 and index('dDfFIKLmMnoPrwW',substr($c,-1)) >= 0;
+ }
+ else
+ {
+ # Just a '-'
+
+ push(@cmd,$c);
+ $readstdin=2;
+ }
+ }
+ else
+ {
+ # Got a filename?
+
+ push(@cmd,"\"$c\"");
+ $readstdin=0 if $readstdin == 1;
+
+ }
+
+}
+
+my $cmdstring=' '.join(' ',@cmd).' ';
+
+if ($readstdin)
+{
+ my ($fh,$tmpfn)=tempfile('pdfmom-XXXXX', UNLINK=>1);
+
+ while (<STDIN>)
+ {
+ print $fh ($_);
+ }
+
+ close($fh);
+
+ $cmdstring=~s/ - / $tmpfn / if $readstdin == 2;
+ $cmdstring.=" $tmpfn " if $readstdin == 1;
+}
+
+if ($dev eq 'pdf')
+{
+ system("groff -Tpdf -dLABEL.REFS=1 -mom -z $cmdstring 2>&1 | LC_ALL=C grep '^\\. *ds' | groff -Tpdf -dPDF.EXPORT=1 -dLABEL.REFS=1 -mom -z - $cmdstring 2>&1 | LC_ALL=C grep '^\\. *ds' | groff -Tpdf -mom $preconv - $cmdstring");
+}
+elsif ($dev eq 'ps')
+{
+ system("groff -Tpdf -dLABEL.REFS=1 -mom -z $cmdstring 2>&1 | LC_ALL=C grep '^\\. *ds' | pdfroff -mpdfmark -mom --no-toc - $preconv $cmdstring");
+}
+elsif ($dev eq '-z') # pseudo dev - just compile for warnings
+{
+ system("groff -Tpdf -mom -z $cmdstring");
+}
+elsif ($dev eq '-Z') # pseudo dev - produce troff output
+{
+ system("groff -Tpdf -mom -Z $cmdstring");
+}
+else
+{
+ print STDERR "Not compatible with device '-T $dev'\n";
+ exit 1;
+}
+
+# Local Variables:
+# fill-column: 72
+# mode: CPerl
+# End:
+# vim: set cindent noexpandtab shiftwidth=2 softtabstop=2 textwidth=72: