release 1.07
[descalc.git] / sdc.pl
diff --git a/sdc.pl b/sdc.pl
index b91c2096146971967e9f9e31bc332883874d5b63..f1692ed64619a81fffd4f954fe5ef96ca6052ceb 100755 (executable)
--- a/sdc.pl
+++ b/sdc.pl
@@ -1,12 +1,22 @@
 #!/usr/bin/perl
 
-### curses rpn desktop calculator ###
-
+### SDC - small desktop calculator ###
+# reverse polish notition calculator using curses
 # by Shiar <shiar.org>
 
-# 06-18       - start
-# 06-25       -
-# 08-04 14:45 - error dialog (don't mess up screen)
+# 1.01 06-18       - start
+# 1.03 06-25       -
+# 1.04 08-04 14:45 - error dialog (don't mess up screen)
+# 1.05 09-10 19:45 - hp48-like drop (backspace but not editing value)
+#                  - argument checking
+#                  - command backspacing
+# 1.06 09-15 23:10 - menu contents in module
+#                  - new commands: a?(sin|cos|tan)h, inv, !, rand
+#                  - x and v shortkeys
+# 1.07 09-24 23:50 - numeric modifiers hardcoded instead of in action hash
+#                  - action undo: last stack alteration can be undone
+#                  - enter on no value repeats last val on stack
+#                  - new commands: sr/sr, shortkeys ( )
 
 use strict;
 use warnings;
@@ -14,6 +24,7 @@ use utf8;
 
 use Term::ReadKey;
 use Curses;
+use SDC::Menu 1.006;
 
 initscr;
 ReadMode 3;  # cbreak mode
@@ -36,93 +47,9 @@ my %set = (
        card     =>  1,  # degrees radians grades
        coord    =>  0,  # cartesian polar spherical
        complex  =>  0,  # real complex
-       menushow =>  6,
+       menushow => 12,
 ); # %set
 
-my @menus = (
-       [qw(refresh math>8 prog> mode>7 unit>11)],
-       [qw(main>0 log alog ln exp sin cos tan 0 asin acos atan)], #1 math
-       [qw(main>0 dec bin oct hex logic>3 bit>4)], #2 base
-       [qw(base>2 and or xor not)], #3 base logic
-       [qw(base>2 rl sl asr sr rr)], #4 base bit
-       [qw(base>2 rlb slb srb rrb)], #5 base byte
-       [qw(main>0 sq sqrt ^ xroot)], #6
-       [qw(main>0 number_format angle_measure coord_system)], #7 mode
-       [qw(main>0
-               vector> matrix> list> hyperbolic>9 real>10 base>2
-               probability> fft> complex> constants>
-       )], #8 math
-       [qw(math>8
-               sinh cosh tanh asinh acosh atanh
-               expm lnp1
-       )], #9 math hyperbolic
-       [qw(math>8
-               % %ch %t min max mod
-               abs sign mant xpon ip fp
-               rnd trnc floor ceil r>d d>r
-       )], #10 math real
-       [qw(main>0
-               tools> length>12 area>13 volume>14 time>15 speed>16
-               mass>17 force>18 energy>19 power>20 pressure>21 temperature>22
-               electric_current>23 angle>24 light>25 radiation>26 viscosity>27
-       )], #11 units
-#              mm cm m in ft yd km mile mmile lt-yr mil Ang fermi rod fath)],
-       [qw(unit>11
-               _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
-               _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
-       )], #12 length
-       [qw(unit>11
-               _m^2 _cm^2 _b _yd^2 _ft^2 _in^2
-               _km^2 _ha _a _mi^2 _miUS^2 _acre
-       )], #13 area
-       [qw(unit>11
-               _m^3 _st _cm^3 _yd^3 _ft^3 _in^3
-               _l _galUK _galC _gal _qt _pt
-               _ml _cu _ozfl _ozUK _tbsp _tsp
-               _bbl _bu _pk _fbm
-       )], #14 volume
-       [qw(unit>11
-               _yr _d _h _min _s _Hz
-       )], #15 time
-       [qw(unit>11
-               _m/s _cm/s _ft/s _kph _mph _knot
-               _c _ga
-       )], #16 speed
-       [qw(unit>11
-               _kg _g _Lb _oz _slug _lbt
-               _ton _tonUS _t _ozt _ct _grain
-               _u _mol
-       )], #17 mass
-       [qw(unit>11
-               _N _dyn _gf _kip _lbf _pdl
-       )], #18 force
-       [qw(unit>11
-               _J _erg _Kcal _Cal _Btu _ftxlbf
-               _therm _MeV _eV
-       )], #19 energy
-       [qw(unit>11
-               _W _hp
-       )], #20 power
-       [qw(unit>11
-               _Pa _atm _bar _psi _torr _mmHg
-               _inHg _inH2O
-       )], #21 pressure
-       [qw(unit>11
-       )], #22 temperature
-       [qw(unit>11
-       )], #23 electric_current
-       [qw(unit>11
-       )], #24 angle
-       [qw(unit>11
-       )], #25 light
-       [qw(unit>11
-       )], #26 radiation
-       [qw(unit>11
-       )], #27 viscosity
-
-
-
-); # @menus
 @menu = @{$menus[0]};
 $menumin = 0;
 
@@ -159,18 +86,19 @@ my %falias = (
 my %alias = (
        chr 4 => 'quit', # ^D
        chr 9 => 'more', # tab
-       '_' => 'chs', # change sign; 48: y
-       'e' => 'eex', # exponent; 48: z
-#      "\033\133\062\176" => 'swap', # ins
-       chr(27).chr(91).chr(51).chr(126) => 'clear', # del
+       '_'   => 'chs', # change sign; 48: y
+       'e'   => 'eex', # exponent; 48: z
+       "\033\133\062\176" => 'eex', # ins
+       "\033\133\063\176" => "clear", # del
        chr 127 => 'drop', # backspace
-       chr 8 => 'drop', # backspace
-       chr 13 => ' ', # enter
-       "\014" => 'refresh', # ^L
+       chr 8   => 'drop', # backspace
+       chr 13  => 'enter', # enter
+       ' '     => 'enter', # space
+       "\014"  => 'refresh', # ^L
 #      "\033\133\110" => 'refresh', # home
 
 #      "\033\133\101" => '', # up; 48: k (stack)
-#      "\033\133\104" => '', # left; 48: p (picture)
+       "\033\133\104" => 'undo', # left; 48: p (picture)
 #      "\033\133\102" => '', # down; 48: q (view)
        "\033\133\103" => 'swap', # right; 48: r (swap)
 
@@ -178,20 +106,25 @@ my %alias = (
        '|' => 'or',
        '#' => 'xor',
        '~' => 'not',
-
-               's' => 'sin',
-       chr(27).'s' => 'asin',
-               'c' => 'cos',
-       chr(27).'c' => 'acos',
-               't' => 'tan',
-       chr(27).'t' => 'atan',
-               'l' => 'log',
-       chr(27).'l' => 'alog',
-               'n' => 'ln',
-       chr(27).'n' => 'exp',
-               'q' => 'sq',
-       chr(27).'q' => 'sqrt',
-       chr(27).'^' => 'xroot',
+       '(' => 'sl',
+       ')' => 'sr',
+
+           "s" => "sin",
+       "\033s" => "asin",
+           "c" => "cos",
+       "\033c" => "acos",
+           "t" => "tan",
+       "\033t" => "atan",
+           "l" => "log",
+       "\033l" => "alog",
+           "n" => "ln",
+       "\033n" => "exp",
+           "q" => "sq",
+       "\033q" => "sqrt",
+           "x" => "^",
+       "\033x" => "xroot",
+       "\033^" => "xroot",
+           "v" => "inv",
 ); # %alias
 
 =cut
@@ -203,44 +136,25 @@ HP48 keys:
 =cut
 
 my %action = (
-       'more' => [0, sub {
+       'more' => [-1, sub {
                $menumin += $set{menushow};
                $menumin = 0 if $menumin>=$#menu;
                showmenu();
        }], # tab
-       'digit'=> [-2, sub { $val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_ }],
-       '.'    => [-2, sub { $val{frac} = 1 }], # decimal point
-       'eex'  => [-2, sub {}], # exponent
-       'chs'  => [0, sub {
-               if (defined $val{i}) {
-                       $val{i} = -$val{i};
-               } else {
-                       $stack[0] = -$stack[0];
-               }
-       }], # negative
+       'chs'  => [0, sub {$stack[0] = -$stack[0]}], # negative
 
-       'drop' => [0, sub {
-               if (defined $val{i}) {
-                       $val{i} = ($val{frac} = int $val{frac}/10)
-                               ? int($val{i}*$val{frac})/$val{frac} : int $val{i}/10
-               } else {
-                       shift @stack;
-               }
-       }], # backspace
-       'clear'  => [0, sub {
-               #todo: if (val{i}) delete char after cursor
-               @stack = (); %val = (i=>undef, frac=>0)
-       }], # clear all
-
-       ' '    => [0, sub {
-               unshift @stack, $val{i};
+       'drop' => [0, sub {shift @stack}], # backspace
+       'clear'=> [0, sub {@stack = (); %val = (i=>undef, frac=>0) }], # clear all #todo: if (val{i}) delete char after cursor
+
+       'enter'=> [0, sub {
+               unshift @stack, defined $val{i} ? $val{i} : $stack[0];
                %val = (i=>undef, frac=>0);
        }], # duplication
 
        'swap' => [1, sub {@stack[0, 1] = @stack[1, 0]}], # swap x<->y
 
        '='    => [1, sub {$var{a} = $stack[0]}], # copy
-       '>'    => [1, sub {$var{a} = shift @stack}], # assign
+       '?'    => [1, sub {$var{a} = shift @stack}], # assign
 
        '+'    => [2, sub {$stack[1] += shift @stack}], # addition
        '-'    => [2, sub {$stack[1] -= shift @stack}], # substraction
@@ -248,6 +162,7 @@ my %action = (
        '/'    => [2, sub {$stack[1] /= shift @stack}], # division
        'mod'  => [2, sub {$stack[1] %= shift @stack}], # modulo
 
+       'inv'  => [1, sub {$stack[0] = 1 / $stack[0]}], # 1/x
        'sqrt' => [1, sub {$stack[0] = sqrt $stack[0]}], # square root
        'sq'   => [1, sub {$stack[0] *= $stack[0]}], # squared
        '^'    => [2, sub {$stack[1] **= shift @stack}], # exponentiation
@@ -267,6 +182,13 @@ my %action = (
        'tan'  => [1, sub {$stack[0] = sin($stack[0]) / cos($stack[0])}], # tangent
 #      'atan' => [1, sub {}], # arctangent
 
+       'sinh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/2}], # hyperbolic sine
+       'cosh' => [1, sub {$stack[0] = ( exp($stack[0]) + exp(-$stack[0]) )/2}], # hyperbolic cosine
+       'tanh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/( exp($stack[0]) + exp(-$stack[0]) )}], # hyperbolic tangent (sinh/cosh)
+       'asinh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2+1)+$stack[0] )}], # inverse hyperbolic sine
+       'acosh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2-1)+$stack[0] )}], # inverse hyperbolic cosine
+       'atanh'=> [1, sub {$stack[0] = log( (1+$stack[0]) / (1-$stack[0]) )/2}], # inverse hyperbolic tangent
+
        '%'    => [2, sub {$stack[0] /= shift @stack}], # percentage
        '%ch'  => [2, sub {$val{i} = 100*(shift(@stack)-$val{i})/$val{i}}], # percentage change
        '%t'   => [2, sub {$val{i} = 100*$val{i}/shift(@stack)}], # percentage total
@@ -275,6 +197,8 @@ my %action = (
        'or'   => [2, sub {$stack[1] |= shift @stack}], # bitwise or
        'xor'  => [2, sub {$stack[1] ^= shift @stack}], # bitwise xor
        'not'  => [2, sub {$stack[0] = ~$stack[0]}], # bitwise not
+       'sl'   => [1, sub {$stack[0] *= 2}], # shift left
+       'sr'   => [1, sub {$stack[0] /= 2}], # shift right
 
        'abs'  => [1, sub {$stack[0] = abs $stack[0]}], # absolute #todo
        'sign' => [1, sub {$stack[0] = $stack[0] <=> 0}], # sign
@@ -286,20 +210,19 @@ my %action = (
        'floor'=> [1, sub {$stack[0] = int $stack[0]}], # floor
        'ceil' => [1, sub {$stack[0] = int $stack[0]+.9999}], # ceil
 
-       'min'  => [2, sub {
-               local $_ = shift @stack;
-               $stack[0] = $_ if $_<$stack[0];
-       }], # minimum
-       'max'  => [2, sub {
-               local $_ = shift @stack;
-               $stack[0] = $_ if $_>$stack[0];
-       }], # maximum
+       'min'  => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_<$stack[0] }], # minimum
+       'max'  => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_>$stack[0] }], # maximum
 
        'dec'  => [0, sub {$set{base} = 10}], # decimal
        'bin'  => [0, sub {$set{base} = 2}], # binary
        'oct'  => [0, sub {$set{base} = 8}], # octal
        'hex'  => [0, sub {$set{base} = 16}], # hexadecimal
-       'base36' => [0, sub {$set{base} = 36}], # alphanumerical
+       'base' => [1, sub {$set{base} = shift @stack}], # alphanumerical
+
+       '!'    => [1, sub {local $_ = $stack[0]; $stack[0] *= $_ while --$_>1}], # factor
+       'rand' => [0, sub {unshift @stack, rand}], # random value <1
+
+       'undo' => [0, sub {@stack = @{ $var{undo} }}], # undo
 ); # %action
 
 my %unit;
@@ -331,6 +254,17 @@ $unit{$_->[0]} = { name=>$_->[0], type=>$i, val=>$_->[1] } for map {$i++; @$_} (
 } # create unit table
 
 
+sub error($) {
+       attron(A_REVERSE);
+       addstr(0, 0, shift);
+       attroff(A_REVERSE);
+       clrtoeol;
+       refresh;
+
+       ReadKey; # wait for confirm
+       1 while defined (ReadKey -1); # clear key buffer
+} # error
+
 sub showval($$);
 sub showval($$) {
        my ($val, $base) = @_;
@@ -391,7 +325,7 @@ DRAW:
 clear;
 showmenu();
 showstack();
-addstr($height+1, 0, "> ");
+addstr($height+1, 0, "> ");  # prompt
 
 while (1) {
        addstr($height+1, 2, showval($val{i}, $set{base}));
@@ -407,10 +341,15 @@ while (1) {
                } # read additional keys
        } # escape sequence
 
-       exists $alias{$_}  and $_ = $alias{$_};
-       exists $falias{$_} and $_ = $menu[$falias{$_}];
+       exists $alias{$_}  and $_ = $alias{$_};  # command shortkeys
+       if (exists $falias{$_}) {
+               unless ($_ = $menu[$falias{$_}]) {
+                       error("* no such menu entry *");
+                       goto DRAW;
+               }
+       } # function key
 
-       $_ = delete $val{bla} if exists $val{bla} and $_ eq ' ';
+       $_ = delete $val{bla} if exists $val{bla} and $_ eq 'enter';
 
        if ($_ eq 'quit') {
                last;
@@ -419,39 +358,67 @@ while (1) {
                goto DRAW;
        } # refresh
 
-       elsif (/>(\d+)$/) {
-               @menu = @{ $menus[$1] };
-               $menumin = 0;
-               showmenu();
-       } # submenu
-
        elsif (exists $val{bla} or /^[A-Z]$/) {
                if (defined $val{i}) {
                        unshift @stack, $val{i};
                        %val = (i=>undef, frac=>0);
                        showstack();
-               }
-               $val{bla} .= lc $_;
+               } # enter present value
+               if ($_ eq "drop") {
+                       $val{bla} = substr $val{bla}, 0, -1 or delete $val{bla};
+               } # backspace
+               else {
+                       $val{bla} .= lc $_;
+               } # add character
        } # manual command
 
+       elsif (/^\d$/) {
+               $val{i} = 0 unless defined $val{i};
+               $val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_;
+       }
+       elsif ($_ eq '.') {
+               $val{i} = 0 unless defined $val{i};
+               $val{frac} = 1;
+       } # decimal point
+       elsif ($_ eq 'eex') {
+               $val{i} = 1 unless defined $val{i};
+               #todo
+       } # exponent
+       elsif ($_ eq 'chs' and defined $val{i}) {
+               $val{i} = -$val{i};
+       } # change sign
+       elsif ($_ eq 'drop' and defined $val{i}) {
+               $val{i} = ($val{frac} = int $val{frac}/10)
+                       ? int($val{i}*$val{frac})/$val{frac} : int $val{i}/10
+       } # backspace
+
        elsif (exists $action{$_} or /^\d$/) {
-               my ($type, $cmd) = @{ $action{$_} || $action{digit} };
-               if ($type==-2) {
-                       $val{i} = 0 unless defined $val{i};
-               } # modify value
+               my ($type, $cmd) = @{ $action{$_} };
                if ($type>0 and defined $val{i}) {
                        unshift @stack, $val{i};
                        %val = (i=>undef, frac=>0);
                } # auto enter
+               if ($type>0 and $type>@stack) {
+                       error("* insufficient stack arguments for operation *");
+                       goto DRAW;
+               } # insufficient arguments
+               $var{undo} = [@stack] if $type>=0 and $_ ne 'undo';
                $cmd->();
                showstack() if $type>=0;
        } # some operation
 
+       elsif (/>(\d+)$/) {
+               @menu = @{ $menus[$1] };
+               $menumin = 0;
+               showmenu();
+       } # submenu
+
        elsif ($_ =~ /^_/) {{
                $_ = $unit{substr $_, 1} or next;
                if (exists $val{unit} and $val{unit}{type}==$_->{type}) {
-                       unshift @stack, $val{i} and showstack() if defined $val{i};
+                       unshift @stack, $val{i} if defined $val{i};
                        $stack[0] *= delete($val{unit})->{val} / $_->{val};
+                       showstack();
                        %val = (i=>undef, frac=>0);
                } # convert
                else {
@@ -460,14 +427,7 @@ while (1) {
        }} # conversion
 
        else {
-               attron(A_REVERSE);
-               addstr($height+1, 0, "* error: ".join(' ', map ord, split //, $_)." *");
-               attroff(A_REVERSE);
-               clrtoeol;
-               refresh;
-
-               ReadKey; # wait for confirm
-               1 while defined (ReadKey -1); # clear key buffer
+               error("* error: ".join(' ', map ord, split //, $_)." *");
                goto DRAW; # screen messed up
        } # error
 } # input loop