news.utdallas.edu!hermes.chpc.utexas.edu!cs.utexas.edu!usc!elroy.jpl.nasa.gov!swrinde!gatech!hubcap!ncrcae!ncrhub2!ncrgw2!psinntp!internet!sbi!zeuswtc!pivot!bet Fri Jan 29 10:47:42 CST 1993
Article: 655 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:655
Path: feenix.metronet.com!news.utdallas.edu!hermes.chpc.utexas.edu!cs.utexas.edu!usc!elroy.jpl.nasa.gov!swrinde!gatech!hubcap!ncrcae!ncrhub2!ncrgw2!psinntp!internet!sbi!zeuswtc!pivot!bet
From: bet@sbi.com (Bennett Todd @ Salomon Brothers Inc., NY )
Newsgroups: comp.lang.perl
#Subject: HP-style calculator in perl
Message-ID: <837@pivot.sbi.com>
Date: 27 Jan 93 21:49:28 GMT
Sender: news@pivot.sbi.com
Organization: Salomon Brothers, Inc.
Lines: 216
Nntp-Posting-Host: sandstorm


I finally got tired of not having an HP-style termcap-based calculator
around, so I wrote one in Perl. The implementation isn't especially pretty,
but it seems to work fine [at least for me]. I couldn't get the ioctl call
to work for finding out the baud rate (which termcap.pl wants for computing
padding) so I just wired in 9600. Aside from that it pretty much worked
right the first time:-).

This implements numeric entry, the arithmetic operators "+". "-", "*", "/",
and "^" (y**x); ^L redraws the screen; "x" recalls the last-x register; "X"
exchanges the x and y registers; and "q" quits. I think I have the tracking
of last-x and stack push correctly reproducing the behavior of an HP
calculator. I call this thing ``hp''.

Share and Enjoy!

-Bennett
bet@sbi.com

#/usr/local/bin/perl
($progname=$0) =~ s#.*/##;
$term = $ENV{'TERM'} || 'ansi';


require 'sys/ioctl.ph';
#ioctl(STDIN,&TIOCGETP,$foo) || die "$progname: ioctl failed: $!\n";
#($ispeed,$ospeed) = unpack('cc',$foo);
($ispeed,$ospeed) = (&B9600,&B9600);

require 'termcap.pl';
&Tgetent($term);

sub clear {
	print $TC{'cl'};
}

sub clear_to_end_of_display {
	print $TC{'cd'};
}

sub clear_to_end_of_line {
	print $TC{'ce'};
}

sub tgoto {
	($col,$row) = @_;
	print &Tgoto($TC{'cm'},$col,$row);
}

sub term_init {
	system("stty -echo raw");
}
sub term_restore {
	system("stty echo -raw");
	&tgoto(0,8);
}

sub die_cleanly {
	&term_restore;
	exit(0);
}

sub getch {
	local($foo);
	sysread(STDIN,$foo,1) || &die_cleanly;
	$foo;
}

$SIG{'INT'} = $SIG{'QUIT'} = $SIG{'TERM'} = die_cleanly;
&term_init;
$| = 1;


# Screen layout
# These are rows for all the registers and such

%loc = (
	't', 0,
	'z', 1,
	'y', 2,
	'x', 3,
	'lastx', 5,
	'input', 7
);

$lastx = $x = $y = $z = $t = 0;

sub refresh {
	&tgoto(0,$loc{'t'});
	printf("%12.2f", $t);&clear_to_end_of_line;
	&tgoto(0,$loc{'z'});
	printf("%12.2f", $z);&clear_to_end_of_line;
	&tgoto(0,$loc{'y'});
	printf("%12.2f", $y);&clear_to_end_of_line;
	&tgoto(0,$loc{'x'});
	printf("%12.2f", $x);&clear_to_end_of_line;
	&tgoto(0,$loc{'lastx'});
	printf("%12.2f", $lastx);&clear_to_end_of_line;
	&tgoto(0,$loc{'input'});
}

&clear;
&refresh;
$_ = &getch;
$dopush = 0;

command: while (!/q/) {
	/q/ && last command;
	/\014/ && do {
		&clear;
		&refresh;
		$_ = &getch;
		next command;
	};
	/[0-9.]/ && do {
		&pushstack if $dopush;
		$x = &getnum;
		$dopush = 1;
		&refresh;
		next command;
	};
	/[\r\n]/ && do {
		&pushstack;
		$dopush = 0;
		&refresh;
		$_ = &getch;
		next command;
	};
	/\+/ && do {
		$lastx = $x;
		($x,$y,$z) = ($x+$y,$z,$t);
		$dopush = 1;
		&refresh;
		$_ = &getch;
		next command;
	};
	/-/ && do {
		$lastx = $x;
		($x,$y,$z) = ($y-$x,$z,$t);
		$dopush = 1;
		&refresh;
		$_ = &getch;
		next command;
	};
	/\*/ && do {
		$lastx = $x;
		($x,$y,$z) = ($x*$y,$z,$t);
		$dopush = 1;
		&refresh;
		$_ = &getch;
		next command;
	};
	/\// && do {
		$lastx = $x;
		($x,$y,$z) = ($y/$x,$z,$t);
		$dopush = 1;
		&refresh;
		$_ = &getch;
		next command;
	};
	/\^/ && do {
		$lastx = $x;
		($x,$y,$z) = ($y**$x,$z,$t);
		$dopush = 1;
		&refresh;
		$_ = &getch;
		next command;
	};
	/x/ && do {
		&pushstack if $dopush;
		$x = $lastx;
		$dopush = 1;
		&refresh;
		$_ = &getch;
		next command;
	};
	/X/ && do {
		$lastx = $x;
		($x,$y) = ($y,$x);
		$dopush = 1;
		&refresh;
		$_ = &getch;
		next command;
	};
	$_ = &getch;
}

sub pushstack {
	($t,$z,$y) = ($z,$y,$x);
}

sub getnum {
	local($num) = $_;
	print $num;
	$_ = &getch;
	digit: while (/[0-9.\008\127]/) {
		/[0-9.]/ && do {
			print $_;
			$num .= $_;
			$_ = &getch;
			next digit;
		};
		/[\008\127]/ && do {
			chop($num);
			print "\008 \008";
			$_ = &getch;
			next digit;
		};
	}
	&tgoto(0,$loc{'input'});
	&clear_to_end_of_display;
	$num+0;
}
			
	
&die_cleanly;