release 1.03

Oldest snapshot I could find.

Curses interface, some basic commands and menu.

This version adds fraction and negative input, and preliminary base
conversion.

diff --git a/sdc.pl b/sdc.pl
new file mode 100644 (file)
index 0000000..09541a0
--- /dev/null
+++ b/sdc.pl
@@ -0,0 +1,247 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Term::ReadKey;
+use Curses;
+
+initscr;
+ReadMode 3;
+
+my $height = $LINES-3;
+my $width = 42; #COLS
+
+my @stack;
+my @val;
+my $nopush; # 0=push and reset next; 1=reset next; 2=do nothing
+my $base = 10;
+my @menu;
+
+INIT: {
+
+@stack = ();
+@val = (0, 0); # val, frac
+$nopush = 1;
+
+sub showval($$) {
+       my ($val, $base) = @_;
+       return $val if $base==10;
+
+       my $int = int $val;
+       my $frac = $val-$int;
+
+       my $txt = '';
+       while ($int>=1) {
+               my $char = $int%$base;
+               $txt = ($char<10 ? $char : chr($char+55)).$txt;
+               $int /= $base;
+       }
+
+       $txt .= '.' if $frac>0;
+       for (my $i = 0; length $txt<$width-2 && $frac>0; $i++) {
+               $frac *= $base;
+               my $char = int $frac;
+               $frac -= $char;
+               $txt .= $char<10 ? $char : chr($char+55);
+       }
+
+       return $txt;
+} # showval
+
+sub showstack() {
+       for (0..@stack-1) {
+               addstr($height-$_, 1, "$_: ".showval($stack[$_], $base));
+               clrtoeol;
+       } # show stack
+       clrtoeol($height-$#stack-1, 1);
+} # showstack
+
+sub showmenu($) {
+       my @menus = ([qw(xroot log alog)], [qw(dec bin oct hex)]);
+       @menu = @{$menus[shift]};
+       attron(A_REVERSE);
+       addstr($height+2, $width/6*$_+1, join " ", $menu[$_]) for grep exists $menu[$_], 0..5;
+       attroff(A_REVERSE);
+       clrtoeol;
+       addstr($height+2, $width/6*$_, $_+1) for grep exists $menu[$_], 0..5;
+} # showmenu
+
+my %falias = (
+       chr(27).chr(79).chr(80)                  =>  0, # F1
+       chr(27).chr(79).chr(81)                  =>  1, # F2
+       chr(27).chr(79).chr(82)                  =>  2, # F3
+       chr(27).chr(79).chr(83)                  =>  3, # F4
+       chr(27).chr(91).chr(49).chr(53).chr(126) =>  4, # F5
+       chr(27).chr(91).chr(49).chr(55).chr(126) =>  5, # F6
+       chr(27).chr(91).chr(49).chr(56).chr(126) =>  6, # F7
+       chr(27).chr(91).chr(49).chr(57).chr(126) =>  7, # F8
+       chr(27).chr(91).chr(50).chr(48).chr(126) =>  8, # F9
+       chr(27).chr(91).chr(50).chr(49).chr(126) =>  9, # F10
+       chr(27).chr(91).chr(50).chr(51).chr(126) => 10, # F11
+       chr(27).chr(91).chr(50).chr(52).chr(126) => 10, # F12
+); # %falias
+
+my %alias = (
+       q     => chr 4,   # quit
+       s     => 'sin',
+       c     => 'cos',
+       t     => 'tan',
+       l     => 'log',
+       x     => 'xroot',
+       chr 8 => chr 127, # backspace
+); # %alias
+
+my %action = (
+       chr 13 => sub {
+               unshift @stack, $stack[0];
+               $nopush = 1;
+       }, # duplication
+
+       '+' => sub {
+               $stack[1] += shift @stack;
+       }, # addition
+       '-' => sub {
+               $stack[1] -= shift @stack;
+       }, # substraction
+       '*' => sub {
+               $stack[1] *= shift @stack;
+       }, # multiplication
+       '/' => sub {
+               $stack[1] /= shift @stack;
+       }, # division
+       '%' => sub {
+               $stack[1] %= shift @stack;
+       }, # modulus
+
+       '^' => sub {
+               $stack[1] **= shift @stack;
+       }, # exponentiation
+       'xroot' => sub {
+               $stack[1] **= 1/shift @stack;
+       }, # x-root of y
+
+       '&' => sub {
+               $stack[1] &= shift @stack;
+       }, # bitwise and
+       '|' => sub {
+               $stack[1] |= shift @stack;
+       }, # bitwise or
+       '#' => sub {
+               $stack[1] ^= shift @stack;
+       }, # bitwise xor
+       '~' => sub {
+               unshift @stack, ~(shift @stack);
+       }, # bitwise not
+
+       'log' => sub {
+               unshift @stack, log shift @stack;
+       }, # logarithm
+       'alog' => sub {
+               unshift @stack, 10 ** shift @stack;
+       }, # 10^x
+
+       'sin' => sub {
+               unshift @stack, sin shift @stack;
+       }, # sine
+       'cos' => sub {
+               unshift @stack, cos shift @stack;
+       }, # cosine
+       'tan' => sub {
+               local $_ = shift @stack;
+               unshift @stack, sin($_) / cos($_);
+       }, # tangent
+
+       'abs' => sub {
+               unshift @stack, abs shift @stack;
+       }, # absolute
+       '_' => sub {
+               unshift @stack, -shift @stack;
+       }, # negative
+       'min' => sub {
+               local $_ = shift @stack;
+               $stack[1] = $_ if $_<$stack[1];
+       }, # minimum
+
+       'dec' => sub {
+               $base = 10;
+       }, # decimal
+       'bin' => sub {
+               $base = 2;
+       }, # binary
+       'oct' => sub {
+               $base = 8;
+       }, # octal
+       'hex' => sub {
+               $base = 16;
+       }, # hexadecimal
+       'base36' => sub {
+               $base = 36;
+       }, # alphanumerical
+); # %action
+
+clear;
+showmenu(0);
+addstr($height+1, 0, "> ");
+
+while (1) {
+       addstr($height+1, 2, showval($val[0], $base));
+       clrtoeol;
+       refresh;
+
+       $_ = ReadKey;
+       if ($_ eq chr 27) {
+               while (defined (my $key = ReadKey -1)) {
+                       $_ .= $key;
+               } # read additional keys
+       } # escape
+
+       exists $alias{$_}  and $_ = $alias{$_};
+       exists $falias{$_} and $_ = $menu[$falias{$_}];
+
+       if ($_ eq chr 4) {
+               last INIT;
+       } # ^D
+       elsif ($_ eq chr 27) {
+               redo INIT;
+       } # escape
+
+       elsif (/^[\d.]$/) {
+               unshift @stack, $val[0] and showstack() unless $nopush;
+               @val = (0, 0) if $nopush<2; # replace current
+               $nopush = 2;
+               if ($_ eq '.') {
+                       $val[1] = 1;
+               } # dot
+               elsif ($val[1] *= 10) {
+                       $val[0] += $_/$val[1];
+               } # fraction
+               else {
+                       $val[0] = $val[0]*10+$_;
+               } # integer
+       } # number
+       elsif ($_ eq chr 127) {
+               if ($val[1] = int $val[1]/10) {
+                       $val[0] = int($val[0]*$val[1])/$val[1];
+               } else {
+                       $val[0] = int $val[0]/10
+               }
+       } # backspace
+
+       elsif (exists $action{$_}) {
+               unshift @stack, $val[0];
+               $nopush = 0;
+               $action{$_}();
+               $val[0] = shift @stack;
+               showstack();
+       } # some operation
+
+       else {
+               print "\n* error: ", join(' ', map ord, split //, $_), "\n";
+       }
+} # input loop
+}
+
+ReadMode 0;
+endwin;
+