formatps.pm

ARM上的如果你对底层感兴趣

    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");
    unshift(@{$self->{output}}, @prolog);
}


sub header_start
{
    my($self, $level, $node) = @_;
    # If we are close enough to be bottom of the page, start a new page
    # instead of this:
    $self->vspace(1 + (6-$level) * 0.4);
    $self->{bold}++;
    push(@{$self->{font_size}}, 8 - $level);
    1;
}


sub header_end
{
    my($self, $level, $node) = @_;
    $self->vspace(1);
    $self->{bold}--;
    pop(@{$self->{font_size}});
    1;
}

sub hr_start
{
    my $self = shift;
    $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;
    if (defined $self->{vspace}) {
	$self->showline;
	if ($self->{out}) {
	    $self->{ypos} -= $self->{vspace} * 10 * $self->{fontscale};
	    if ($self->{ypos} < $self->{bm}) {
		$self->newpage;
	    }
	}
	$self->{xpos} = $self->{lm};
	$self->{vspace} = undef;
	$self->{hspace} = undef;
    }
}


sub show
{
    my $self = shift;
    my $str = $self->{showstring};
    return unless length $str;
    $str =~ s/([\(\)\\])/\\$1/g;    # must escape parentesis
    $self->{line} .= "($str)S\n";
    $self->{showstring} = "";
}


sub showline
{
    my $self = shift;
    $self->show;
    my $line = $self->{line};
    return unless length $line;
    $self->{ypos} -= $self->{largest_pointsize} || $self->{pointsize};
    if ($self->{ypos} < $self->{bm}) {
	$self->newpage;
	$self->{ypos} -= $self->{pointsize};
	# must set current font again
	my $font = $self->{prev_currentfont};
	if ($font) {
	    $self->collect("$self->{fonts}{$font} SF\n");
	}
    }
    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 with space
    $self->collect($line);

    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.  Lets make
	    # filled cirle ourself.
	    my $radius = $self->{pointsize} / 4;
	    $self->collect(sprintf "newpath %.1f %.1f %.1f 0 360 arc fill\n",
		       $self->{bullet_pos} + $radius,
		       $self->{ypos} + $radius, $radius);
	} else {
	    $self->collect(sprintf "%.1f %.1f M\n", # moveto
			   $self->{bullet_pos},
			   $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
    $self->{ypos} -= $self->{leading} * $self->{pointsize};
}


sub endpage
{
    my $self = shift;
    # End previous page
    $self->collect("showpage\n");
    $self->{pageno}++;
}


sub newpage
{
    my $self = shift;
    if ($self->{'out'}) {
	$self->endpage;
    }
    $self->{'out'} = 0;
    my $pageno = $self->{pageno};
    $self->collect("\n%%Page: $pageno $pageno\n");

    # Print area marker (just for debugging)
    if ($DEBUG) {
	my($llx, $lly, $urx, $ury) = map { sprintf "%.1f", $_}
				     @{$self}{qw(lm bm rm tm)};
	$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}) {
	$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($pageno)S\n", $x);
	$x = $self->{lm};
	$self->collect(sprintf "%.1f 30.0 M($self->{title})S\n", $x);
    }
    $self->collect("\n");

    $self->{xpos} = $self->{lm};
    $self->{ypos} = $self->{tm};
}


sub out
{
    my($self, $text) = @_;
    if ($self->{collectingTheTitle}) {
        # Both collect and print the title
    	$text =~ s/([\(\)\\])/\\$1/g; # Escape parens.
        $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;
    $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;
}

sub bullet
{
    my($self, $bullet) = @_;
    $self->{bullet} = $bullet;
    $self->{bullet_pos} = $self->{lm};
}

sub adjust_lm
{
    my $self = shift;
    $self->showline;
    $self->{lm} += $_[0] * $self->{en};
}


sub adjust_rm
{
    my $self = shift;
    $self->showline;
    $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;
}

1;