NetNews Usenet Archive 1993 #3/NN_1993_3.iso/spool/comp/lang/perl/8038

Text File | 1993-01-28 | 4.1 KB | 228 lines

Path: sparky!uunet!ferkel.ucsb.edu!taco!gatech!hubcap!ncrcae!ncrhub2!ncrgw2!psinntp!internet!sbi!zeuswtc!pivot!bet
From: [e-mail] (Bennett Todd @ Salomon Brothers Inc., NY )
Newsgroups: comp.lang.perl
Subject: HP-style calculator in perl
Message-ID: <[e-mail]>
Date: 27 Jan 93 21:49:28 GMT
Sender: [e-mail]
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
[e-mail]

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