#!//usr/bin/perl
# "i2ps" text to PostScript filter written in perl by Gisle Aas, NCC 1990
# $Id: i2ps,v 1.7 90/10/30 16:54:46 aas Exp $
#
# Whish list:  (this may become a feature some time)
#     Marking (by some funny char) truncation and wrapping of lines
#     Faster execution (rewrite the hole thing in C?)
#     Parsing of backspace to produce bold and underlined fonts.

# Följande fixat av Per Foreby (perf@efd.lth.se):
# * Standard fontstorlek är 10, 7 resp 5pt för 1, 2 resp 3 kolumner.
# * Lagt till -P för att skicka utskriften direkt till skrivare.
# * Flyttat man-sidan till en egen fil.
#
# $Log:	i2ps,v $
# Revision 1.7  90/10/30  16:54:46  aas
# Options can be specified with the environment variable I2PS.
# New option -w.  Fixed bug which made -n option act like the -f
# option.
# 
# Revision 1.6  90/10/24  12:00:43  aas
# Applied patch from Tor Lillqvist. I2ps now supports finnish/swedish
# ISO-646.
# 
# Revision 1.5  90/10/18  10:26:45  aas
# Changed the name from a2ps to i2ps. Merged the manual-page with the
# program. I2ps now rejects garbage files. I2ps was confused about what
# to put in the header when some of the specified files did not exist.
# Some minor spelling corrections.
# 
# Revision 1.4  90/10/01  15:57:46  aas
# Simplify reencoding to ISO-Latin1. (newencode)
# Fixed problem with showpage after page level restore. Graphic state
# initialized on each page. Included the ISOLatin1Encoding-vector
# in the script. Linenumber on last line when the -l option is used.
# Linenumbers are moved to the left margin.
# 
# Revision 1.3  90/09/27  14:05:31  aas
# Cleaned up the use of A4 variables.
# 
# Revision 1.2  90/09/27  13:18:31  aas
# Removed sccs-stuff, replaced it with rcs-stuff.
# 

# Some configuration constants, meassured in points (1/72 inch)
sub page_top        { 841; }    # A4 = 297mm x 210mm = 841pt x 595pt
sub page_right_edge { 595; }
# Uncomment next line if your printer doesn't have iso encoding builtin.
$isoencoding_not_builtin = 1; #true

# The next few entries are from the AFM file for Adobe's font Courier
sub cour_char_width     { 600; }   # The width of each char in 1000x1000 square
#sub underline_position  { -82; }   # Where underline goes relative to baseline
#sub underline_thickness {  40; }   # and it's thickness

# Parse command line for options and flags
$prog_name = substr($0,rindex($0,"/")+1);
($upcase_name = $prog_name) =~ tr/a-z/A-Z/;
unshift(@ARGV,$ENV{$upcase_name}) if defined($ENV{$upcase_name});
require 'getopts.pl';
unless (&Getopts('nfrth123s:b:lgw:P:')) {
   print STDERR
        "Usage: $prog_name [-<options>] [file]...\n" .
        "Options: -l        print with line numbers\n" .
        "         -r        rotated, landscape orientation\n" .
        "         -t        truncate long lines, default is to wrap lines\n" .
        "         -b\"text\"  replaces the text in the page header\n" .
        "         -h        no page headers\n" .
        "         -2        set text in two columns format\n" .
        "         -3        set text in three columns format\n" .
        "         -s<size>  select new text fontsize, default 10pt\n" .
        "         -w<width> char positions per column\n" .
        "         -g        don't reject garbage files\n" .
        "         -n        norwegian 7bit-ascii encoding\n" .
        "         -f        finnish/swedish 7bit-ascii encoding\n" .
	"	  -P<printer> Print output on \"printer\"\n";  
   exit(1);
}

if (defined($opt_P)) {
   open (OUT, "|lpr -P$opt_P");
   select (OUT);
}

if (defined($opt_s) && $opt_s <= 0) {
   printf STDERR "Illegal argument \"$opt_s\" to -s option\n";
   exit(1);
}
if (defined($opt_w) && $opt_w <= 0) {
   printf STDERR "Illegal argument \"$opt_w\" to -w option\n";
   exit(1);
}

# Set default values, some based on command line options
$left_margin  = 80;
$right_margin = 40;
$tb_margin    = 45;
$font         = "Courier";
$header_font  = "Helvetica-Bold";
$header_font_size = 12;
$line_number_font = "Helvetica";
$line_number_size = 5;

$no_columns = defined($opt_2) ? 2 : defined($opt_3) ? 3 : 1;
$def_fontsize = defined($opt_2) ? 7 : defined($opt_3) ? 5 : 10;
$col_separation = 30;
$sep_bars = 0;  # false
$landscape = defined($opt_r);
$header_height = 30;
$show_header = !defined($opt_h);
$wrap_lines = !defined($opt_t);
$truncate_lines = !$wrap_lines; # don't change this
$norsk_ascii = defined($opt_n);
$sw_fi_ascii = defined($opt_f);

# Some initial values
$opt_b = &ps_string($opt_b) if ($opt_b);
$form_feed = 0; # false;
$page_no  = 0;
$line_no = 0;
if ($landscape) {
    $top = &page_right_edge;
    $right_edge = &page_top;
    $left_margin = $right_margin; # this is a dirty one
} else {
    $top = &page_top;
    $right_edge = &page_right_edge;
}
$home_pos = $top - $tb_margin - ($show_header ? $header_height : 0);
$col_width = ($right_edge - $left_margin - $right_margin
              - ($no_columns - 1) * $col_separation) / $no_columns;
$font_size    = $opt_s || $def_fontsize;
if (defined($opt_w)) {
    $font_size = ($col_width / $opt_w) / (&cour_char_width / 1000);
    printf STDERR "New font size is %.2g points\n", $font_size;
}
$line_height = $font_size * 1.08;
$char_width = &cour_char_width * $font_size / 1000;
$chars_per_line = int ($col_width / $char_width + 1);

&prolog;

unshift(@ARGV,'-') if $#ARGV < $[;
FILE:
while ($FILEHAND = shift) {
    unless (open(FILEHAND)) {
        print STDERR "Can't open \"$FILEHAND\"\n";
        next FILE;
    }
    if (!defined($opt_g) && -B FILEHAND) {
        print STDERR "Skipping binary file \"$FILEHAND\"\n";
        close(FILEHAND);
        next FILE;
    }
    $file_name = ($FILEHAND eq '-') ? '' : &ps_string($FILEHAND);
    $cur_pos = -1;     # this will force a new column next time
    $cur_col = 100;    # this will force a new page next time
    $line_no = 0;
    LINE:
    while (<FILEHAND>) {
        chop;
        $line_no++;
        if (ord == 014) {		# form feed
            s/.//;	# chop off first char
            $cur_pos = -1; 
            next LINE if (length == 0);
        }
        while (s/\t/' ' x (8 - length($`) % 8)/e) {}   # expand tabs
        do {
            if ($cur_pos < $tb_margin) {
                $cur_pos = $home_pos;
                if ($cur_col < $no_columns) {
                     $cur_col++;
                } else {
                     $cur_col = 1;
                     &new_page;
                }
            }
            $text = substr($_,0,$chars_per_line);
            $_ = $truncate_lines ? '' : substr($_,$chars_per_line,10000);
            if ($text =~ s/^ +//) {		# suppress leading blanks
                $indent = $char_width * length($&);
            } else {
                $indent = 0;
            }
            # Make suitable as a postscript string, same as calling
            # "ps_string", but the overhead of calling a function is
            # not acceptable here.
            $text =~ s/[\\\(\)]/\\$&/g;
            $text =~ s/[\000-\037\177-\377]/sprintf("\\%03o",ord($&))/ge;
            # Calculate position
            $x = $left_margin +
		 ($cur_col - 1) * ($col_width + $col_separation);
            $cur_pos -= $line_height;
            printf "(%s)%.1f %.1f S\n", $text, $x + $indent, $cur_pos 
                if (length($text));
            if ($opt_l && (($line_no % 5) == 0 || eof)) { # print line numbers
                 printf "F2 SF($line_no)%.1f %.1f S F1 SF\n",
                        $x + $col_width + 5, $cur_pos;
            }
        } while (length($_));
    } # while (each line)
} # while (each file)
&end_page;
print "%%Trailer\n";
print "%%Pages: $page_no\n";
# printf "($prog_name: $page_no page%s for $user\n) print\n",
#     $page_no != 1 ? "s" : "";

#--end of main-------------------------------------------------------


sub prolog {
   $user = getlogin || "(unknown)";
   local($sec,$min,$hour,$mday,$mon,$year) = localtime;
   $date = sprintf("(%s %d, %d) (%2d:%02d)",
                    ('January','February','March','April','May','June',
                     'July','August','October','November','Desember')[$mon],
                     $mday, $year+1900, $hour,$min);
   print "%!PS-Adobe-2.0\n";
   print "%%Title: @ARGV\n" if (@ARGV);
   print <<"EOT";
%%Creator: $prog_name, Text to PostScript filter in perl, (C) 1990 Gisle Aas, NCC
%%CreationDate: $date
%%For: $user
%%Pages: (atend)
EOT
   print "%%DocumentFonts: $font";
   print " $line_number_font" if ($opt_l);
   print " $header_font" if ($show_header);
   print "\n";
   print <<"EOT";
%%EndComments
/S{moveto show}bind def
/M/moveto load def
/L/lineto load def
/SF/setfont load def
EOT
    print <<"EOT" if ($isoencoding_not_builtin && !($norsk_ascii || $sw_fi_ascii));
ISOLatin1Encoding where { pop } { ISOLatin1Encoding
[/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/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/.notdef/.notdef
/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef
/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef/dotlessi/grave
/acute/circumflex/tilde/macron/breve/dotaccent/dieresis/.notdef/ring
/cedilla/.notdef/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/cedilla
/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 %ISOLatin1Encoding
} ifelse
EOT
    print <<"EOT" if ($norsk_ascii || $sw_fi_ascii);
%%BeginProcSet: reencode 1.0 0
/RE { %def
   findfont begin
   currentdict dup length dict begin
      { %forall
         1 index/FID ne {def} {pop pop} ifelse
      } forall
      /FontName exch def
      dup length 0 ne { %if
         /Encoding Encoding 256 array copy def
         0 exch { %forall
            dup type /nametype eq { %ifelse
               Encoding 2 index 2 index put
               pop 1 add
            }{%else
               exch pop
            } ifelse
         } forall
      } if pop
      currentdict dup
   end
   end
   /FontName get exch definefont pop
} bind def
%%EndProcSet: reencode 1.0 0
EOT
   print <<"EOT" if (!($norsk_ascii || $sw_fi_ascii));
%%BeginProcSet: 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
%%EndProcSet: newencode 1.0 0
EOT
   print "%%EndProlog\n%%BeginSetup\n";
   if ($norsk_ascii || $sw_fi_ascii) {
      print "[8#133 /AE/Oslash/Aring 8#173 /ae/oslash/aring] dup\n"
	if ($norsk_ascii);
      print "[8#133 /Adieresis/Odieresis/Aring" .
            " 8#173 /adieresis/odieresis/aring] dup\n"
	if ($sw_fi_ascii);
      print "/$font-ISO/$font RE\n";
      print "/$header_font-ISO/$header_font RE\n" if ($show_header);
   } else {
      print "ISOLatin1Encoding /$font-ISO/$font NE\n";
      print "ISOLatin1Encoding /$header_font-ISO/$header_font NE\n"
         if ($show_header);
   }
   printf "/F1/$font-ISO findfont %.2g scalefont def\n", $font_size;
   print "/F2/$line_number_font findfont $line_number_size scalefont def\n"
        if ($opt_l);
   print "/F3/$header_font-ISO findfont $header_font_size scalefont def\n"
        if ($show_header);
   print "F1 SF\n";
   print "%%EndSetup\n";
}



sub new_page {
   &end_page unless ($page_no == 0);
   $page_no++;
   print "%%Page: $page_no $page_no\n";
   print "%%BeginPageSetup\n";
   print "/page_save save def\n";
   printf "90 rotate 0 -%d translate %% landscape mode\n",&page_right_edge
      if ($landscape);
   print "0.15 setlinewidth\n" if ($show_header);
   print "%%EndPageSetup\n";
   if ($show_header) {
      # First print a box
      local($llx,$lly,$urx,$ury) = ($left_margin - 10,
            $top - $tb_margin - $header_font_size * 1.3,
            $right_edge - $right_margin + 10, $top - $tb_margin);
      printf "%.1f %.1f M %.1f %.1f L %.1f %.1f L ",
             $llx,$lly, $urx,$lly, $urx, $ury;
      printf "%.1f %.1f L closepath \n",$llx,$ury;
      print  "gsave .95 setgray fill grestore stroke\n";
      # Then the banner or the filename
      print "F3 SF\n";
      if ($opt_b) {
         printf "($opt_b)%.1f %.1f S\n",
                $left_margin,$top - $tb_margin - $header_font_size;
      }
      elsif ($file_name) {
         printf "(%s)%.1f %.1f S\n", $file_name, 
                      $left_margin,
                      $top - $tb_margin - $header_font_size;
      }
      # Then print page number
      printf "%.1f %.1f M($page_no)dup stringwidth pop neg 0 rmoveto show\n",
                 $right_edge - $right_margin, 
                 $top - $tb_margin - $header_font_size;
      print  "F1 SF\n";
   }
   if ($sep_bars) {
      print "% Some postscript code to draw horizontal bars.\n";
      print "% Not implemented yet\n";
   }
}

sub end_page {
   unless ($page_no == 0) {
      print "page_save restore\n";
      print "showpage\n";
   }
}

sub ps_string
{
   # Prepare text for printing
   local($_) = shift;
   s/[\\\(\)]/\\$&/g;
   s/[\001-\037\177-\377]/sprintf("\\%03o",ord($&))/ge;
   $_;    # return string
}