#!/afs/athena/contrib/perl/p
#
# Copyright 1990 Kurt Pires.  All rights reserved.
#
# Permission to use, copy, and/or distribute for any purpose and
# without fee is hereby granted, provided that both the above copyright
# notice and this permission notice appear in all copies and derived works.
# Fees for distribution of this software or for derived sources may only
# be charged with express written permission of the copyright holders.
# This software is provided ``as is'' without express or implied warranty.
#
# E-Mail address: kjpires@Berkeley.EDU

$host	= ($#ARGV >= 0) ? $ARGV[0] :
		($ENV{'GBHOST'} ? $ENV{'GBHOST'} : 'golem.mit.edu');
$port	= ($#ARGV >= 1) ? $ARGV[1] : 
		($ENV{'GBPORT'} ? $ENV{'GBPORT'} : 2010);

select(STDIN); $| = 1; select(STDOUT); $| = 1;

do 'ioctl.pl' || do 'sys/ioctl.pl';
eval '$TIOCGETP = &TIOCGETP()' if ($TIOCGETP == 0);
eval '$TIOCSETP = &TIOCSETP()' if ($TIOCSETP == 0);
eval '$TIOCGWINSZ = &TIOCGWINSZ()' if ($TIOCGWINSZ == 0);
$TIOCGETP = 1074164744 if ($TIOCGETP == 0);
$TIOCSETP = -2147060727 if ($TIOCSETP == 0);
$TIOCGWINSZ = 1074295912 if ($TIOCGWINSZ == 0);

ioctl(STDOUT,$TIOCGETP,$foo);
($ispeed,$ospeed) = unpack('cc',$foo);
do 'termcap.pl' || die "Can't get termcap.pl: $@";
&Tgetent($ENV{'TERM'});
do get_tty_size();

$SIG{'WINCH'} = 'get_tty_size';

$curhilite = '0';

print "Retry attempt #", ++$retry, "...\n" while (&connectto($host, $port));
print "\007"x3 if ($retry);

$SIG{'PIPE'} = 'IGNORE';

$loc = 'LOGIN';
$ap = '->';

$SIG{'TSTP'} = 'tstp';
do setup();

# Setup the Input Select Mask
$input_mask = '';
vec($input_mask, fileno(S), 1) = 1;
vec($input_mask, fileno(STDIN), 1) = 1;

# Setup the Output Select Mask
$output_mask = undef;

# Default aliases
do command('alias ls map');
do command('alias cd cs');
do command('source ' . $ENV{'HOME'} . '/.gbrc') if (-e $ENV{'HOME'} . '/.gbrc');

$timeout = 0.1;
while (1) {
	$timeout = undef if ($timeout == 0.0);
	$nfound = select($read_mask = $input_mask, $write_mask = $output_mask,
							undef, $timeout);
	if ($redraw) {	# After-suppend redraw...  See tstp & cont...
		$timeout = .2;
		undef $redraw;
		next;
	}

	if ($nfound <= 0) {	# Handle this first in case select is broken.
		# Timeout -- print prompt and input...

		print "\r";
		do prompt();
		print $output;

		$timeout = undef;
	} elsif (vec($read_mask, fileno(S), 1)) {
		recv(S, $input, 4096, 0);
		if (length($input) <= 0) {
			print "Connection closed by foreign host.\n";
			do quit();
		}
		$input = $pushback . $input if ($pushback);

		if ($timeout == 0) {
			do erase_input();

			$timeout = .3;
		}

		while ($input =~ s/([^\r\n]*)\r*\n//) {
			do input($1);		# Pass a line at a time...
		}
		$pushback = $input;
	} elsif (vec($read_mask, fileno(STDIN), 1)) {
		read(STDIN, $input, 1);
		if ($input =~ /[\b\027\177\014\022\025\030\004]/) {
			if (length($output) == 0) {
				# Just redraw the prompt!
				#do erase_input();
				print "\r";
				if ($input =~ /\004/) {
					do quit();
				}
			} elsif ($input =~ /[\b\177]/) {
				# ^H or DEL -- Backspace/Delete
				$output =~ s/.$//;
				do erase_chars(1);
				next;
			} elsif ($input =~ /\027/) {
				# ^W -- Word erase
				$output =~ s/([^ \t]*[ \t]?)$//;
				do erase_chars(length($1));
				next;
			} elsif ($input =~ /[\014\022]/) {
				# ^L or ^R -- Just redraw
				do erase_input();
			} elsif ($input =~ /[\025\030]/) {
				# ^U or ^X -- Line erase
				do erase_input();
				undef $output;
			} else {
				print "\007";
			}

			if ($timeout == 0) {
				do prompt();
				print $output;
			}
			next;
		}

		# Toss blank input lines...
		next if (($input =~ /[\r\n]/) && (length($output) == 0));

		print $input if ($timeout == 0);

		$input = $output . $input;

		while ($input =~ s/([^\r\n]*)\r*\n//) {
			$_ = $1;
			if ($timeout) {
				do prompt();
				print $output;
			}

			do command($_);
		}
		$output = $input;
	}
}

sub command {	# Parses command and may start up the output write queue...
	local($_) = @_;

	# End of last command -- close redirection.
	if ($tempout) {
		$tempout = 0;
		close(TEMPOUT);
	}

	s/^\s+//;	# kill leading spaces
	s/\s+$//;	# kill trailing spaces

	# Process aliases here
	# Arguments go at end or where !* is...
	# Example:  alias surv \surv !* \| less

	$alias_loop = 0;
	while (/^\S+/ && ($alias = $aliases{$&})) {
		local($body) = $&;
		local($end) = $';
		$_ = $body if ($alias =~ s/!\*/$end/g);	# Handle !* in alias
		s/^\S+/$alias/;
		if (++$alias_loop > 20) {
			print "Alias loop. \n";
			$timeout = 0.1;		# Causes prompt to appear
			return;
		}
	}
	s/^\\//;	# Remove leading \'s -- alias escape

	# Process redirection here
	# command > file		Outputs to both screen and file
	# command |> file		Outputs to file only
	# command | UNIX_commands	Outputs to UNIX_commands

	s/\\>/\001/g;
	s/\\\|/\002/g;
	if (s/([>|]).*//) {
		local($file) = $&;
		$tempout = ($file =~ /\|/) ? 2 : 1;
		$file =~ s/\|\s*>/>/;
		if (open(TEMPOUT, $file) == 0) {
			$tempout = 0;
			print "ERROR: $file: $! -- Command not executed.\n";
			$timeout = 0.1;		# Causes prompt to appear
			return;
		}
		s/\s+$//;	# Strip off any trailing spaces left...
	}
	s/\001/>/g;
	s/\002/\|/g;

	# Process commands here
	# alias <alias> <command>	Alias a command -- !* only substitution
	# alias <alias>			Show alias
	# alias				Show all aliases
	# source <file>			Read in a file as if it was typed
	# tee <file>			Set tee file
	# tee				Turn off
	# unalias <alias> ...		Unaliasing aliases
	# unalias *			Unalias all aliases

	if (/^alias$/) {
		while (($alias, $_) = each %aliases) {
			do term_output("$alias\t$_");
		}
	} elsif (/^alias\s+(\S+)$/) {
		if ($alias = $aliases{$1}) {
			do term_output($alias);
		}
	} elsif (/^alias\s+(\S+)\s+/) {
		$aliases{$1} = $';
	} elsif (/^source\s+(\S+)/) {
		if (open(INPUT, $1)) {
			while (<INPUT>) {
				chop;
				do command($_);
			}
			close(INPUT);
		} else {
			print "$1: $!\n";
		}
	} elsif (/^tee\b/) {
		if (defined $tee) {
			close(TEE);
			print "Tee to file $tee done.\n";
			undef $tee;
		}
		if (/^tee\s+(\S+)$/) {
			if (open(TEE, ">$1")) {
				$tee = $1;
				print "Tee'ing output to file $tee\n";
			} else {
				print "$1: $!\n";
			}
		}
	} elsif (/^unalias\b/) {
		if (/^unalias\s+\*$/) {
			undef %aliases;
		} else {
			split;
			shift(@_);
			foreach $_ (@_) {
				delete $aliases{$_};
			}
		}
	} else {
		# Normal Command
		s/^\\//;			# For \alias, etc.
		print S $_, "\r\n";
		print TEMPOUT "$loc $ap: $_\n" if ($tempout);
		print TEE "$loc $ap: $_\n" if (defined $tee);
		return;
	}
	$timeout = 0.1;	# Redraw prompt
	return;
}

sub quit {
	close(S);
	system '/bin/stty', 'echo', 'cooked';
	print "\n";
	exit;
}

sub connectto {
	if ($_[0] =~ /^([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)$/) {
		$name = $_[0];
		$aliases = '';
		$atype = 2;
		$len = 4;
		@addrs = ( pack("CCCC", $1, $2, $3, $4) );
	} else {
		($name, $aliases, $atype, $len, @addrs) = gethostbyname($_[0]);
		if ($#addrs < 0) {
			print "Unknown address for $_[0]\n";
			exit 1;
		}
	}
	print "Connecting to $name port ", $_[1], "\n";

	socket(S, $atype, 1, 0) || die "socket: $!";;
	$SIG{'INT'} = 'quit';
	$SIG{'TERM'} = 'quit';
	$SIG{'PIPE'} = 'quit';

	foreach $addr (@addrs) {
		local($them) = pack("S n a4 x8", $atype, $_[1], $addr);

		if (connect(S, $them)) {
			select(S); $| = 1; select(STDOUT);

			print "Connected to $name port ", $_[1], "\n";
			return 0;
		}
	}
	print "Failed to connect to $name: $!\n";
	sleep 10;
	return -1;
}

sub input {
	local($_) = $_[0];

	if (s/^ ?\$([\w'-]+);([0-9]+);([0-9]+);([0-9]+);//) {
$| = 0;
		($name, $maxx, $maxy, $num) = ($1, $2, $3, $4);
		print "Planet Map: $name ($num)\n";
		if ($maxx >= 10) {
			print "   ";
			for ($x = 0; $x < $maxx; $x++) {
				print int($x/10);
			}
			print "\n";
		}
		print "   ";
		for ($x = 0; $x < $maxx; $x++) {
			print $x%10;
		}
		print "\n";
		for ($y = 0; $y < $maxy; $y++) {
			printf("%2d ", $y);
			for ($x = 0; $x < $maxx; $x++) {
				s/(.)(.)//;
				($hilite, $sect) = ($1, $2);
				do hilite($hilite);
				print $sect;
			}
			do hilite(0);
			print "\n";
		}
		s/[\r\n]+$//;
		print "\n  $_\n";
$| = 1;
		next;
	}
	if (s/^ ?#([0-9].*;)/\1/) {
$| = 0;
		@objects = split(/ *; */);
		$rest = pop(@objects);

		do mapclear();

		obj: foreach $_ (@objects) {
			#s/^[^0-9]+//;
			($stand, $x, $y, $a, $symbol, $stand2, $name) = split;

			next obj if ($symbol eq 'm');
			next obj if (($symbol eq '*' || $symbol eq '@') && $a > 0);

			$y = int($y * $yscale);
			next obj if ($y >= $rows);

			$x = int($x * $xscale);
			next obj if ($x >= $cols);

			do mapset($x++, $y, $stand, $symbol);

			foreach $c (split(/ */, $name)) {
				next obj if ($x >= $cols);
				next obj if (&mapchar($x, $y) eq '*');
				do mapset($x, $y, $stand2, $c);
				$x++;
			}
		}
		for ($y = $miny; $y <= $maxy; $y++) {
			$cursor = 0;
			for ($x = $minx; $x <= $maxx; $x++) {
				$pos = $y*$cols + $x;

				if ($mapchars[$pos] ne ' ') {
					if ($cursor < $x) {
						do hilite(0);
						$tabs = (int($x/8) - int($cursor/8));
						print "\t" x $tabs,
						      ' ' x ($tabs ? ($x%8) : ($x-$cursor));
					}
					do hilite($maphilites[$pos]);
					print $mapchars[$pos];
					$cursor = $x+1;
				}
			}
			do hilite(0);
			print "\n";
		}
		undef @map;

		$_ = $rest;
$| = 1;
	}
	if (s,^ *\( \[(\d+)\] ([/\w# '-]+)\) *$,,) {
		($ap, $loc) = ($1, $2);

		$loc =~ s/ //g;
		$loc =~ s,^/*,/,;

		## do prompt();

		# The command is over.
		if ($tempout) {
			$tempout = 0;
			close(TEMPOUT);
		}
		next;
	}
	do term_output($_);
}

sub term_output {
	print "@_\n" if ($tempout < 2);
	print TEMPOUT "@_\n" if ($tempout);
	print TEE "@_\n" if (defined $tee);
}

sub mapclear {
	$i = $rows * $cols;
	while (--$i >= 0) {
		$mapchars[$i] = ' ';
		$maphilites[$i] = '0';
	}
	$minx = $cols;
	$miny = $rows;
	$maxx = 0;
	$maxy = 0;
}
sub mapset {	# No range check anymore...
	local($x, $y, $hilite, $char) = @_;

	local($pos) = $y * $cols + $x;
	$mapchars[$pos] = $char;
	$maphilites[$pos] = $hilite;

	$maxx = $x if ($x > $maxx);
	$maxy = $y if ($y > $maxy);
	$minx = $x if ($x < $minx);
	$miny = $y if ($y < $miny);
}
sub mapchar { return $mapchars[$_[1] * $cols + $_[0]]; }

sub hilite {
	local($hilite) = @_;

	if ($curhilite != $hilite) {
		&Tputs($TC{$hilite ? 'so' : 'se'}, 1, 'STDOUT');
		$curhilite = $hilite;
	}
}

sub get_tty_size {
	ioctl(STDOUT, $TIOCGWINSZ, $foo);
	($rows, $cols) = unpack('SS', $foo);
	$TC{'li'} = $rows if ($rows != 0);
	$TC{'co'} = $cols if ($cols != 0);
	$TC{'li'} = 24 if ($TC{'li'} == 0);
	$TC{'co'} = 80 if ($TC{'co'} == 0);

	$rows = $TC{'li'};
	$cols = $TC{'co'};

	$yscale = ($rows - 3) / 2 / 100;
	$xscale = ($cols - 6) / 2 / 100;
}

sub prompt {
	print "$loc ";
	do hilite(1);
	print "$ap";
	do hilite(0);
	print ': ';
	$prompt_length = length("$loc $ap: ");
}

sub erase_input {
	return if ($timeout);

	local($i);
	local($x) = $TC{'xn'} ? 1 : 0;		# XXX last column problems

	print "\r";
	for ($i = int(($prompt_length+length($output)-$x)/
			$cols); $i > 0; $i--) {
		&Tputs($TC{'ce'}, 1, 'STDOUT');
		&Tputs($TC{'up'}, 1, 'STDOUT');
	}
	&Tputs($TC{'ce'}, 1, 'STDOUT');
}

sub erase_chars {
	local($i) = @_;
	return if ($timeout || $i < 1);

	local($x) = $TC{'xn'} ? 1 : 0;		# XXX last column problems

	if ((($prompt_length+length($output)-$x) % $cols) + $i + $x+1 > $cols) {
		# crosses line boundry -- redraw the whole thing...
		local($save_output) = $output;
		$output .= 'X' x $i;
		do erase_input();
		$output = $save_output;

		do prompt();
		print $output;
	} else {
		print "\b" x $i;
		print " " x $i;
		print "\b" x $i;
		#&Tputs($TC{'ce'}, 1, 'STDOUT');
	}
}

sub tstp {
	$SIG{'CONT'} = 'cont';

	system '/bin/stty', 'echo', 'cooked';
	do hilite(0);

	$SIG{'TSTP'} = 'DEFAULT';
	kill 'TSTP', $$;
}

sub cont {
	do setup();
	$redraw = 1;
}

sub setup {
	$SIG{'TSTP'} = 'tstp';
	system '/bin/stty', '-echo', 'cbreak';
	do get_tty_size();
}