diff options
Diffstat (limited to 'src/devices/gropdf')
| -rw-r--r-- | src/devices/gropdf/TODO | 31 | ||||
| -rw-r--r-- | src/devices/gropdf/gropdf.1.man | 1845 | ||||
| -rw-r--r-- | src/devices/gropdf/gropdf.am | 58 | ||||
| -rw-r--r-- | src/devices/gropdf/gropdf.pl | 3928 | ||||
| -rw-r--r-- | src/devices/gropdf/pdfmom.1.man | 229 | ||||
| -rw-r--r-- | src/devices/gropdf/pdfmom.pl | 150 |
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: |