home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _20400ce9f0cbeff2fc1e1293607cab33 < prev    next >
Text File  |  2000-03-15  |  20KB  |  780 lines
  1. package HTML::FormatPS;
  2.  
  3. # $Id: FormatPS.pm,v 1.25 1998/03/26 20:31:02 aas Exp $
  4.  
  5. =head1 NAME
  6.  
  7. HTML::FormatPS - Format HTML as postscript
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.   require HTML::FormatPS;
  12.   $html = parse_htmlfile("test.html");
  13.   $formatter = new HTML::FormatPS
  14.            FontFamily => 'Helvetica',
  15.            PaperSize  => 'Letter';
  16.   print $formatter->format($html);
  17.  
  18. =head1 DESCRIPTION
  19.  
  20. The HTML::FormatPS is a formatter that outputs PostScript code.
  21. Formatting of HTML tables and forms is not implemented.
  22.  
  23. You might specify the following parameters when constructing the formatter:
  24.  
  25. =over 4
  26.  
  27. =item PaperSize
  28.  
  29. What kind of paper should we format for.  The value can be one of
  30. these: A3, A4, A5, B4, B5, Letter, Legal, Executive, Tabloid,
  31. Statement, Folio, 10x14, Quarto.
  32.  
  33. The default is "A4".
  34.  
  35. =item PaperWidth
  36.  
  37. The width of the paper in points.  Setting PaperSize also defines this
  38. value.
  39.  
  40. =item PaperHeight
  41.  
  42. The height of the paper in points.  Setting PaperSize also defines
  43. this value.
  44.  
  45. =item LeftMargin
  46.  
  47. The left margin in points.
  48.  
  49. =item RightMargin
  50.  
  51. The right margin in points.
  52.  
  53. =item HorizontalMargin
  54.  
  55. Both left and right margin at the same time.  The default value is 4 cm.
  56.  
  57. =item TopMargin
  58.  
  59. The top margin in points.
  60.  
  61. =item BottomMargin
  62.  
  63. The bottom margin in points.
  64.  
  65. =item VerticalMargin
  66.  
  67. Both top and bottom margin at the same time.  The default value is 2 cm.
  68.  
  69. =item PageNo
  70.  
  71. The parameter determines if we should put page numbers on the pages.
  72. The default is yes, so you have to set this value to 0 in order to
  73. suppress page numbers.
  74.  
  75. =item FontFamily
  76.  
  77. The parameter specifies which family of fonts to use for the formatting.
  78. Legal values are "Courier", "Helvetica" and "Times".  The default is
  79. "Times".
  80.  
  81. =item FontScale
  82.  
  83. All fontsizes might be scaled by this factor.
  84.  
  85. =item Leading
  86.  
  87. How much space between lines.  This is a factor of the fontsize used
  88. for that line.  Default is 0.1.
  89.  
  90. =back
  91.  
  92. =head1 SEE ALSO
  93.  
  94. L<HTML::Formatter>
  95.  
  96. =head1 COPYRIGHT
  97.  
  98. Copyright (c) 1995-1998 Gisle Aas. All rights reserved.
  99.  
  100. This library is free software; you can redistribute it and/or
  101. modify it under the same terms as Perl itself.
  102.  
  103. =head1 AUTHOR
  104.  
  105. Gisle Aas <aas@sn.no>
  106.  
  107. =cut
  108.  
  109. use Carp;
  110. use strict;
  111. use vars qw(@ISA $VERSION);
  112.  
  113. require HTML::Formatter;
  114. @ISA = qw(HTML::Formatter);
  115.  
  116. $VERSION = sprintf("%d.%02d", q$Revision: 1.25 $ =~ /(\d+)\.(\d+)/);
  117.  
  118. use vars qw(%PaperSizes %FontFamilies @FontSizes %param $DEBUG);
  119.  
  120. # A few routines that convert lengths into points
  121. sub mm { $_[0] * 72 / 25.4; }
  122. sub in { $_[0] * 72; }
  123.  
  124. %PaperSizes =
  125. (
  126.  A3        => [mm(297), mm(420)],
  127.  A4        => [mm(210), mm(297)],
  128.  A5        => [mm(148), mm(210)],
  129.  B4        => [729,     1032   ],
  130.  B5        => [516,     729    ],
  131.  Letter    => [in(8.5), in(11) ],
  132.  Legal     => [in(8.5), in(14) ],
  133.  Executive => [in(7.5), in(10) ],
  134.  Tabloid   => [in(11),  in(17) ],
  135.  Statement => [in(5.5), in(8.5)],
  136.  Folio     => [in(8.5), in(13) ],
  137.  "10x14"   => [in(10),  in(14) ],
  138.  Quarto    => [610,     780    ],
  139. );
  140.  
  141. %FontFamilies =
  142. (
  143.  Courier   => [qw(Courier
  144.           Courier-Bold
  145.           Courier-Oblique
  146.           Courier-BoldOblique)],
  147.  
  148.  Helvetica => [qw(Helvetica
  149.           Helvetica-Bold
  150.           Helvetica-Oblique
  151.           Helvetica-BoldOblique)],
  152.  
  153.  Times     => [qw(Times-Roman
  154.           Times-Bold
  155.           Times-Italic
  156.           Times-BoldItalic)],
  157. );
  158.  
  159.       # size   0   1   2   3   4   5   6   7
  160. @FontSizes = ( 5,  6,  8, 10, 12, 14, 18, 24, 32);
  161.  
  162. sub BOLD   { 0x01; }
  163. sub ITALIC { 0x02; }
  164.  
  165. %param =
  166. (
  167.  papersize        => 'papersize',
  168.  paperwidth       => 'paperwidth',
  169.  paperheight      => 'paperheigth',
  170.  leftmargin       => 'lmW',
  171.  rightmargin      => 'rmW',
  172.  horizontalmargin => 'mW',
  173.  topmargin        => 'tmH',
  174.  bottommargin     => 'bmH',
  175.  verticalmargin   => 'mH',
  176.  pageno           => 'printpageno',
  177.  fontfamily       => 'family',
  178.  fontscale        => 'fontscale',
  179.  leading          => 'leading',
  180. );
  181.  
  182.  
  183. sub new
  184. {
  185.     my $class = shift;
  186.     my $self = $class->SUPER::new(@_);
  187.  
  188.     # Obtained from the <title> element
  189.     $self->{title} = "";
  190.  
  191.     # The font ID last sent to the PostScript output (this may be
  192.     # temporarily different from the "current font" as read from
  193.     # the HTML input).  Initially none.
  194.     $self->{psfontid} = "";
  195.     
  196.     # Pending horizontal space.  A list [ " ", $fontid, $width ],
  197.     # or undef if no space is pending.
  198.     $self->{hspace} = undef;
  199.     
  200.     $self;
  201. }
  202.  
  203. sub default_values
  204. {
  205.     (
  206.      family      => "Times",
  207.      mH          => mm(40),
  208.      mW          => mm(20),
  209.      printpageno => 1,
  210.      fontscale   => 1,
  211.      leading     => 0.1,
  212.      papersize   => 'A4',
  213.      paperwidth  => mm(210),
  214.      paperheight => mm(297),
  215.     )
  216. }
  217.  
  218. sub configure
  219. {
  220.     my($self, $hash) = @_;
  221.     my($key,$val);
  222.     while (($key, $val) = each %$hash) {
  223.     $key = lc $key;
  224.     croak "Illegal parameter ($key => $val)" unless exists $param{$key};
  225.     $key = $param{$key};
  226.     {
  227.         $key eq "family" && do {
  228.         $val = "\u\L$val";
  229.         croak "Unknown font family ($val)"
  230.           unless exists $FontFamilies{$val};
  231.         $self->{family} = $val;
  232.         last;
  233.         };
  234.         $key eq "papersize" && do {
  235.         $self->papersize($val) || croak "Unknown papersize ($val)";
  236.         last;
  237.         };
  238.         $self->{$key} = lc $val;
  239.     }
  240.     }
  241. }
  242.  
  243. sub papersize
  244. {
  245.     my($self, $val) = @_;
  246.     $val = "\u\L$val";
  247.     my($width, $height) = @{$PaperSizes{$val}};
  248.     return 0 unless defined $width;
  249.     $self->{papersize} = $val;
  250.     $self->{paperwidth} = $width;
  251.     $self->{paperheight} = $height;
  252.     1;
  253. }
  254.  
  255.  
  256. sub fontsize
  257. {
  258.     my $self = shift;
  259.     my $size = $self->{font_size}[-1];
  260.     $size = 8 if $size > 8;
  261.     $size = 3 if $size < 0;
  262.     $FontSizes[$size] * $self->{fontscale};
  263. }
  264.  
  265. # Determine the current font and set font-related members.
  266. # If $plain_with_size is given (a number), use a plain font
  267. # of that size.  Otherwise, use the font specified by the
  268. # HTML context.  Returns the "font ID" of the current font.
  269.  
  270. sub setfont
  271. {
  272.     my($self, $plain_with_size) = @_;
  273.     my $index = 0;
  274.     my $family = $self->{family} || 'Times';
  275.     my $size = $plain_with_size;
  276.     unless ($plain_with_size) {
  277.     $index |= BOLD   if $self->{bold};
  278.     $index |= ITALIC if $self->{italic} || $self->{underline};
  279.     $family = 'Courier' if $self->{teletype};
  280.     $size = $self->fontsize;
  281.     }
  282.     my $font = $FontFamilies{$family}[$index];
  283.     my $font_with_size = "$font-$size";
  284.     if ($self->{currentfont} eq $font_with_size) {
  285.     return $self->{currentfontid};
  286.     }
  287.     $self->{currentfont} = $font_with_size;
  288.     $self->{pointsize} = $size;
  289.     my $fontmod = "Font::Metrics::$font";
  290.     $fontmod =~ s/-//g;
  291.     my $fontfile = $fontmod . ".pm";
  292.     $fontfile =~ s,::,/,g;
  293.     require $fontfile;
  294.     {
  295.     no strict 'refs';
  296.     $self->{wx} = \@{ "${fontmod}::wx" };
  297.     }
  298.     $font = $self->{fonts}{$font_with_size} || do {
  299.     my $fontID = "F" . ++$self->{fno};
  300.     $self->{fonts}{$font_with_size} = $fontID;
  301.     $fontID;
  302.     };
  303.     $self->{currentfontid} = $font;
  304.     return $font;
  305. }
  306.  
  307. # Construct PostScript code for setting the current font according 
  308. # to $fontid, or an empty string if no font change is needed.
  309. # Assumes the return string will always be output as PostScript if
  310. # nonempty, so that our notion of the current PostScript font
  311. # stays in sync with that of the PostScript interpreter.
  312.  
  313. sub switchfont
  314. {
  315.     my($self, $fontid) = @_;
  316.     if ($self->{psfontid} eq $fontid) {
  317.     return "";
  318.     } else {
  319.     $self->{psfontid} = $fontid;
  320.     return "$fontid SF";
  321.     }
  322. }
  323.  
  324. # Like setfont + switchfont.
  325.  
  326. sub findfont
  327. {
  328.     my($self, $plain_with_size) = @_;
  329.     return $self->switchfont($self->setfont($plain_with_size));
  330. }
  331.  
  332. sub width
  333. {
  334.     my $self = shift;
  335.     my $w = 0;
  336.     my $wx = $self->{wx};
  337.     my $sz = $self->{pointsize};
  338.     for (unpack("C*", $_[0])) {
  339.     $w += $wx->[$_] * $sz;
  340.     }
  341.     $w;
  342. }
  343.  
  344.  
  345. sub begin
  346. {
  347.     my $self = shift;
  348.     $self->HTML::Formatter::begin;
  349.  
  350.     # Margins is points
  351.     $self->{lm} = $self->{lmW} || $self->{mW};
  352.     $self->{rm} = $self->{paperwidth}  - ($self->{rmW} || $self->{mW});
  353.     $self->{tm} = $self->{paperheight} - ($self->{tmH} || $self->{mH});
  354.     $self->{bm} = $self->{bmH} || $self->{mH};
  355.  
  356.     # Font setup
  357.     $self->{fno} = 0;
  358.     $self->{fonts} = {};
  359.     $self->{en} = 0.55 * $self->fontsize(3);
  360.  
  361.     # Initial position
  362.     $self->{xpos} = $self->{lm};  # top of the current line
  363.     $self->{ypos} = $self->{tm};
  364.  
  365.     $self->{pageno} = 1;
  366.  
  367.     $self->{line} = "";
  368.     $self->{showstring} = "";
  369.     $self->{currentfont} = "";
  370.     $self->{prev_currentfont} = "";
  371.     $self->{largest_pointsize} = 0;
  372.  
  373.     $self->newpage;
  374. }
  375.  
  376.  
  377. sub end
  378. {
  379.     my $self = shift;
  380.     $self->showline;
  381.     $self->endpage if $self->{out};
  382.     my $pages = $self->{pageno} - 1;
  383.  
  384.     my @prolog = ();
  385.     push(@prolog, "%!PS-Adobe-3.0\n");
  386.     #push(@prolog,"%%Title: No title\n"); # should look for the <title> element
  387.     push(@prolog, "%%Creator: HTML::FormatPS (libwww-perl)\n");
  388.     push(@prolog, "%%CreationDate: " . localtime() . "\n");
  389.     push(@prolog, "%%Pages: $pages\n");
  390.     push(@prolog, "%%PageOrder: Ascend\n");
  391.     push(@prolog, "%%Orientation: Portrait\n");
  392.     my($pw, $ph) = map { int($_); } @{$self}{qw(paperwidth paperheight)};
  393.  
  394.     push(@prolog, "%%DocumentMedia: Plain $pw $ph 0 white ()\n");
  395.     push(@prolog, "%%DocumentNeededResources: \n");
  396.     my($full, %seenfont);
  397.     for $full (sort keys %{$self->{fonts}}) {
  398.     $full =~ s/-\d+$//;
  399.     next if $seenfont{$full}++;
  400.     push(@prolog, "%%+ font $full\n");
  401.     }
  402.     push(@prolog, "%%DocumentSuppliedResources: procset newencode 1.0 0\n");
  403.     push(@prolog, "%%+ encoding ISOLatin1Encoding\n");
  404.     push(@prolog, "%%EndComments\n");
  405.     push(@prolog, <<'EOT');
  406.  
  407. %%BeginProlog
  408. /S/show load def
  409. /M/moveto load def
  410. /SF/setfont load def
  411.  
  412. %%BeginResource: encoding ISOLatin1Encoding
  413. systemdict /ISOLatin1Encoding known not {
  414.     /ISOLatin1Encoding [
  415.     /space /space /space /space /space /space /space /space
  416.     /space /space /space /space /space /space /space /space
  417.     /space /space /space /space /space /space /space /space
  418.     /space /space /space /space /space /space /space /space
  419.     /space /exclam /quotedbl /numbersign /dollar /percent /ampersand
  420.         /quoteright
  421.     /parenleft /parenright /asterisk /plus /comma /minus /period /slash
  422.     /zero /one /two /three /four /five /six /seven
  423.     /eight /nine /colon /semicolon /less /equal /greater /question
  424.     /at /A /B /C /D /E /F /G
  425.     /H /I /J /K /L /M /N /O
  426.     /P /Q /R /S /T /U /V /W
  427.     /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore
  428.     /quoteleft /a /b /c /d /e /f /g
  429.     /h /i /j /k /l /m /n /o
  430.     /p /q /r /s /t /u /v /w
  431.     /x /y /z /braceleft /bar /braceright /asciitilde /space
  432.     /space /space /space /space /space /space /space /space
  433.     /space /space /space /space /space /space /space /space
  434.     /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
  435.     /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron
  436.     /space /exclamdown /cent /sterling /currency /yen /brokenbar /section
  437.     /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen
  438.         /registered /macron
  439.     /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph
  440.         /periodcentered
  441.     /cedillar /onesuperior /ordmasculine /guillemotright /onequarter
  442.         /onehalf /threequarters /questiondown
  443.     /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla
  444.     /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex
  445.         /Idieresis
  446.     /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
  447.     /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn
  448.         /germandbls
  449.     /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla
  450.     /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex
  451.         /idieresis
  452.     /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide
  453.     /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn
  454.         /ydieresis
  455.     ] def
  456. } if
  457. %%EndResource
  458. %%BeginResource: procset newencode 1.0 0
  459. /NE { %def
  460.    findfont begin
  461.       currentdict dup length dict begin
  462.      { %forall
  463.         1 index/FID ne {def} {pop pop} ifelse
  464.      } forall
  465.      /FontName exch def
  466.      /Encoding exch def
  467.      currentdict dup
  468.       end
  469.    end
  470.    /FontName get exch definefont pop
  471. } bind def
  472. %%EndResource
  473. %%EndProlog
  474. EOT
  475.  
  476.     push(@prolog, "\n%%BeginSetup\n");
  477.     for $full (sort keys %{$self->{fonts}}) {
  478.     my $short = $self->{fonts}{$full};
  479.     $full =~ s/-(\d+)$//;
  480.     my $size = $1;
  481.     push(@prolog, "ISOLatin1Encoding/$full-ISO/$full NE\n");
  482.     push(@prolog, "/$short/$full-ISO findfont $size scalefont def\n");
  483.     }
  484.     push(@prolog, "%%EndSetup\n");
  485.  
  486.     $self->collect("\n%%Trailer\n%%EOF\n");
  487.     unshift(@{$self->{output}}, @prolog);
  488. }
  489.  
  490.  
  491. sub header_start
  492. {
  493.     my($self, $level, $node) = @_;
  494.     # If we are close enough to be bottom of the page, start a new page
  495.     # instead of this:
  496.     $self->vspace(1 + (6-$level) * 0.4);
  497.     $self->{bold}++;
  498.     push(@{$self->{font_size}}, 8 - $level);
  499.     1;
  500. }
  501.  
  502.  
  503. sub header_end
  504. {
  505.     my($self, $level, $node) = @_;
  506.     $self->vspace(1);
  507.     $self->{bold}--;
  508.     pop(@{$self->{font_size}});
  509.     1;
  510. }
  511.  
  512. sub hr_start
  513. {
  514.     my $self = shift;
  515.     $self->showline;
  516.     $self->vspace(0.5);
  517.     $self->skip_vspace;
  518.     my $lm = $self->{lm};
  519.     my $rm = $self->{rm};
  520.     my $y = $self->{ypos};
  521.     $self->collect(sprintf "newpath %.1f %.1f M %.1f %.1f lineto stroke\n",
  522.            $lm, $y, $rm, $y);
  523.     $self->vspace(0.5);
  524. }
  525.  
  526.  
  527. sub skip_vspace
  528. {
  529.     my $self = shift;
  530.     if (defined $self->{vspace}) {
  531.     $self->showline;
  532.     if ($self->{out}) {
  533.         $self->{ypos} -= $self->{vspace} * 10 * $self->{fontscale};
  534.         if ($self->{ypos} < $self->{bm}) {
  535.         $self->newpage;
  536.         }
  537.     }
  538.     $self->{xpos} = $self->{lm};
  539.     $self->{vspace} = undef;
  540.     $self->{hspace} = undef;
  541.     }
  542. }
  543.  
  544.  
  545. sub show
  546. {
  547.     my $self = shift;
  548.     my $str = $self->{showstring};
  549.     return unless length $str;
  550.     $str =~ s/([\(\)\\])/\\$1/g;    # must escape parentesis
  551.     $self->{line} .= "($str)S\n";
  552.     $self->{showstring} = "";
  553. }
  554.  
  555.  
  556. sub showline
  557. {
  558.     my $self = shift;
  559.     $self->show;
  560.     my $line = $self->{line};
  561.     return unless length $line;
  562.     $self->{ypos} -= $self->{largest_pointsize} || $self->{pointsize};
  563.     if ($self->{ypos} < $self->{bm}) {
  564.     $self->newpage;
  565.     $self->{ypos} -= $self->{pointsize};
  566.     # must set current font again
  567.     my $font = $self->{prev_currentfont};
  568.     if ($font) {
  569.         $self->collect("$self->{fonts}{$font} SF\n");
  570.     }
  571.     }
  572.     my $lm = $self->{lm};
  573.     my $x = $lm;
  574.     if ($self->{center}) {
  575.     # Unfortunately, the center attribute is gone when we get here,
  576.     # so this code is never activated
  577.     my $linewidth = $self->{xpos} - $lm;
  578.     $x += ($self->{rm} - $lm - $linewidth) / 2;
  579.     }
  580.  
  581.     $self->collect(sprintf "%.1f %.1f M\n", $x, $self->{ypos});  # moveto
  582.     $line =~ s/\s\)S$/)S/;  # many lines will end with space
  583.     $self->collect($line);
  584.  
  585.     if ($self->{bullet}) {
  586.     # Putting this behind the first line of the list item
  587.     # makes it more likely that we get the right font.  We should
  588.     # really set the font that we want to use.
  589.     my $bullet = $self->{bullet};
  590.     if ($bullet eq '*') {
  591.         # There is no character that is really suitable.  Lets make
  592.         # filled cirle ourself.
  593.         my $radius = $self->{pointsize} / 4;
  594.         $self->collect(sprintf "newpath %.1f %.1f %.1f 0 360 arc fill\n",
  595.                $self->{bullet_pos} + $radius,
  596.                $self->{ypos} + $radius, $radius);
  597.     } else {
  598.         $self->collect(sprintf "%.1f %.1f M\n", # moveto
  599.                $self->{bullet_pos},
  600.                $self->{ypos});
  601.         $self->collect("($bullet)S\n");
  602.     }
  603.     $self->{bullet} = '';
  604.  
  605.     }
  606.  
  607.     $self->{prev_currentfont} = $self->{currentfont};
  608.     $self->{largest_pointsize} = 0;
  609.     $self->{line} = "";
  610.     $self->{xpos} = $lm;
  611.     # Additional linespacing
  612.     $self->{ypos} -= $self->{leading} * $self->{pointsize};
  613. }
  614.  
  615.  
  616. sub endpage
  617. {
  618.     my $self = shift;
  619.     # End previous page
  620.     $self->collect("showpage\n");
  621.     $self->{pageno}++;
  622. }
  623.  
  624.  
  625. sub newpage
  626. {
  627.     my $self = shift;
  628.     if ($self->{'out'}) {
  629.     $self->endpage;
  630.     }
  631.     $self->{'out'} = 0;
  632.     my $pageno = $self->{pageno};
  633.     $self->collect("\n%%Page: $pageno $pageno\n");
  634.  
  635.     # Print area marker (just for debugging)
  636.     if ($DEBUG) {
  637.     my($llx, $lly, $urx, $ury) = map { sprintf "%.1f", $_}
  638.                      @{$self}{qw(lm bm rm tm)};
  639.     $self->collect("gsave 0.1 setlinewidth\n");
  640.     $self->collect("clippath 0.9 setgray fill 1 setgray\n");
  641.     $self->collect("$llx $lly moveto $urx $lly lineto $urx $ury lineto $llx $ury lineto closepath fill\n");
  642.     $self->collect("grestore\n");
  643.     }
  644.  
  645.     # Print page number
  646.     if ($self->{printpageno}) {
  647.     $self->collect("%% Title and pageno\n");
  648.     my $f = $self->findfont(8);
  649.     $self->collect("$f\n") if $f;
  650.         my $x = $self->{paperwidth};
  651.         if ($x) { $x -= 30; } else { $x = 30; }
  652.         $self->collect(sprintf "%.1f 30.0 M($pageno)S\n", $x);
  653.     $x = $self->{lm};
  654.     $self->collect(sprintf "%.1f 30.0 M($self->{title})S\n", $x);
  655.     }
  656.     $self->collect("\n");
  657.  
  658.     $self->{xpos} = $self->{lm};
  659.     $self->{ypos} = $self->{tm};
  660. }
  661.  
  662.  
  663. sub out
  664. {
  665.     my($self, $text) = @_;
  666.     if ($self->{collectingTheTitle}) {
  667.         # Both collect and print the title
  668.         $text =~ s/([\(\)\\])/\\$1/g; # Escape parens.
  669.         $self->{title} .= $text;
  670.     return;
  671.     }
  672.  
  673.     my $fontid = $self->setfont();
  674.     my $w = $self->width($text);
  675.  
  676.     if ($text =~ /^\s*$/) {
  677.         $self->{hspace} = [ " ", $fontid, $w ];
  678.         return;
  679.     }
  680.  
  681.     $self->skip_vspace;
  682.  
  683.     # determine spacing / line breaks needed before text
  684.     if ($self->{hspace}) {
  685.     my ($stext, $sfont, $swidth) = @{$self->{hspace}};
  686.     if ($self->{xpos} + $swidth + $w > $self->{rm}) {
  687.         # line break
  688.         $self->showline;
  689.     } else {
  690.         # no line break; output a space
  691.             $self->show_with_font($stext, $sfont, $swidth);
  692.     }
  693.     $self->{hspace} = undef;
  694.     }
  695.  
  696.     # output the text
  697.     $self->show_with_font($text, $fontid, $w);
  698. }
  699.  
  700.  
  701. sub show_with_font {
  702.     my ($self, $text, $fontid, $w) = @_;
  703.  
  704.     my $fontps = $self->switchfont($fontid);
  705.     if (length $fontps) {
  706.     $self->show;
  707.     $self->{line} .= "$fontps\n";
  708.     }
  709.  
  710.     $self->{xpos} += $w;
  711.     $self->{showstring} .= $text;
  712.     $self->{largest_pointsize} = $self->{pointsize}
  713.       if $self->{largest_pointsize} < $self->{pointsize};
  714.     $self->{'out'}++;
  715. }
  716.  
  717.  
  718. sub pre_out
  719. {
  720.     my($self, $text) = @_;
  721.     $self->skip_vspace;
  722.     $self->tt_start;
  723.     my $font = $self->findfont();
  724.     if (length $font) {
  725.     $self->show;
  726.     $self->{line} .= "$font\n";
  727.     }
  728.     while ($text =~ s/(.*)\n//) {
  729.         $self->{'out'}++;
  730.     $self->{showstring} .= $1;
  731.     $self->showline;
  732.     }
  733.     $self->{showstring} .= $text;
  734.     $self->tt_end;
  735. }
  736.  
  737. sub bullet
  738. {
  739.     my($self, $bullet) = @_;
  740.     $self->{bullet} = $bullet;
  741.     $self->{bullet_pos} = $self->{lm};
  742. }
  743.  
  744. sub adjust_lm
  745. {
  746.     my $self = shift;
  747.     $self->showline;
  748.     $self->{lm} += $_[0] * $self->{en};
  749. }
  750.  
  751.  
  752. sub adjust_rm
  753. {
  754.     my $self = shift;
  755.     $self->showline;
  756.     $self->{rm} += $_[0] * $self->{en};
  757. }
  758.  
  759. sub head_start {
  760.     1;
  761. }
  762.  
  763. sub head_end {
  764.     1;
  765. }
  766.  
  767. sub title_start {
  768.     my($self) = @_;
  769.     $self->{collectingTheTitle} = 1;
  770.     1;
  771. }
  772.  
  773. sub title_end {
  774.     my($self) = @_;
  775.     $self->{collectingTheTitle} = 0;
  776.     1;
  777. }
  778.  
  779. 1;
  780.