Newsgroups: fj.lang.perl,fj.lang.postscript
Path: galaxy.trc.rwcp.or.jp!sparky!uunet!ccut!wnoc-tyo-news!sranha!sranhd!sran230!utashiro
From: utashiro@sran230.sra.co.jp (Kazumasa Utashiro)
Subject: a2ps v1.24
Organization: Software Research Associates, Inc., Japan
Date: Wed, 18 Nov 1992 06:03:29 GMT
Message-ID: <BxwE5w.2xn@sran230.sra.co.jp>
Distribution: fj
Lines: 842
Xref: galaxy.trc.rwcp.or.jp fj.lang.perl:4 fj.lang.postscript:39
X-originally-archived-at: http://galaxy.rwcp.or.jp/text/cgi-bin/newsarticle2?ng=fj.lang.perl&nb=4&hd=a
X-reformat-date: Mon, 18 Oct 2004 15:18:22 +0900
X-reformat-comment: Tabs were expanded into 4 column tabstops by the Galaxy's archiver. See http://katsu.watanabe.name/ancientfj/galaxy-format.html for more info.


$B:#G/$N(B1$B7n$K%]%9%H$7$?(B a2ps v1.18 $B$N:G?7HG$G$9!#%P%0%U%#%C%/(B
$B%90J30$NJQ99E@$O<!$N$h$&$J$b$N$G$9!#4pK\E*$K$O$"$^$jJQ$o$C$F(B
$B$$$^$;$s!#(B

o $B%"%s%@!<%i%$%sJ8;z$K(B Courier-Oblique $B$G$O$J$/(B 
  Courier-BoldOblique $B$r;H$&!#(B

o -toc $B%*%W%7%g%s$NDI2C!#$3$l$OL\<!$r:n$k$?$a!#CfES(B
  $BH>C<$K:n$C$F$"$k$N$G!";H$$$?$$?M$OE,Ev$K9)IW$7$F$/(B
  $B$@$5$$!#85!9$O(B locore.s $B$r%W%j%s%H$9$k$?$a$KIU$1$?!#(B

o nkf $B$,$J$/$F$b<+J,$GJQ49$7$FF0$/$h$&$K$7$?!#(B

$B%*%j%8%J%k$N(B a2ps $B$H$N0c$$$O<!$N$H$*$j!#(B

>> - $BF|K\8l$,=PNO$G$-$k!#%U%)%s%H$O(B /Ryumin-Light-H $B$,(B
>>   $B;H$o$l$k!#$?$@$7!"%3!<%IJQ49$r%3%^%s%I$KMj$C$F$$$k(B
>>   $B$N$G(B nkf $BEy$,I,MW!#(B
>> 
>> - nroff $B=PNO$N=E$M$&$AItJ,$K(B Courier-Bold $B$H(B
>>   GothicBBB-Medium-H $B$r;H$&!#(B
>> 
>> - nroff $B=PNO$N%"%s%@!<%i%$%sItJ,$K(B Courier-Oblique 
>>   $B$H(B /Ryumin-Light-H $B$N<PBN$r;H$&!#(B
>> 
>> - $BF|IU$1ItJ,$NJQ99$,2DG=!#(B
>> 
>> - $B:82<$N6y$K%i%Y%k$r=PNO$9$k!#B?$/$N%Z!<%8$NCf$+$iI,(B
>>   $BMW$JItJ,$r$_$D$1$k$N$rMF0W$K$9$k$?$a!#(B

$B$^$@$"$^$jG<F@$G$-$k=PMh$G$O$J$$$N$G!"&C%j%j!<%9$H$$$&$H$3$m(B
$B$G$7$g$&$+!#%P%0%l%]!<%H!"%3%a%s%HEy$"$j$^$7$?$i!"$*CN$i$;$/(B
$B$@$5$$!#(B

$BK\Ev$O:G=i$+$i:n$jD>$7$?$$$1$I!"%]%9%H%9%/%j%W%H$O$h$/$o$+$i(B
$B$J$$!D(B

--utashiro

#!/usr/local/bin/perl
;#
;# a2ps: ascii to ps
;#
;# Copyright (c) 1990,1991,1992 Kazumasa Utashiro
;# Software Research Associates, Inc., Japan <utashiro@sra.co.jp>
;# InterTech Data Systems, Inc., Cupertino CA <utashiro@InterTech.COM>
;#
;; $rcsid = q$Id: a2ps,v 1.24 1992/10/13 13:06:19 utashiro Exp $;
;#
;# This program is perl version of Miguel Santana's a2ps.  Postscript
;# kanji enhancement was done by N. Kanazawa <kanazawa@sra.co.jp>.
;# Converted to perl and enhanced by K. Utashiro <utashiro@sra.co.jp>.
;#
;# Please change next line for default paper.
;# ('us' for US letter size, 'a4' for A4 size)
;#
;;$default_paper = 'a4';
;#
;# Change next line for default action of converting to jis code. If
;# the variable $jisconvert is true, a2ps tries to convert the input
;# text to jis code.  It tries to use some converting program like nkf
;# first.  If failed to exec these programs, a2ps does converting work
;# by itself.
;#
;;$jisconvert = 1;
;#
;# WISH LIST
;#- change algorithm to determine frame size (buggy on big font)
;#- print toc matched pattern at the bottom of pages
;#
@mon = (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec);
@day = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
@mon{@mon} = ($[ .. $#mon);
@day{@day} = ($[ .. $#day);

sub paper {
    local($p) = shift; $paper =~ s/.*/\L$&/;
    ($width, $height, $lmargin, $smargin, $fontsize_l, $fontsize_p,
     $portrait_header, $landscape_header, $paper_adjust)
#= ($p eq 'us') ? (8.50, 11.06, 0.95, 1.2, 6.85, 9.5, 0.29, 0.22, 0.12)
= ($p eq 'us') ? (8.50, 11.06, 0.65, 1.2, 6.85, 9.5, 0.29, 0.22, 0.12)
       : (8.27, 11.64, 1.20, 1.2, 6.60, 9.8, 0.29, 0.22, 0);
}
&paper($default_paper);
$pixels_inch = 72;$selfconvert = 0;
$numbering = 0;$folding = 1;$restart = 1;
$only_printable = 0;$copies_number = 1;
$landscape = 1;$wide_pages = 0;$twinpage = 1;
$no_border = 0;$no_header = 0;$tab_w = 8;
$skip_column = 1;$numformat = '%-5d ';
$oblique = 1;$bold = 1;
$kanji_ascii_ratio = 1.0;
$default_sublabel = q#%month %mday 19%year %hour:%min#;

$re_sjis_s = '([\201-\237\340-\374][\100-\176\200-\374])+';
$re_euc_s  = '([\241-\376]{2})+';
$re_jin    = '\033\$[\@\B]';
$re_jout   = '\033\([BJ]';

while ($_ = $ARGV[0], s/^-(.+)$/$1/ && shift) {
    next if $_ eq '';
    if (s/^help$//){&usage;next;}
    if (s/^(us|a4)$//){&paper($1);next;}
    if (s/^l(.*)$//){defined($label=$1||shift)||&usage;next;}
    if (s/^L(.*)$//){defined($sublabel=$1||shift)||&usage;next;}
    if (s/^toc$//){defined($toc=shift)||&usage;next;}
    if (s/^k([\d\.]+)$//){$kanji_ascii_ratio=$1;next;}
    if (s/^f([\d\.]+)$//){$font_size=$1;next;}
    if (s/^fx([\d\.]+)$//){$font_mag=$1;next;}
    if (s/^j([\d\.]*)$//){$ascii_mag=$1||1.2;next;}
    if (s/^d(\d*)$//){$debug=$1||1;next;}

    if (s/^(n?v)//){$only_printable=($1 ne 'v');redo;}
    if (s/^(n?w)//){$wide_pages=($1 eq 'w');redo;}
    if (s/^(n?c)//){$jisconvert=($1 eq 'c');redo;}
    if (s/^(n?p)//){$landscape=($1 ne 'p');redo;}
    if (s/^(n?h)//){$no_header=($1 ne 'h');redo;}
    if (s/^(n?s)//){$no_border=($1 ne 's');redo;}
    if (s/^(n?t)//){$no_footer=($1 ne 't');redo;}
    if (s/^(n?f)//){$folding=($1 eq 'f');redo;}
    if (s/^(n?r)//){$restart=($1 eq 'r');redo;}
    if (s/^(n?b)//){$bold=($1 eq 'b');redo;}
    if (s/^(n?o)//){$oblique=($1 eq 'o');redo;}
    if (s/^(n?C)//){$selfconvert=($1 eq 'C');redo;}
    if (s/^(n?n)//){$numbering=($1 eq 'n');redo;}
    &usage;
}

sub usage {
    ($command = $0) =~ s#.*/##;
    select(STDERR); $|=0;
    print "syntax: $command [switches] [files]\n";
    print <<"    >>";
switches are:
-l \@label string
-L \@sub-label string (\%default="$default_sublabel")
-[n]ttail label (t)
-[n]nnumbering (n)
-[n]hheader (h)
-[n]sscale (s)
-[n]wwide page (nw)
-[n]pportrait (np)
-[n]ffolding (f)
-[n]cconvert to jis code (c)
-[n]rreset sheet number on each file (r)
-[n]buse bold/gothic font for overstruck characters (b)
-[n]ouse oblique font for underlined characters (o)
-f[x]#font size or maginificent (6.6 or 9.8)
-k#kanji:ascii font size ratio (1.0)
-j[#]adjust ascii font height to Japanese (1.0)
-us/a4US letter / A4
-toc pattern
specify table of contents pattern
-helpprint this message
    >>
    print "($rcsid)\n";
    exit 1;
}

$twinpage = ($landscape && !$wide_pages);
$font_size = $landscape ? $fontsize_l : $fontsize_p unless ($font_size);
$font_size *= $font_mag if ($font_mag);
$sheet_height = ($height - $lmargin) * $pixels_inch;
$sheet_width = ($width - $smargin) * $pixels_inch;
$char_width = 0.6 * $font_size;
$skip_column = 0 if ($numbering);
$esc = $only_printable ? ' ' : '^[';

($header, $page_width, $page_height) =
    $landscape ? ($landscape_header, $sheet_height, $sheet_width)
       : ($portrait_header, $sheet_width, $sheet_height);
$header_size = $no_header ? 0 : $header * $pixels_inch;
$linesperpage = (int(($page_height-$header_size)/($font_size * 1.1))) - 1;
if (!$landscape || $wide_pages) {
    $columnsperline = (int($page_width / $char_width)) - 1;
} else {
    $page_height = ($height - ($lmargin * 5 / 3)) * $pixels_inch;
    $columnsperline = (int((int($page_height / 2)) / $char_width)) - 1;
}

if ($linesperpage <= 0 || $columnsperline <= 0) {
    printf STDERR "Font %g too big !!\n", $font_size;
    exit(1);
}

if ($debug == 2) {
    require('dumpvar.pl');
    &dumpvar('main',
     'width', 'height', 'lmargin', 'smargin', 'font_size',
     'sheet_height', 'sheet_width', 'char_width', 'skip_column',
     'header', 'page_width', 'page_height', 'header_size',
     'linesperpage', 'columnsperline');
    exit(0);
}

push(@ARGV, '') unless (@ARGV);
while (@ARGV) {
    $file = shift;
    if ($file && !-r $file) {warn "$file: $!\n"; next;}
    if ($jisconvert) {
open(F, "-|") || &jis($file);
    } else {
$file = '-' if $file eq '';
open(F, $file) || (print STDERR "$file: $!\n", next);
    }
    $file = 'stdin' if $file =~ /^-?$/;
    if ($toc) {
$TOC = $file . '.toc';
die "$TOC exists.\n" if -e $TOC;
open(TOC, ">$TOC") || die "$TOC: $!\n";
    }
    &print_file($file, $label);
    close(F);
    close(TOC) if $toc;
}
print "\n%%Trailer\ncleanup\ndocsave restore end\n" if $header_is_printed;
exit;

############################################################

sub print_file {
    local($name, $label) = @_;
    defined($label) || ($label = $name || 'stdin');
    $label =~ s/[\(\)\\]/\\$&/g;
    defined($sublabel) && do { $sublabel =~ s/[\(\)\\]/\\$&/g; };
    $line_number=0;

    &print_header;

    print "($label) newfile\n";
    if ($restart) {
print "/sheet 1 def\n";
$sheets = 0;
    }
    $page = 0;
    $maxrest = $columnsperline - $skip_column;
    $numberwidth = length(sprintf($numformat,0));
    $maxrest -= $numberwidth if $numbering;
    $lastnumber = -1;
    $show = 's';
    $line = 1; $bl = 1;

    while (<F>) {
$line_number++;
if ($toc && /$toc/o) {
    print TOC "$sheets:$page:$line_number:$+:$_";
}
1 while s/\t/' 'x($tab_w-(&pwidth($`)%$tab_w))/e;
if ($only_printable) {
    s/[\000-\032\034-\037\177-\377]/ /g;
} else {
    s/[\200-\377]/'M-'.pack('c',ord($&)&0177)/ge;
    s/[\000-\007\013\016-\032\034-\037]/'^'.pack('c',ord($&)|0100)/ge;
    s/\0177/^?/g;
}
s/\033\$[B\@]/\005/g; s/\033\([BJ]/\006/g;
if (/\010/) {
    if ($oblique) {
s/__\010\010(\005)?(..)/\003$1$2\004/g;
s/_\010(.)/\003$1\004/g;
s/\004\003//g;
    }
    if ($bold) {
s/(..)\006?\010\010\005?\1/\001$1\002/g;
s/(.)(\010\1)+/\001$1\002/g;
s/\002\001//g;
    }
}
$rest = $maxrest;
@l = split(/([\001-\006\010\f\n\r])/);
while (defined($w = shift(@l))) {
    if ($w eq '') { next; }
    if ($w eq "\f") {$bl || &nl; &rp; next;}
    $bl && &bl;
    if ($w eq "\b") {$rest++, print ' bs' if ($rest<$maxrest); next;}
    if ($w eq "\n") {&nl; next;}
    if ($w eq "\r") {&cr; &bl; next;}
    if ($w eq "\001") {print ' B'; next;}# bold start
    if ($w eq "\002") {print ' R'; next;}# bold end
    if ($w eq "\003") {print ' I'; next;}# italic start
    if ($w eq "\004") {print ' R'; next;}# italic end
    if ($w eq "\005") {# kanji start
$kanji = 1; $show = 'ks';
print ' initkanji' if !$initkanji++;
next;
    }
    if ($w eq "\006") {# kanji end
$kanji = 0; $show = 's'; next;
    }
    $show_width = $rest & ~$kanji;
    if ($show_width < length($w)) {
($w, $folded) = unpack("a$show_width a*", $w);
    }
    $rest -= length($w);
    $w =~ s/[\(\)\\]/\\$&/g;
    print ' (', $w, ') ', $show;
    if (defined($folded)) {
unshift(@l, $folded); $rest=$maxrest; &nl;
undef($folded);
    }
}
    }
    &ep;
}

sub rp {
    if ($line%$linesperpage != 1) {
$line=$linesperpage*(int($line/$linesperpage)+1)+1;
    }
}

sub np {
    &ep if ($page++ > 0);
    if (!$twinpage || ($page%2)==1) {
$sheets++;
print "%%Page: $sheets $sheets\n";
$initkanji = 0;
print "initkanji\n" if $kanji;
    }
    print "startpage\n";
    &rp;
}

sub bl {
    &np if ($bl && ($line % $linesperpage) == 1);
    $bl = 0;
    $rest = $maxrest;
    print 'bl (', ' ' x $skip_column;
    if ($numbering) {
if ($line_number != $lastnumber) {
    printf ($numformat, $line_number);
    $lastnumber = $line_number;
} else {
    print ' ' x $numberwidth;
}
    }
    print ') s';
}

sub nl {$line++; print " nl\n"; $bl = 1;}
sub cr {print ' cr ';}
sub ep {print "\nendpage\n";}

sub max { $_[ ($_[$[] < $_[$[+1]) + $[]; }

sub pwidth {
    return(length($_[0])) unless($_[0]=~/[\033\010\f\r]/);
    local($_)=shift;
    s/^.*[\f\r]//;
    s/\033\$[\@B]|\033\([JB]//g;
    1 while s/[^\010]\010//;
    s/^\010*//;
    length($_);
}

sub jis {
    unless ($selfconvert) {
exec "nkf -b -j @_";
exec "jconv -j @_";
exec "jcat -IJ @_";
    }
    open(STDIN, $file) || die "$file: $!\n" if $file = shift;
    while (<>) {
print, next if (!@readahead && !/[\033\200-\377]/);
push(@readahead, $_);
next unless ($kcode = &kcode(*_));
$convf = ($kcode || 'jis') . '2jis';
eval "do \$convf(*_), print while (\$_ = shift(\@readahead));" .
     "do \$convf(*_), print while (<>);";
exit(0);
    }
    print @readahead;
    exit(0);
}

sub kcode {
    local(*_, $sjis, $euc) = @_;
    return undef unless /[\033\200-\377]/;
    return 'jis' if /$re_jin|$re_jout/o;
    $sjis += length($&) while /$re_sjis_s/go;
    $euc += length($&) while /$re_euc_s/go;
    return ('euc', undef, 'sjis')[($sjis <=> $euc) + $[ + 1];
}

sub jis2jis { 1; }

sub sjis2jis {
    local(*_) = @_;
    s/$re_sjis_s/&_sjis2jis($&)/geo;
}
sub _sjis2jis {
    local($_) = @_;
    s/../$s2j{$&}||&s2j($&)/ge;
    "\033\$B" . $_ . "\033\(B";
}
sub s2j {
    local($c1, $c2) = unpack('CC', shift);
    if ($c2 >= 0x9f) {
$c1 = ($c1 * 2 - ($c1 >= 0xe0 ? 0xe0 : 0x60)) & 0x7f;
$c2 -= 0x7e;
    } else {
$c1 = ($c1 * 2 - ($c1 >= 0xe0 ? 0xe1 : 0x61)) & 0x7f;
$c2 = ($c2 + 0x60 + ($c2 < 0x7f)) & 0x7f;
    }
    $s2j{$&} = pack('cc', $c1, $c2);
}

sub euc2jis {
    local(*_) = @_;
    s/$re_euc_s/&_euc2jis($&)/geo;
}
sub _euc2jis {
    local($_) = @_;
    tr/\200-\377/\000-\177/;
    "\033\$B" . $_ . "\033\(B";
}

sub print_header {
    return if $debug;
    return if ($header_is_printed++);
    print <<'---';
%! a2ps 3.0

/$a2psdict 100 dict def
$a2psdict begin
% Initialize page description variables.
/inch {72 mul} bind def
---
    printf("/landscape %s def\n", $landscape ? "true" : "false");
    printf("/twinpage %s def\n", $twinpage ? "true" : "false");
    printf("/sheetheight %g inch def\n", $height);
    printf("/sheetwidth %g inch def\n", $width);
    printf("/lmargin %g inch def\n", $lmargin);
    printf("/smargin %g inch def\n", $smargin);
    printf("/paper_adjust %g inch def\n", $paper_adjust);
    printf("/noborder %s def\n", $no_border ? "true" : "false");
    if ($no_header) {
print "/noheader true def\n";
print "/headersize 0.0 def\n";
    }
    else {
printf("/noheader false def\n");
printf("/headersize %g inch def\n",
       $landscape ? $landscape_header : $portrait_header);
    }
    if ($no_footer) {
print "/nofooter true def\n";
    } else {
print "/nofooter false def\n";
    }
    printf("/bodyfontsize %g def\n", $font_size);
    printf("/kanjiAsciiRatio %g def\n", $kanji_ascii_ratio);
    printf("/lines %d def\n", $linesperpage);
    printf("/columns %d def\n", $columnsperline);
    $sublabel = $default_sublabel unless defined($sublabel);
    print "/date (", &date($sublabel, time), ") def\n";
    if ($ascii_mag) {
printf("/doasciimag true def /asciimagsize %f def\n", $ascii_mag);
    } else {
printf("/doasciimag false def\n");
    }
    &print_template;
    print "%%EndProlog\n\n";

    if ($copies_number > 1) {
printf("/#copies %d def\n", $copies_number);
    }

    printf("/docsave save def\n");
    printf("startdoc\n");
}

sub date {
    local($_, $time) = @_;
    local($sec, $min, $hour, $mday, $mon, $year, $wday)= localtime($time);

    s/[\\%]%/\377/g;# save escaped %
    s/%default/$default_sublabel/g;# %default

    s/%user/$ENV{'USER'}||(getpwuid($<))[0]/ge;# %user

    # compatible with mh_format(5)
    s/%month\b/$mon[$mon]/g;# %month
    s/%sec\b/sprintf("%02d",$sec)/ge;# %sec
    s/%min\b/sprintf("%02d",$min)/ge;# %min
    s/%hour\b/$hour/g;# %hour
    s/%mday\b/$mday/g;# %mday
    s/%mon\b/$mon+1/ge;# %mon
    s/%wday\b/$wday/g;# %wday
    s/%year\b/$year/g;# %year
    s/%day\b/$day[$wday]/g;# %day

    s/\377/%/g;# restore %
    $_;
}

sub print_template {
    while(<DATA>) {
last if /^__END__$/;
print;
    }
}
__END__
%!  PostScript Source Code
%
%  File: imag:/users/local/a2ps/header.ps
%  Created: Tue Nov 29 12:14:02 1988 by miguel@imag (Miguel Santana)
%  Version: 2.0
%  Description: PostScript prolog for a2ps ascii to PostScript program.
% 
%  Edit History:
%  - Original version by evan@csli (Evan Kirshenbaum).
%  - Modified by miguel@imag to:
%    1) Correct an overflow bug when printing page number 10 (operator
%cvs).
%    2) Define two other variables (sheetwidth, sheetheight) describing
%the physical page (by default A4 format).
%    3) Minor changes (reorganization, comments, etc).
%  - Modified by tullemans@apolloway.prl.philips.nl
%    1) Correct stack overflows with regard to operators cvs and copy.
%       The resulting substrings where in some cases not popped off 
%       the stack, what can result in a stack overflow.
%    2) Replaced copypage and erasepage by showpage. Page througput
%       degrades severely (see red book page 140) on our ps-printer
%       after printing sheet 16 (i.e. page 8) of a file which was 
%       actually bigger. For this purpose the definitions of startdoc
%       and startpage are changed.
%  - Modified by Tim Clark <T.Clark@uk.ac.warwick> to:
%    1) Print one page per sheet (portrait) as an option.
%    2) Reduce size of file name heading, if it's too big.
%    3) Save and restore PostScript state at begining/end. It now uses
%conventional %%Page %%Trailer markers.
%    4) Print one wide page per sheet in landscape mode as an option.
%  - Modified by miguel@imag.fr to
%    1) Add new option to print n copies of a file.
%    2) Add new option to suppress heading printing.
%    3) Add new option to suppress page surrounding border printing.
%    4) Add new option to change font size. Number of lines and columns
%are now automatically adjusted, depending on font size and
%printing mode used.
%    5) Minor changes (best layout, usage message, etc).
%  - Modified by kanazawa@sra.co.jp to:
%    1) Handle Japanese code
%  - Modified by utashiro@sra.co.jp to:
%    1) Fix bug in printing long label
%    2) Handle caridge-return
%    3) Specify kanji-ascii character retio
%    4) Add footer label
%    5) Change filename->fname becuase ghostscript has operator filename
%    6) Support three different font style
%

% Copyright (c) 1988, Miguel Santana, miguel@imag.imag.fr
%
% Permission is granted to copy and distribute this file in modified
% or unmodified form, for noncommercial use, provided (a) this copyright
% notice is preserved, (b) no attempt is made to restrict redistribution
% of this file, and (c) this file is not distributed as part of any
% collection whose redistribution is restricted by a compilation copyright.
%


% General macros.
/xdef {exch def} bind def
/getfont {exch findfont exch scalefont} bind def

% Page description variables and inch function are defined by a2ps program.

% Character size for differents fonts.
   landscape
   { /filenamefontsize 12 def }
   { /filenamefontsize 16 def }
ifelse
/datefontsize filenamefontsize 0.8 mul def
/headermargin filenamefontsize 0.25 mul def
/bodymargin bodyfontsize 0.7 mul def

% Font assignment to differents kinds of "objects"
/filenamefontname /Helvetica-Bold def
/stdfilenamefont filenamefontname filenamefontsize getfont def
/datefont /Helvetica datefontsize getfont def
/footerfont /Helvetica-Bold datefontsize getfont def
/mag { doasciimag { [ 1 0 0 asciimagsize 0 0 ] makefont } if } def
/bodynfont /Courier bodyfontsize getfont mag def
/bodybfont /Courier-Bold bodyfontsize getfont mag def
%/bodyofont /Courier-Oblique bodyfontsize getfont mag def
/bodyofont /Courier-BoldOblique bodyfontsize getfont mag def
/fontarray [ bodynfont bodybfont bodyofont ] def
/bodyfont bodynfont def
/R { /fonttype 0 def } bind def R
/B { /fonttype 1 def } bind def
/I { /fonttype 2 def } bind def

% Initializing kanji fonts
/kanji_initialized false def
/initkanji {
   kanji_initialized not
   {
      /bodykfontsize bodyfontsize kanjiAsciiRatio mul def
      /bodyknfont /Ryumin-Light-H bodykfontsize getfont def
      /bodykbfont /GothicBBB-Medium-H bodykfontsize getfont def
      /bodykofont bodyknfont [ 1 0 .2 1 0 0 ] makefont def
      /KanjiRomanDiff 1.2 bodyfontsize mul 1.0 bodykfontsize mul sub def
      /KanjiRomanDiffHalf KanjiRomanDiff 2 div def
      /kfontarray [ bodyknfont bodykbfont bodykofont ] def
      /kanji_initialized true def
   } if
} def

% Backspace width
/backspacewidth
   bodyfont setfont (0) stringwidth pop
   def

% Logical page attributs (a half of a real page or sheet).
/pagewidth
   bodyfont setfont (0) stringwidth pop columns mul bodymargin dup add add
   def
/pageheight
   bodyfontsize 1.1 mul lines mul bodymargin dup add add headersize add
   def

% Coordinates for upper corner of a logical page and for sheet number.
% Coordinates depend on format mode used.
% In twinpage mode, coordinate x of upper corner is not the same for left
% and right pages: upperx is an array of two elements, indexed by sheetside.
/rightmargin smargin 3 div def
/leftmargin smargin 2 mul 3 div def
/topmargin lmargin twinpage {3} {2} ifelse div def
landscape
{  % Landscape format
   /uppery rightmargin pageheight add bodymargin add def
   /sheetnumbery sheetwidth leftmargin pageheight add datefontsize add sub def
   twinpage
   {  % Two logical pages
      /upperx [ topmargin 2 mul% upperx for left page
dup topmargin add pagewidth add% upperx for right page
      ] def
      /sheetnumberx sheetheight topmargin 2 mul sub def
   }
   {  /upperx [ topmargin dup ] def
      /sheetnumberx sheetheight topmargin sub datefontsize sub def
   }
   ifelse
}
{  % Portrait format
   /uppery topmargin pageheight add def
   /upperx [ leftmargin dup ] def
   /sheetnumberx sheetwidth rightmargin sub datefontsize sub def
   /sheetnumbery
 sheetheight 
 topmargin pageheight add datefontsize add headermargin add
      sub
      def

}
ifelse

% Strings used to make easy printing numbers
/pnum 12 string def
/empty 12 string def

% Other initializations.
datefont setfont
/datewidth date stringwidth pop def
/pagenumwidth (Page 999) stringwidth pop def
/filenameroom
         pagewidth
 filenamefontsize 4 mul datewidth add pagenumwidth add
      sub
   def


% Function startdoc: initializes printer and global variables.
/startdoc
    { /sheetside 0 def% sheet side that contains current page
      /sheet 1 def% sheet number
   } bind def

% Function newfile: init file name and reset page number for each new file.
/newfile
    { cleanup
      /fname xdef
      stdfilenamefont setfont
      /filenamewidth fname stringwidth pop def
      /filenamefont
 filenamewidth filenameroom gt
 {
       filenamefontname
       filenamefontsize filenameroom mul filenamewidth div
    getfont
 }
 {  stdfilenamefont }
 ifelse
 def
      /pagenum 1 def
    } bind def

% Function printpage: Print a physical page.
/printpage
    { /sheetside 0 def
      twinpage
      {  noborder not
    { sheetnumber }
 if
      }
      {  noheader noborder not and
    { sheetnumber }
 if
      }
      ifelse
      showpage 
%      pagesave restore
      /sheet sheet 1 add def
    } bind def

% Function cleanup: terminates printing, flushing last page if necessary.
/cleanup
    { twinpage sheetside 1 eq and
         { printpage }
      if
    } bind def

%
% Function startpage: prints page header and page border and initializes
% printing of the file lines.
/startpage
    { sheetside 0 eq
{ % /pagesave save def
  landscape
    { sheetwidth 0 inch translate% new coordinates system origin
      90 rotate% landscape format
      paper_adjust neg 0 translate
    } if
} if
      noborder not { printborder } if
      noheader not { printheader } if
      nofooter not { printfooter } if
 upperx sheetside get  bodymargin  add
    uppery
    bodymargin bodyfontsize add  noheader {0} {headersize} ifelse  add
 sub
      moveto
    } bind def

% Function printheader: prints page header.
/printheader
    { upperx sheetside get  uppery headersize sub 1 add  moveto
      datefont setfont
      gsave
        datefontsize headermargin rmoveto
date show% date/hour
      grestore
      gsave
pagenum pnum cvs pop
   pagewidth pagenumwidth sub
   headermargin
rmoveto
        (Page ) show pnum show% page number
      grestore
      empty pnum copy pop
      gsave
        filenamefont setfont
      filenameroom fname stringwidth pop sub 2 div datewidth add
      filenamefontsize 2 mul 
   add 
   headermargin
rmoveto
        fname show% file name
      grestore
    } bind def

% Function printfooter: prints page footer.
/printfooter
    { upperx 0 get sheetnumbery moveto
      footerfont setfont
      fname show
    } bind def

% Function printborder: prints border page.
/printborder 
    { upperx sheetside get uppery moveto
      gsave% print the four sides
        pagewidth 0 rlineto% of the square
        0 pageheight neg rlineto
        pagewidth neg 0 rlineto
        closepath stroke
      grestore
      noheader not
         { 0 headersize neg rmoveto pagewidth 0 rlineto stroke }
      if
    } bind def

%
% Function endpage: adds a sheet number to the page (footnote) and prints
% the formatted page (physical impression). Activated at the end of each
% source page (lines reached or FF character).
/endpage
   { /pagenum pagenum 1 add def
     twinpage  sheetside 0 eq  and
        { /sheetside 1 def }
        { printpage }
     ifelse
   } bind def

% Function sheetnumber: prints the sheet number.
/sheetnumber
    { sheetnumberx sheetnumbery moveto
      datefont setfont
      sheet pnum cvs
 dup stringwidth pop (0) stringwidth pop sub neg 0 rmoveto show
      empty pnum copy pop
    } bind def

% Function bs: go back one character width to emulate BS
/bs { backspacewidth neg 0 rmoveto } bind def

% Function s: print a source string
/s  { fontarray fonttype get setfont
      show
    } bind def

% Function ks: print a kanji source string
/ks { kfontarray fonttype get setfont
      KanjiRomanDiffHalf 0 rmoveto
      KanjiRomanDiff 0 3 -1 roll ashow
      KanjiRomanDiffHalf neg 0 rmoveto
    } def

% Function bl: beginning of line
/bl { gsave } bind def

% Function nl: newline
/nl {
      grestore
      0 bodyfontsize 1.1 mul neg rmoveto
    } bind def

% Function cr: caridge return
/cr { grestore } bind def
__END__
