—

              
package HTML::FormatPS;
BEGIN {
  $HTML::FormatPS::VERSION = '2.04.02'; # TRIAL
}
BEGIN {
  $HTML::FormatPS::AUTHORITY = 'cpan:NIGELM';
}
# ABSTRACT: Format HTML as PostScript
use Carp;
use strict;
use vars qw(@ISA $VERSION);
use HTML::Formatter ();
BEGIN { *DEBUG = \&HTML::Formatter::DEBUG unless defined &DEBUG }
@ISA = qw(HTML::Formatter);
use vars qw(%PaperSizes %FontFamilies @FontSizes %param $DEBUG);
# A few routines that convert lengths into points
sub mm { $_[0] * 72 / 25.4; }
sub in { $_[0] * 72; }
%PaperSizes =
(
 A3        => [mm(297), mm(420)],
 A4        => [mm(210), mm(297)],
 A5        => [mm(148), mm(210)],
 B4        => [729,     1032   ],
 B5        => [516,     729    ],
 Letter    => [in(8.5), in(11) ],
 Legal     => [in(8.5), in(14) ],
 Executive => [in(7.5), in(10) ],
 Tabloid   => [in(11),  in(17) ],
 Statement => [in(5.5), in(8.5)],
 Folio     => [in(8.5), in(13) ],
 "10x14"   => [in(10),  in(14) ],
 Quarto    => [610,     780    ],
);
%FontFamilies =
(
 Courier   => [qw(Courier
          Courier-Bold
          Courier-Oblique
          Courier-BoldOblique)],
 Helvetica => [qw(Helvetica
          Helvetica-Bold
          Helvetica-Oblique
          Helvetica-BoldOblique)],
 Times     => [qw(Times-Roman
          Times-Bold
          Times-Italic
          Times-BoldItalic)],
);
      # size   0   1   2   3   4   5   6   7
@FontSizes = ( 5,  6,  8, 10, 12, 14, 18, 24, 32);
sub BOLD   () { 0x01; }
sub ITALIC () { 0x02; }
%param =
(
 papersize        => 'papersize',
 paperwidth       => 'paperwidth',
 paperheight      => 'paperheigth',
 leftmargin       => 'lmW',
 rightmargin      => 'rmW',
 horizontalmargin => 'mW',
 topmargin        => 'tmH',
 bottommargin     => 'bmH',
 verticalmargin   => 'mH',
 no_prolog        => 'no_prolog',
 no_trailer       => 'no_trailer',
 pageno           => 'printpageno',
 startpage        => 'startpage',
 fontfamily       => 'family',
 fontscale        => 'fontscale',
 leading          => 'leading',
);
sub new
{
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    # Obtained from the <title> element
    $self->{title} = "";
    # The font ID last sent to the PostScript output (this may be
    # temporarily different from the "current font" as read from
    # the HTML input).  Initially none.
    $self->{psfontid} = "";
    # Pending horizontal space.  A list [ " ", $fontid, $width ],
    # or undef if no space is pending.
    $self->{hspace} = undef;
    $self;
}
sub default_values
{
    (
     shift->SUPER::default_values(),
     family      => "Times",
     mH          => mm(40),
     mW          => mm(20),
     printpageno => 1,
     startpage   => 1,  # yes, you can start numbering at 10, or whatever.
     fontscale   => 1,
     leading     => 0.1,
     papersize   => 'A4',
     paperwidth  => mm(210),
     paperheight => mm(297),
    )
}
sub configure
{
    my($self, $hash) = @_;
    my($key,$val);
    while (($key, $val) = each %$hash) {
    $key = lc $key;
    croak "Illegal parameter ($key => $val)" unless exists $param{$key};
    $key = $param{$key};
    {
        $key eq "family" && do {
        $val = "\u\L$val";
        croak "Unknown font family ($val)"
          unless exists $FontFamilies{$val};
        $self->{family} = $val;
        last;
        };
        $key eq "papersize" && do {
        $self->papersize($val) ||
          croak sprintf
                  "Unknown papersize '%s'.\nThe knowns are: %s.\nAborting",
                    $val,
                    join(', ',  sort keys %PaperSizes)
                ;
        last;
        };
        $self->{$key} = lc $val;
    }
    }
}
sub papersize
{
    my($self, $val) = @_;
    $val = "\u\L$val";
    my($width, $height) = @{$PaperSizes{$val} || return 0};
    return 0 unless defined $width;
    $self->{papersize} = $val;
    $self->{paperwidth} = $width;
    $self->{paperheight} = $height;
    1;
}
sub fontsize
{
    my $self = shift;
    my $size = $self->{font_size}[-1];
    $size = 8 if $size > 8;
    $size = 3 if $size < 0;
    $FontSizes[$size] * $self->{fontscale};
}
# Determine the current font and set font-related members.
# If $plain_with_size is given (a number), use a plain font
# of that size.  Otherwise, use the font specified by the
# HTML context.  Returns the "font ID" of the current font.
sub setfont
{
    my($self, $plain_with_size) = @_;
    my $index = 0;
    my $family = $self->{family} || 'Times';
    my $size = $plain_with_size;
    unless ($plain_with_size) {
    $index |= BOLD   if $self->{bold};
    $index |= ITALIC if $self->{italic} || $self->{underline};
    $family = 'Courier' if $self->{teletype};
    $size = $self->fontsize;
    }
    my $font = $FontFamilies{$family}[$index];
    my $font_with_size = "$font-$size";
    if ($self->{currentfont} eq $font_with_size) {
    return $self->{currentfontid};
    }
    $self->{currentfont} = $font_with_size;
    $self->{pointsize} = $size;
    my $fontmod = "Font::Metrics::$font";
    $fontmod =~ s/-//g;
    my $fontfile = $fontmod . ".pm";
    $fontfile =~ s,::,/,g;
    require $fontfile;
    {
    no strict 'refs';
    $self->{wx} = \@{ "${fontmod}::wx" };
    }
    $font = $self->{fonts}{$font_with_size} || do {
    my $fontID = "F" . ++$self->{fno};
    $self->{fonts}{$font_with_size} = $fontID;
    $fontID;
    };
    $self->{currentfontid} = $font;
    return $font;
}
# Construct PostScript code for setting the current font according
# to $fontid, or an empty string if no font change is needed.
# Assumes the return string will always be output as PostScript if
# nonempty, so that our notion of the current PostScript font
# stays in sync with that of the PostScript interpreter.
sub switchfont
{
    my($self, $fontid) = @_;
    if ($self->{psfontid} eq $fontid) {
    return "";
    } else {
    $self->{psfontid} = $fontid;
    return "$fontid SF";
    }
}
# Like setfont + switchfont.
sub findfont
{
    my($self, $plain_with_size) = @_;
    return $self->switchfont($self->setfont($plain_with_size));
}
sub width
{
    my $self = shift;
    my $w = 0;
    my $wx = $self->{wx};
    my $sz = $self->{pointsize};
    for (unpack("C*", $_[0])) {
    $w += $wx->[$_] * $sz   # unless  $_ eq 0xAD; # optional hyphen
    }
    $w;
}
sub begin
{
    my $self = shift;
    $self->SUPER::begin;
    # Margins are in points
    $self->{lm} = $self->{lmW} || $self->{mW};
    $self->{rm} = $self->{paperwidth}  - ($self->{rmW} || $self->{mW});
    $self->{tm} = $self->{paperheight} - ($self->{tmH} || $self->{mH});
    $self->{bm} = $self->{bmH} || $self->{mH};
    $self->{'orig_margins'} = # used only by the debug-mode print-area marker
        [  map { sprintf "%.1f", $_}
         @{$self}{qw(lm bm rm tm)}
    ];
    # Font setup
    $self->{fno} = 0;
    $self->{fonts} = {};
    $self->{en} = 0.55 * $self->fontsize(3);
    # Initial position
    $self->{xpos} = $self->{lm};  # top of the current line
    $self->{ypos} = $self->{tm};
    $self->{pageno} = 1;
    $self->{visible_page_number} = $self->{startpage};
    $self->{line} = "";
    $self->{showstring} = "";
    $self->{currentfont} = "";
    $self->{prev_currentfont} = "";
    $self->{largest_pointsize} = 0;
    $self->newpage;
}
sub end
{
    my $self = shift;
    $self->showline;
    $self->endpage if $self->{'out'};
    my $pages = $self->{pageno} - 1;
    my @prolog = ();
    push(@prolog, "%!PS-Adobe-3.0\n");
    #push(@prolog,"%%Title: No title\n"); # should look for the <title> element
    push(@prolog, "%%Creator: " . $self->version_tag . "\n");
    push(@prolog, "%%CreationDate: " . localtime() . "\n");
    push(@prolog, "%%Pages: $pages\n");
    push(@prolog, "%%PageOrder: Ascend\n");
    push(@prolog, "%%Orientation: Portrait\n");
    my($pw, $ph) = map { int($_); } @{$self}{qw(paperwidth paperheight)};
    push(@prolog, "%%DocumentMedia: Plain $pw $ph 0 white ()\n");
    push(@prolog, "%%DocumentNeededResources: \n");
    my($full, %seenfont);
    for $full (sort keys %{$self->{fonts}}) {
    $full =~ s/-\d+$//;
    next if $seenfont{$full}++;
    push(@prolog, "%%+ font $full\n");
    }
    push(@prolog, "%%DocumentSuppliedResources: procset newencode 1.0 0\n");
    push(@prolog, "%%+ encoding ISOLatin1Encoding\n");
    push(@prolog, "%%EndComments\n");
    push(@prolog, <<'EOT');
%%BeginProlog
/S/show load def
/M/moveto load def
/SF/setfont load def
%%BeginResource: encoding ISOLatin1Encoding
systemdict /ISOLatin1Encoding known not {
    /ISOLatin1Encoding [
    /space /space /space /space /space /space /space /space
    /space /space /space /space /space /space /space /space
    /space /space /space /space /space /space /space /space
    /space /space /space /space /space /space /space /space
    /space /exclam /quotedbl /numbersign /dollar /percent /ampersand
        /quoteright
    /parenleft /parenright /asterisk /plus /comma /minus /period /slash
    /zero /one /two /three /four /five /six /seven
    /eight /nine /colon /semicolon /less /equal /greater /question
    /at /A /B /C /D /E /F /G
    /H /I /J /K /L /M /N /O
    /P /Q /R /S /T /U /V /W
    /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore
    /quoteleft /a /b /c /d /e /f /g
    /h /i /j /k /l /m /n /o
    /p /q /r /s /t /u /v /w
    /x /y /z /braceleft /bar /braceright /asciitilde /space
    /space /space /space /space /space /space /space /space
    /space /space /space /space /space /space /space /space
    /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
    /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron
    /space /exclamdown /cent /sterling /currency /yen /brokenbar /section
    /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen
        /registered /macron
    /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph
        /periodcentered
    /cedillar /onesuperior /ordmasculine /guillemotright /onequarter
        /onehalf /threequarters /questiondown
    /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla
    /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex
        /Idieresis
    /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
    /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn
        /germandbls
    /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla
    /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex
        /idieresis
    /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide
    /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn
        /ydieresis
    ] def
} if
%%EndResource
%%BeginResource: procset newencode 1.0 0
/NE { %def
   findfont begin
      currentdict dup length dict begin
     { %forall
        1 index/FID ne {def} {pop pop} ifelse
     } forall
     /FontName exch def
     /Encoding exch def
     currentdict dup
      end
   end
   /FontName get exch definefont pop
} bind def
%%EndResource
%%EndProlog
EOT
    push(@prolog, "\n%%BeginSetup\n");
    for $full (sort keys %{$self->{fonts}}) {
    my $short = $self->{fonts}{$full};
    $full =~ s/-(\d+)$//;
    my $size = $1;
    push(@prolog, "ISOLatin1Encoding/$full-ISO/$full NE\n");
    push(@prolog, "/$short/$full-ISO findfont $size scalefont def\n");
    }
    push(@prolog, "%%EndSetup\n");
    $self->collect("\n%%Trailer\n%%EOF\n")
      unless $self->{'no_trailer'};
    unshift(@{$self->{output}}, @prolog)
      unless $self->{'no_prolog'};
}
sub header_start
{
    my($self, $level) = @_;
    # If we are close enough to be bottom of the page, start a new page
    # instead of this:
    DEBUG > 1 and print "  Heading of level $level\n";
    $self->vspace(1 + (6-$level) * 0.4);
    $self->{bold}++;
    push(@{$self->{font_size}}, 8 - $level);
    1;
}
sub header_end
{
    my($self) = @_;
    $self->vspace(1);
    $self->{bold}--;
    pop(@{$self->{font_size}});
    1;
}
sub hr_start
{
    my $self = shift;
    DEBUG > 1 and print "  Making an HR.\n";
    $self->showline;
    $self->vspace(0.5);
    $self->skip_vspace;
    my $lm = $self->{lm};
    my $rm = $self->{rm};
    my $y = $self->{ypos};
    $self->collect(sprintf "newpath %.1f %.1f M %.1f %.1f lineto stroke\n",
           $lm, $y, $rm, $y);
    $self->vspace(0.5);
}
sub skip_vspace
{
    my $self = shift;
    DEBUG > 2 and print "   Skipping some amount of vspace.\n";
    if (defined $self->{vspace}) {
    $self->showline;
    if ($self->{'out'}) {
        $self->{ypos} -= $self->{vspace} * 10 * $self->{fontscale};
        if ($self->{ypos} < $self->{bm}) {
        DEBUG > 2 and printf "   Skipping %s bits of vspace meant moving y down by %.1f to %.1f (via fontscale %s), forcing a pagebreak.\n",
          $self->{'vspace'},
          $self->{'ypos'},
                  $self->{'vspace'} * 10 * $self->{fontscale},
          $self->{'fontscale'},
        ;
        $self->newpage;
        } else {
        DEBUG > 2 and printf "   Skipping %s bits of vspace meant moving y down by %.1f to %.1f up.\n",
          $self->{vspace},
          $self->{'ypos'},
                  $self->{vspace} * 10 * $self->{fontscale},
          $self->{'fontscale'},
        ;
        }
    } else {
        DEBUG > 2 and printf "   Would skip $$self{vspace} bits of vspace, but 'out' is false.\n", $$self{'ypos'};
    }
    $self->{xpos} = $self->{lm};
    $self->{vspace} = undef;
    $self->{hspace} = undef;
    } else {
      DEBUG > 2 and print "   (But no vspace to skip.)\n";
    }
    DEBUG > 3 and print "    Done skipping that vspace.\n";
    return;
}
sub show
{
    my $self = shift;
    my $str = $self->{showstring};
    $str =~ tr/\x01//d;
    return unless length $str;
    $str =~ s/[^\x00-\xff]/\xA4/g;
     # replace any Unicode characters with the otherwise useless
     #  International Communist Conspiracy money logo!
    $str =~ s/([\(\)\\])/\\$1/g;    # must escape parentheses and backslash
    $self->{line} .= "($str)S\n";
    $self->{showstring} = "";
}
sub showline
{
    my $self = shift;
    $self->show;
    my $line = $self->{line};
    unless( length $line ) {
        DEBUG > 2
         and print "   Showline is a no-op because line buffer is empty\n";
        return;
    }
    if( DEBUG > 2 ) {
        my $l = $line;
        $l =~ tr/\n/\xB6/;
        print "   Showline is going to emit <$l>\n";
    }
    $self->{ypos} -= $self->{largest_pointsize} || $self->{pointsize};
    if ($self->{ypos} < $self->{bm}) {
        DEBUG > 2
         and print "   Showline has to start a new page first.\n";
        DEBUG > 2 and print "   vspace value before newpage: ",
          defined($self->{vspace}) ? $self->{vspace} : 'undef', "\n";
        DEBUG > 10 and $self->dump_state;
    $self->newpage;
         # newpage might alter currentfont!
        DEBUG > 2 and print "  vspace value after newpage: ",
          defined($self->{vspace}) ? $self->{vspace} : 'undef', "\n";
        DEBUG > 2 and printf "   Moving y from %.1f down to %.f because of pointsize %s\n",
         $self->{ypos}, $self->{ypos} - $self->{pointsize}, $self->{pointsize},
        ;
    $self->{ypos} -= $self->{pointsize};
        DEBUG > 2 and printf "   Newpage's (x,y) is (%.1f, %.1f).\n",
         @$self{'xpos', 'ypos'};
    # must set current font again
    my $font = $self->{prev_currentfont};
    if ($font) {
        $self->collect("$self->{fonts}{$font} SF\n\n");
    }
        DEBUG > 10 and $self->dump_state;
        DEBUG > 2 and print "   End of doing newpage.\n";
    }
    #DEBUG > 2 and $self->dump_state;
    my $lm = $self->{lm};
    my $x = $lm;
    if ($self->{center}) {
    # Unfortunately, the center attribute is gone when we get here,
    # so this code is never activated
    my $linewidth = $self->{xpos} - $lm;
    $x += ($self->{rm} - $lm - $linewidth) / 2;
    }
    $self->collect(sprintf "%.1f %.1f M\n", $x, $self->{ypos});  # moveto
    $line =~ s/\s\)S$/)S/;  # many lines will end uselessly with space
    $self->collect($line);
    $self->{'out'}++;
    if( DEBUG > 3 ) {
        my $l = $line;
        $l =~ tr/\n/\xB6/;
        print "   Showline has just emitted <$l>\n";
    }
    DEBUG > 3 and print "   vspace value after collection: ",
          defined($self->{vspace}) ? $self->{vspace} : 'undef', "\n";
    if ($self->{bullet}) {
    # Putting this behind the first line of the list item
    # makes it more likely that we get the right font.  We should
    # really set the font that we want to use.
    my $bullet = $self->{bullet};
    if ($bullet eq '*') {
        # There is no character that is really suitable.  Let's make
        # a medium-sized filled cirle ourself.
        my $radius = $self->{pointsize} / 8;
            DEBUG > 2 and
             print "   Adding code for a '*' bullet for that line.\n";
        $self->collect(sprintf "newpath %.1f %.1f %.1f 0 360 arc fill\n",
               $self->{bullet_pos} + $radius,
               $self->{ypos} + $radius * 2,
               $radius,
        );
    } else {
            DEBUG > 2 and
             print "   Adding code for a '$bullet' bullet for that line.\n";
        $self->collect(sprintf "%.1f (%s) stringwidth pop sub %.1f add %.1f M\n", # moveto
               $self->{bullet_pos},
               $bullet,
               $self->{pointsize} * 0.62,
               $self->{ypos},
        );
        $self->collect("($bullet)S\n");
    }
    $self->{bullet} = '';
    }
    $self->{prev_currentfont} = $self->{currentfont};
    $self->{largest_pointsize} = 0;
    $self->{line} = "";
    $self->{xpos} = $lm;
    # Additional linespacing
    DEBUG > 2 and printf "   Leading makes me move down from (%.1f, %.1f) by (%.1f * %.1f = %.1f).\n", @$self{'xpos', 'ypos'}, $self->{leading}, $self->{pointsize} , $self->{leading} * $self->{pointsize};
    $self->{ypos} -= $self->{leading} * $self->{pointsize};
    DEBUG > 2 and printf "   Showline ends by setting (x,y) to (%.1f, %.1f).\n",
     @$self{'xpos', 'ypos'};
    return;
}
sub endpage
{
    my $self = shift;
    DEBUG > 1 and print "  Ending page $$self{pageno}\n";
    # End previous page
    $self->collect("showpage\n");
    $self->{visible_page_number}++;
    $self->{pageno}++;
}
sub newpage
{
    my $self = shift;
    local $self->{'pointsize'} = $self->{'pointsize'};
     # That's needed for protecting against one bit of the
     #  potential side-effects from from page-numbering code
    if ($self->{'out'}) { # whether we've sent anything to the current page so far.
        DEBUG > 2 and print "   Newpage sees that 'out' is true ($$self{'out'}), so calls endpage.\n";
    $self->endpage;
        $self->collect( sprintf
         "%% %s has sent %s write-events to the above page.\n",
         ref($self), $self->{'out'},
        );
    }
    $self->{'out'} = 0;
    my $pageno = $self->{pageno};
    my $visible_page_number = $self->{visible_page_number};
    $self->collect("\n%%Page: $pageno $pageno\n");
    DEBUG and print " Starting page $pageno\n";
    # Print area marker (just for debugging)
    if ($DEBUG or DEBUG > 5) {
    my($llx, $lly, $urx, $ury) = @{ $self->{'orig_margins'} };
    $self->collect("gsave 0.1 setlinewidth\n");
    $self->collect("clippath 0.9 setgray fill 1 setgray\n");
    $self->collect("$llx $lly moveto $urx $lly lineto $urx $ury lineto $llx $ury lineto closepath fill\n");
    $self->collect("grestore\n");
    }
    # Print page number
    if ($self->{printpageno}) {
        DEBUG > 2 and print "   Printing page number $visible_page_number (really page $pageno).\n";
    $self->collect("%% Title and pageno\n");
    my $f = $self->findfont(8);
    $self->collect("$f\n") if $f;
        my $x = $self->{paperwidth};
        if ($x) { $x -= 30; } else { $x = 30; }
        $self->collect(sprintf "%.1f 30.0 M($visible_page_number)S\n", $x);
    $x = $self->{lm};
    $self->{title} =~ tr/\x01//d;
    $self->collect(sprintf "%.1f 30.0 M($self->{title})S\n", $x);
    } else {
        DEBUG > 2 and print "   Pointedly not printing page number.\n";
    }
    $self->collect("\n");
    DEBUG > 2 and printf "  Newpage ends by setting (x,y) to (%.1f across, %.1f up)\n",
     @$self{'lm','tm'};
    $self->{xpos} = $self->{lm};
    $self->{ypos} = $self->{tm};
}
sub out   # Output a word
{
    my($self, $text) = @_;
    $text =~ tr/\xA0\xAD/ /d;
    DEBUG > 3 and print "    Trapping new word <$text>\n";
    if ($self->{collectingTheTitle}) {
        # Both collect and print the title
        $text =~ s/([\(\)\\])/\\$1/g; # Escape parens and the backslash
        $self->{title} .= $text;
    return;
    }
    my $fontid = $self->setfont();
    my $w = $self->width($text);
    if ($text =~ /^\s*$/) {
        $self->{hspace} = [ " ", $fontid, $w ];
        return;
    }
    $self->skip_vspace;
    # determine spacing / line breaks needed before text
    if ($self->{hspace}) {
    my ($stext, $sfont, $swidth) = @{$self->{hspace}};
    if ($self->{xpos} + $swidth + $w > $self->{rm}) {
        # line break
        $self->showline;
    } else {
        # no line break; output a space
            $self->show_with_font($stext, $sfont, $swidth);
    }
    $self->{hspace} = undef;
    }
    # output the text
    $self->show_with_font($text, $fontid, $w);
}
sub show_with_font {
    my ($self, $text, $fontid, $w) = @_;
    my $fontps = $self->switchfont($fontid);
    if (length $fontps) {
    $self->show;
    $self->{line} .= "$fontps\n";
    }
    $self->{xpos} += $w;
    $self->{showstring} .= $text;
    DEBUG > 4 and print "     Appending to string buffer: \"$text\" with font $fontid\n";
    DEBUG > 4 and printf "     xpos is now %.1f across.\n", ${$self}{'xpos'};
    $self->{largest_pointsize} = $self->{pointsize}
      if $self->{largest_pointsize} < $self->{pointsize};
    $self->{'out'}++;
}
sub pre_out
{
    my($self, $text) = @_;
    $self->skip_vspace;
    $self->tt_start;
    my $font = $self->findfont();
    if (length $font) {
    $self->show;
    $self->{line} .= "$font\n";
    }
    while ($text =~ s/(.*)\n//) {
        $self->{'out'}++;
    $self->{showstring} .= $1;
    $self->showline;
    }
    $self->{showstring} .= $text;
    $self->tt_end;
    1;
}
sub bullet
{
    my($self, $bullet) = @_;
    $self->{bullet} = $bullet;
    $self->{bullet_pos} = $self->{lm};
}
sub adjust_lm
{
    my $self = shift;
    DEBUG > 1 and printf "  Adjusting lm by %s, called by %s line %s\n",
      $_[0], (caller(1))[3,2];
    $self->showline;
    DEBUG > 2 and printf "  ^=Changing lm from %.1f to %.1f, because en=%.1f\n",
      $self->{lm},
      $self->{lm} + $_[0] * $self->{en},
      $self->{en},
    ;
    $self->{lm} += $_[0] * $self->{en};
    1;
}
sub adjust_rm
{
    my $self = shift;
    DEBUG > 1 and printf "  Adjusting rm by %s, called by %s line %s\n",
      $_[0], (caller(1))[3,2];
    $self->showline;
    DEBUG > 2 and printf "  ^ Changing rm from %.1f to %.1f, because en=%.1f\n",
      $self->{lm},
      $self->{lm} + $_[0] * $self->{en},
      $self->{en},
    ;
    $self->{rm} += $_[0] * $self->{en};
}
sub head_start {
    1;
}
sub head_end {
    1;
}
sub title_start {
    my($self) = @_;
    $self->{collectingTheTitle} = 1;
    1;
}
sub title_end {
    my($self) = @_;
    $self->{collectingTheTitle} = 0;
    1;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
my($counter, $last_state_filename);
# For use in circumstances of total desperation:
sub dump_state {
    my $self = shift;
    require Data::Dumper;
    ++$counter;
    my $filename = sprintf("state%04d.txt", $counter);
    open(STATE, ">$filename") or die "Can't write-open $filename: $!";
    printf STATE "%s line %s\n", (caller(1) )[3,2];
    {
      local( $self->{'wx'}     ) = '<SUPPRESSED>' ;
      local( $self->{'output'} ) = '<SUPPRESSED>' ;
      print STATE Data::Dumper::Dumper($self);
    }
    close(STATE);
    sleep 0;
    if( $last_state_filename ) {
      system("perl -S diff.bat $last_state_filename $filename > $filename.diff");
    }
    $last_state_filename = $filename;
    return 1;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1;
HideShow 236 lines of Pod
__END__
=pod
=for test_synopsis 1;
__END__
=for stopwords bottommargin fontfamily fontscale helvetica
    horizontalmargin leftmargin noprolog notrailer pageno
    paperheight papersize paperwidth postscript rightmargin
    startpage topmargin verticalmargin ledding leeding prolog
=head1 NAME
HTML::FormatPS - Format HTML as PostScript
=head1 VERSION
version 2.04.02
=head1 SYNOPSIS
    use HTML::TreeBuilder;
    $tree = HTML::TreeBuilder->new->parse_file("test.html");
    use HTML::FormatPS;
    $formatter = HTML::FormatPS->new(
        FontFamily => 'Helvetica',
        PaperSize  => 'Letter',
    );
    print $formatter->format($tree);
Or, for short:
    use HTML::FormatPS;
    print HTML::FormatPS->format_file(
        "test.html",
        'FontFamily' => 'Helvetica',
        'PaperSize'  => 'Letter',
    );
=head1 DESCRIPTION
The HTML::FormatPS is a formatter that outputs PostScript code.
Formatting of HTML tables and forms is not implemented.
HTML::FormatPS is built on top of L<HTML::Formatter> and so further
detail may be found in the documentation for L<HTML::Formatter>.
You might specify the following parameters when constructing the formatter
object (or when calling format_file or format_string):
=over 4
=item PaperSize
What kind of paper should we format for.  The value can be one of
these: A3, A4, A5, B4, B5, Letter, Legal, Executive, Tabloid,
Statement, Folio, 10x14, Quarto.
The default is "A4".
=item PaperWidth
The width of the paper, in points.  Setting PaperSize also defines this
value.
=item PaperHeight
The height of the paper, in points.  Setting PaperSize also defines
this value.
=item LeftMargin
The left margin, in points.
=item RightMargin
The right margin, in points.
=item HorizontalMargin
Both left and right margin at the same time.  The default value is 4 cm.
=item TopMargin
The top margin, in points.
=item BottomMargin
The bottom margin, in points.
=item VerticalMargin
Both top and bottom margin at the same time.  The default value is 2 cm,
=item PageNo
This parameter determines if we should put page numbers on the pages.
The default value is true; so you have to set this value to 0 in order to
suppress page numbers.  (The "No" in "PageNo" means number/numero!)
=item FontFamily
This parameter specifies which family of fonts to use for the formatting.
Legal values are "Courier", "Helvetica" and "Times".  The default is
"Times".
=item FontScale
This is a scaling factor for all the font sizes.  The default value is 1.
For example, if you want everything to be almost three times as large,
you could set this to 2.7.  If you wanted things just a bit smaller than
normal, you could set it to .92.
=item Leading
This option (pronounced "ledding", not "leeding") controls how much is
space between lines. This is a factor of the font size used for that
line.  Default is 0.1 -- so between two 12-point lines, there will be
1.2 points of space.
=item StartPage
Assuming you have PageNo on, StartPage controls what the page number of
the first page will be. By default, it is 1. So if you set this to 87,
the first page would say "87" on it, the next "88", and so on.
=item NoProlog
If this option is set to a true value, HTML::FormatPS will make a point of
I<not> emitting the PostScript prolog before the document. By default,
this is off, meaning that HTML::FormatPS I<will> emit the prolog. This
option is of interest only to advanced users.
=item NoTrailer
If this option is set to a true value, HTML::FormatPS will make a point of
I<not> emitting the PostScript trailer at the end of the document. By
default, this is off, meaning that HTML::FormatPS I<will> emit the bit
of PostScript that ends the document. This option is of interest only to
advanced users.
=back
=head1 METHODS
=head2 new
    my $formatter = FormatterClass->new(
        option1 => value1, option2 => value2, ...
    );
This creates a new formatter object with the given options.
=head1 SEE ALSO
L<HTML::Formatter>
=head1 TO DO
=over
=item *
Support for some more character styles, notably including:
strike-through, underlining, superscript, and subscript.
=item *
Support for Unicode.
=item *
Support for Win-1252 encoding, since that's what most people
mean when they use characters in the range 0x80-0x9F in HTML.
=item *
And, if it's ever even reasonably possible, support for tables.
=back
I would welcome email from people who can help me out or advise
me on the above.
=head1 INSTALLATION
See perlmodinstall for information and options on installing Perl modules.
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
Please report any bugs or feature requests through the web interface at
L<http://rt.cpan.org/Public/Dist/Display.html?Name=HTML-Format>.
=head1 AVAILABILITY
The project homepage is L<http://search.cpan.org/dist/HTML-Format>.
The latest version of this module is available from the Comprehensive Perl
Archive Network (CPAN). Visit L<http://www.perl.com/CPAN/> to find a CPAN
site near you, or see L<http://search.cpan.org/dist/HTML-Format/>.
The development version lives at L<http://github.com/nigelm/HTML-Format>
and may be cloned from L<git://github.com/nigelm/HTML-Format.git>.
Instead of sending patches, please fork this project using the standard
git and github infrastructure.
=head1 AUTHORS
=over 4
=item *
Nigel Metheringham <nigelm@cpan.org>
=item *
Sean M Burke <sburke@cpan.org>
=item *
Gisle Aas <gisle@ActiveState.com>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by Nigel Metheringham, 2002-2005 Sean M Burke, 1999-2002 Gisle Aas.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut