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: [email protected] (Bennett Todd @ Salomon Brothers Inc., NY )
Newsgroups: comp.lang.perl
#Subject: HP-style calculator in perl
Message-ID: <[email protected]>
Date: 27 Jan 93 21:49:28 GMT
Sender: [email protected]
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
[email protected]

#/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;