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