#! /usr/contrib/bin/perl -w
# $Id:$

my $xsize = 1024;#/12;
my $ysize = 780;#/10;

my $aspect = 0;
my $verbose = 0;

while ($#ARGV >= 0 && ($_ = $ARGV[0], /^-/)) {	# process options
    shift;
    last if /^--$/;
    if (/^-d/) {
	$aspect = 1;
    } elsif (/^-v/) {
	$verbose++;
    } else {
	print "Usage: pbmtek [-d] file.ps\n";
	exit 1;
    }
}

$sign = <>;
exit 1 if (!$sign);				# file not found?
if ($sign ne "P1\n") {
    print "ASCII PBM file expected.\n";
    if ($sign =~ /^Error: /) {			# gs output
	print $sign, <>;
    } else {
	chop $sign;
	print "Found: $sign.\n";
    }
    exit 1;
}

$dims = <>;
my ($nx, $ny) = split ' ', $dims;
#print "$nx x $ny\n";

if ($ENV{"TERM"} ne "xterm") {
#    open (OUT, "| rawtty");
#    select OUT; $| = 1;
}

print "\x1b\x0c";                               # clear screen

my $w;
if ($aspect) {
    if ($nx > $ny) {
        $w = $nx;
    } else {
        $w = $ny;
    }
} else {
    $w = 0;
}

my $x = 0;
my $y = 0;
my $last = 0;

# global state
$lasthighi = -1;
$lasthighj = -1;

while (<>) {
    chop;
    @l = split '';
    foreach (@l) {
	if ($_ > 0) {
            if ($last == 0) {
                print "\x1d";                   # line drawing mode
                &putxy ($x, $y, $w);
                $last = 1;
            }

            if ($x >= $nx - 1) {                # last pixel in a row
                &putxy ($x, $y, $w);
                $last = 0;
            }

        } else {
            if ($last > 0) {
                &putxy ($x - 1, $y, $w);
                $last = 0;
            }
        }
	$x++;
	if ($x >= $nx) {
	    $x = 0;
	    $y++;
	}

    }
}
exit 0;


sub putxy {
    my ($x, $y, $w) = @_;
    my ($i, $j);
    if ($w > 0) {
        $i = int ($xsize * $x / $w);
        $j = int ($ysize * ($w - 1 - $y) / $w);
    } else {
        $i = int (1024 * $x / $nx);
        $j = int (780 * ($ny - 1 - $y) / $ny);
    }
    putij ($i, $j);
}

sub putij {
    my ($i, $j) = @_;
    my ($highi, $highj);

    $highj = ($j >> 5) & 0x1f;
    if ($highj != $lasthighj) {
        print chr (0x20 | ($j >> 5) & 0x1f);    # highy
    }
    $highi = ($i >> 5) & 0x1f;
    if ($highi != $lasthighi) {
        print chr (0x60 | $j & 0x1f) . chr (0x20 | $highi); # lowy, highx
    }
    print chr (0x40 | $i & 0x1f); # lowx

    $lasthighi = -1;                            # only one stretch at a time
    $lasthighj = -1;

}

# $Log: pbmtek,v $
# Revision 1.9  1996/11/14 23:46:01  tjchol01
# New options handling.
#
# Revision 1.8  1996/11/07 05:58:32  tjchol01
# Added gs error handling.
#
# Revision 1.7  1996/10/13 22:37:08  tjchol01
# Using new perl.
#
# Revision 1.6  1996/10/12 04:37:14  tjchol01
# Procedures putij and putxy.  Corrected bug at row endings.
#
# Revision 1.5  1996/10/12 02:32:41  tjchol01
# Continuous horizontal lines and sending lowx only.  Clumsy.
#
# Revision 1.4  1996/10/12 01:30:09  tjchol01
# Skipping all but lowx at the end of line.
#
# Revision 1.3  1996/10/11 05:06:56  tjchol01
# Working without tekps.  Sending 4010 line drawing sequences.
#
# Revision 1.2  1996/10/11 01:58:17  tjchol01
# Working with tekps.
#
# Revision 1.1  1996/10/10 06:47:23  tjchol01
# Initial revision