HP-style calculator in perl 
Author Message
 HP-style calculator in perl

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

#!/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'};

Quote:
}

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

Quote:
}

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

Quote:
}

sub tgoto {

        print &Tgoto($TC{'cm'},$col,$row);

Quote:
}

sub term_init {
        system("stty -echo raw");
Quote:
}

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

Quote:
}

sub die_cleanly {
        &term_restore;
        exit(0);

Quote:
}

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

Quote:
}

$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'});

Quote:
}

&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;

Quote:
}

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

Quote:
}

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;

Quote:
}

&die_cleanly;


Mon, 17 Jul 1995 05:49:28 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Perl 4.019 on HP 400 Hp/UX 8.0

2. Converting mmdf-style maildrops to sendmail-style maildrops

3. Perl 4.003 fails dbm test - HP 825, HP-UX 2.1

4. Perl 4.0 on HP 9000/300 HP/UX

5. Perl as a pocket calculator

6. **Need Calculator Script*

7. Compile perl5 on HP 7xx/HP-UX 8.0 ?

8. op/dbm test fails on HP 735 under HP-UX 9.01

9. How to optimize this? (a check-sum calculator)

10. #! mechanism on HP 9000-870 (HP-UX 8.0)

11. Limited form of eval() - just a calculator

12. HP-UX, HP 720, core dumps on regress

 

 
Powered by phpBB® Forum Software