#!/usr/bin/perl -w
#
# $Header: /cvs/scripts/text2ps,v 1.3 2002/03/31 13:31:10 richard Exp $
#
# text2ps - translate text into Postscript
#
# (c) 1996 Richard Kettlewell <richard@greenend.org.uk>
#
#     This program is free software; you can redistribute it and/or
#     modify it under the terms of the GNU General Public License as
#     published by the Free Software Foundation; either version 2 of
#     the License, or (at your option) any later version.
#
#     This program is distributed in the hope that it will be useful,
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#     GNU General Public License for more details.
#
# Usage:
#
#     text2ps [-twoup] [-reverse] [--] filename ...
#
# text2ps knows about backspace and generates bold and italic text in
# the output.
#
# Revision history:
#
#            2002-03-30    Checked into CVS
#
#     0.4    1996-12-12    Reverse print option
#                          (NB holds entire document in memory)
#                          POD documentation
#
#     0.32   1996-11-26    Cope with _^Hd^Hd^H...
#
#     0.31   1996-11-19    Cope with +^Ho as used in Solaris man pages
#
#     0.3    1996-07-25    Get two-per-page printing right way round.
#                          Postscript comments to mark up page
#                          boundaries e.g. for ghostview
#
#     0.21   1996-07-12    Cope with double overprinting now
#
#     0.2    1996-06-01    Added -twoup option, so you can now have
#                          one page per page.
#

=head1 NAME

text2ps - translate ASCII text to Postscript

=head1 SYNOPSIS

B<text2ps> [B<-reverse>] [B<-twoup>] [B<-->] I<filename> ...

=head1 DESCRIPTION

Translates plain text to Postscript.  This program interprets
backspace characters in the input and uses bold and italic fonts
appropriately.

=head1 OPTIONS

=over 8

=item B<-twoup>

Fits two pages of input onto a single A4 sheet of output.

=item B<-reverse>

Outputs the pages in reverse order.

=back

=head1 AUTHOR

Richard Kettlewell <richard@greenend.org.uk>

=cut

$lines = 66;
$font = "Courier";
$bold = "Courier-Bold";
$italic = "Courier-Italic";

$reverse = 0;
$twoup = 0;
$eof = 0;

while($#ARGV >= 0 && $ARGV[0] =~ /^-/) {
    $_ = $ARGV[0];
    shift @ARGV;
    last if /^--$/;
    /^-twoup$/ && do {
	$twoup = 1;
	next;
    };
    /^-reverse$/ && do {
	$reverse = 1;
	next;
    };
    print STDERR "Usage:\n\n",
                 "text2ps2 [-reverse] [-twoup] [--] filename ...\n";
    exit 1;
}

if($twoup) {
    $pagewidth = 72.0 * 11.6;
    $pageheight = 72.0 * 8.2;

    $leftmargin = 72.0 + 18.0;
    $middlemargin = 56.0;
    $topmargin = 56.0;
    $bottommargin = 56.0;
} else {
    $pageheight = 72.0 * 11.6;
    $pagewidth = 72.0 * 8.2;

    $leftmargin = 72.0 + 18.0;
    $topmargin = 72.0;
    $bottommargin = 72.0;
}

$availableheight = $pageheight - $topmargin - $bottommargin;

$pointstep = $availableheight / $lines;
$pointsize = $pointstep / 1.1;

# print the Postscript header

print "%!PS-Adobe-1.0\n";
print "%%Orientation: ", $twoup ? "Landscape" : "Portrait", "\n";
print "%%EndComments\n";
print "%%BeginProlog\n";
print "/sf /languagelevel where {pop languagelevel} {1} ifelse 2 lt { { exch\n";
print "findfont exch dup type /arraytype eq { makefont } { scalefont }\n";
print "ifelse setfont } bind } { /selectfont load } ifelse def\n";
print "%%EndProlog\n";

$n = 1;

@pages = ();

while(@left = &getpage()) {
    @page = ();
    undef $selected_font;
    &output("%%Page: $n $n\n");
    $n++;
    if($twoup)
    {
	@right = &getpage();
	&output("gsave\n",
		"90 rotate 0 -$pageheight translate\n");
	&putpage($leftmargin, $pageheight - $topmargin - $pointstep, @left);
	&putpage($pagewidth / 2 + $middlemargin, $pageheight - $topmargin - $pointstep, @right);
	&output("grestore\n");
    } else {
	&putpage($leftmargin, $pageheight - $topmargin - $pointstep, @left);
    }
    &output("showpage\n");
    if($reverse)  {
	local @x = @page;
	push(@pages, \@x);
    }
}
if($reverse) {
    for($i = $#pages; $i >= 0; $i--) {
	print @{$pages[$i]};
    }
}
print "% that's all folks!\n";

# output one line, coping with bold and underline (->italic)

sub putline {
    my ($x, $y, $line) = @_;
    local $_;
    my $offset = 0;
    my (@line) = split(//,$line);
    my $i;
    my $buffer = "";
    my $bufferfont = "";

    # move to right point on page
    &output("$x $y moveto\n");
    # iterate over line character by character
    for($i = 0; $i <= $#line; $i++) {
	my $c = $line[$i];
	# expand tabs into spaces
	if($c eq "\t")
	{
	    $buffer .= " ";
	    $offset++;
	    while($offset & 7) {
		$buffer .= " ";
		$offset++;
	    }
	    $bufferfont = $font if $bufferfont eq "";
	} else {
	    my $thischar;
	    # see if there is a backspace
	    if($i < $#line && $line[$i+1] eq "\b") {
		# backspace + underscore represents underline
		# (we use italic)
		if($line[$i] eq "_")
		{
		    $thischar = $italic;
		    $c = $line[$i+2];
		    $i += 2;
		    while($i + 2 <= $#line
			  && $line[$i+1] eq "\b" && $line[$i+2] eq $c) {
			$i += 2;
			$thischar = $bold;
		    }
		}
		# backspace + same character again represents bold
		else {
		    if($i + 2 <= $#line
		       && $c eq "+"
		       && $line[$i+2] eq "o") {
			# kludge for solaris nroff output
			$thischar = $bold;
			$i += 2;
		    }
		    else {
			while($i + 2 <= $#line
			      && $line[$i+1] eq "\b" && $line[$i+2] eq $c) {
			    $i += 2;
			}
			$thischar = $bold;
		    }
		}
		# skip formatting characters
	    }
	    else {
		# plain text
		$thischar = $font;
	    }
	    # if we've built up text in another font, flush it out
	    if($thischar ne $bufferfont) {
		&segment($bufferfont, $buffer) if($buffer ne "");
		$bufferfont = $thischar;
		$buffer = "";
	    }
	    # add another character to the buffer, which now has the
	    # right font associated with it.
	    $buffer .= $c;
	}
    }
    # flush any reminaing buffered text
    &segment($bufferfont, $buffer) if($buffer ne "");
}

# print one line in the right font
# we cache font changes
sub segment {
    local ($textfont, $_) = @_;

    if(!defined $selected_font || $textfont ne $selected_font) {
	&output("/$textfont $pointsize sf\n");
	$selected_font = $textfont;
    }
    s/([\(\)\\])/\\$1/g;
    &output("($_) show\n");
}

# output a page, line by line
sub putpage {
    my ($x, $y, @page) = @_;
    local $_;
    for(@page) {
	&putline($x, $y, $_);
	$y -= $pointstep;
    }
}

# get a page of text
sub getpage {
    my @result = ();
    if(!$eof) {
	local $_;
	while(<>) {
	    # trash newline at end of line
	    chomp;
	    # form feed breaks page
	    last if (/\f/);
	    # blank lines at top of page are ignored
	    next if (/^\s*$/ && $#result < 0);
	    push(@result, $_);
	    last if($#result >= $lines - 1);
	}
	$eof = !defined $_;
    }
    return @result;
}

# output some text
sub output {
    if($reverse) {
	push(@page, @_);
    } else {
	print @_;
    }
}