#!/usr/bin/perl
+### curses rpn desktop calculator ###
+
+# by Shiar <shiar.org>
+
+# 06-18 - start
+# 06-25 -
+# 08-04 14:45 - error dialog (don't mess up screen)
+
use strict;
use warnings;
initscr;
ReadMode 3;
-my $height = $LINES-3;
-my $width = 42; #COLS
+my $height = $LINES-3 || 4;
+my $width = $COLS || 42;
+my @val = (0, 0); # val, frac
+my $nopush = 1; # 0=push and reset next; 1=reset next; 2=do nothing
my @stack;
-my @val;
-my $nopush; # 0=push and reset next; 1=reset next; 2=do nothing
-my $base = 10;
+my %var;
my @menu;
+my %set = (
+ base => 10,
+ numb => 0, # fixed scientific engineering
+ card => 1, # degrees radians grades
+ coord => 0, # cartesian polar spherical
+ complex => 0, # real complex
+ menushow => 12,
+); # %set
+
+my @menus = (
+ [qw(quit base>1 math>8 mode>7)],
+ [qw(main>0 dec bin oct hex logic>3 bit>4)], #1 base
+ [qw(main>0 log alog ln exp sin cos tan 0 asin acos atan)], #2 math
+ [qw(base>1 and or xor not)], #3 base logic
+ [qw(base>1 rl sl asr sr rr)], #4 base bit
+ [qw(base>1 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>1
+ 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> area> volume> time> speed>
+ mass> force> energy> power> pressure> temperature>
+ electric_current> angle> light> radiation> viscosity>
+ )], #11 units
+); # @menus
+@menu = @{$menus[0]};
+
+my %falias = (
+ "\033" => 0, # esc
+ "\033\117\120" => 1, # f1
+ "\033\133\061\061\176" => 1, # f1
+ "\033\117\121" => 2, # f2
+ "\033\133\061\062\176" => 2, # f2
+ "\033\117\122" => 3, # f3
+ "\033\133\061\063\176" => 3, # f3
+ "\033\117\123" => 4, # f4
+ "\033\133\061\064\176" => 4, # f4
+ "\033\133\061\065\176" => 5, # f5
+ "\033\133\061\067\176" => 6, # f6
+ "\033\133\061\070\176" => 7, # f7
+ "\033\133\061\071\176" => 8, # f8
+ "\033\133\062\060\176" => 9, # f9
+ "\033\133\062\061\176" => 10, # f10
+ "\033\133\062\063\176" => 11, # f11/F1
+ "\033\133\062\064\176" => 12, # f12/F2
+ "\033\133\062\065\176" => 13, # F3
+ "\033\133\062\066\176" => 14, # F4
+ "\033\133\062\070\176" => 15, # F5
+ "\033\133\062\071\176" => 16, # F6
+ "\033\133\063\061\176" => 17, # F7
+ "\033\133\063\062\176" => 18, # F8
+ "\033\133\063\063\176" => 19, # F9
+ "\033\133\063\064\176" => 20, # F10
+ "\033\133\062\063\073\062\176" => 21, # F11
+ "\033\133\062\064\073\062\176" => 22, # F12
+); # %falias
+
+my %alias = (
+ chr 4 => 'quit', # ^D
+ 'q' => 'quit', # quit
+ '_' => 'chs', # change sign
+ 'e' => 'eex', # exponent
+ "\033\133\062\176" => 'swap', # ins
+ chr(27).chr(91).chr(51).chr(126) => 'clx', # del
+ chr 127 => '<-', # backspace
+ chr 8 => '<-', # backspace
+ "\014" => 'refresh', # ^L
+ "\033\133\110" => 'refresh', # home
+
+ '&' => 'and',
+ '|' => 'or',
+ '#' => 'xor',
+ '~' => 'not',
+
+ 's' => 'sin',
+ chr(27).'s' => 'asin',
+ 'u' => 'cos',
+ chr(27).'u' => 'acos',
+ 't' => 'tan',
+ chr(27).'t' => 'atan',
+ 'l' => 'log',
+ chr(27).'l' => 'alog',
+ 'n' => 'ln',
+ chr(27).'n' => 'exp',
+ 'x' => 'xroot',
+
+); # %alias
-INIT: {
+my %action = (
+# 'digit' => [-2, sub {
+# if ($val[1] *= 10) {
+# $val[0] += $_/$val[1];
+# } # fraction
+# else {
+# $val[0] = $val[0]*10+$_;
+# } # integer
+# }],
+ 'digit'=> [-2, sub { $val[0] = ($val[1] *= 10) ? $val[0]+$_/$val[1] : $val[0]*10+$_ }],
+ '.' => [-2, sub { $val[1] = 1 }], # decimal point
+ 'eex' => [-2, sub {}], # exponent
+ 'chs' => [1, sub {$val[0] = -$val[0]}], # negative
+
+ '<-' => [-1, sub {
+ $val[0] = ($val[1] = int $val[1]/10)
+ ? int($val[0]*$val[1])/$val[1] : int $val[0]/10
+ }], # backspace
+ 'clx' => [0, sub {@stack = (); @val = (0, 0); $nopush = 1}], # clear all
+
+ chr 13 => [0, sub {
+ unshift @stack, $val[0];
+ $nopush = 1;
+ }], # duplication
+
+ 'swap' => [1, sub {($val[0], $stack[0]) = ($stack[0], $val[0])}], # swap x<->y
+
+ '=' => [1, sub {$var{a} = $val[0]}], # copy
+ '>' => [1, sub {$var{a} = $val[0]; $val[0] = shift @stack}], # assign
+
+ '+' => [2, sub {$val[0] += shift @stack}], # addition
+ '-' => [2, sub {$val[0] = shift(@stack) - $val[0]}], # substraction
+ '*' => [2, sub {$val[0] *= shift @stack}], # multiplication
+ '/' => [2, sub {$val[0] = shift(@stack) / $val[0]}], # division
+ 'mod' => [2, sub {$val[0] = shift(@stack) % $val[0]}], # modulo
+
+ 'sqrt' => [1, sub {$val[0] = sqrt $val[0]}], # square root
+ 'sq' => [1, sub {$val[0] *= $val[0]}], # squared
+ '^' => [2, sub {$val[0] = shift(@stack) ** $val[0]}], # exponentiation
+ 'xroot'=> [2, sub {$val[0] = shift(@stack) ** (1/$val[0])}], # x-root of y
+
+ 'log' => [1, sub {$val[0] = log($val[0]) / log(10)}], # logarithm
+ 'alog' => [1, sub {$val[0] = 10 ** $val[0]}], # 10^x
+ 'ln' => [1, sub {$val[0] = log $val[0]}], # natural logaritm
+ 'lnp1' => [1, sub {$val[0] = log($val[0]+1)}], # ln(x+1)
+ 'exp' => [1, sub {$val[0] = exp($val[0])}], # e^x
+ 'expm' => [1, sub {$val[0] = exp($val[0])-1}], # exp(x)-1
+
+ 'sin' => [1, sub {$val[0] = sin $val[0]}], # sine
+ 'asin' => [1, sub {$val[0] = atan2($val[0], sqrt(1 - $val[0]*$val[0]))}], # inverse sine
+ 'cos' => [1, sub {$val[0] = cos $val[0]}], # cosine
+ 'acos' => [1, sub {$val[0] = atan2(sqrt(1 - $val[0]*$val[0]), $val[0])}], # inverse cosine
+ 'tan' => [1, sub {$val[0] = sin($val[0]) / cos($val[0])}], # tangent
+# 'atan' => [1, sub {}], # arctangent
+
+ '%' => [2, sub {$val[0] /= shift(@stack)}], # percentage
+ '%ch' => [2, sub {$val[0] = 100*(shift(@stack)-$val[0])/$val[0]}], # percentage change
+ '%t' => [2, sub {$val[0] = 100*$val[0]/shift(@stack)}], # percentage total
+
+ 'and' => [2, sub {$val[0] = shift(@stack) & $val[0]}], # bitwise and
+ 'or' => [2, sub {$val[0] = shift(@stack) | $val[0]}], # bitwise or
+ 'xor' => [2, sub {$val[0] = shift(@stack) ^ $val[0]}], # bitwise xor
+ 'not' => [2, sub {$val[0] = ~$val[0]}], # bitwise not
+
+ 'abs' => [1, sub {$val[0] = abs $val[0]}], # absolute #todo
+ 'sign' => [1, sub {$val[0] = $val[0] <=> 0}], # sign
+ 'ip' => [1, sub {$val[0] = int $val[0]}], # integer part
+ 'fp' => [1, sub {$val[0] -= int $val[0]}], # fractional part
+
+ 'rnd' => [1, sub {local $_ = 10**shift @stack; $val[0] = int(($val[0]+.5)*$_)/$_}], # round
+ 'trnc' => [1, sub {local $_ = 10**shift @stack; $val[0] = int($val[0]*$_)/$_}], # truncate
+ 'floor'=> [1, sub {$val[0] = int $val[0]}], # floor
+ 'ceil' => [1, sub {$val[0] = int $val[0]+.9999}], # ceil
+
+ 'min' => [2, sub {
+ local $_ = shift @stack;
+ $val[0] = $_ if $_<$val[0];
+ }], # minimum
+ 'max' => [2, sub {
+ local $_ = shift @stack;
+ $val[0] = $_ if $_>$val[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
+); # %action
-@stack = ();
-@val = (0, 0); # val, frac
-$nopush = 1;
+sub showval($$);
sub showval($$) {
my ($val, $base) = @_;
return $val if $base==10;
my $int = int $val;
my $frac = $val-$int;
+ my $exp = 0;
my $txt = '';
+ while ($int>$base**10) {
+ $int /= $base;
+ $exp++;
+ } # exponent part
while ($int>=1) {
my $char = $int%$base;
$txt = ($char<10 ? $char : chr($char+55)).$txt;
$int /= $base;
- }
+ } # integer part
$txt .= '.' if $frac>0;
for (my $i = 0; length $txt<$width-2 && $frac>0; $i++) {
my $char = int $frac;
$frac -= $char;
$txt .= $char<10 ? $char : chr($char+55);
- }
+ } # fraction part
+
+ $txt .= 'e'.showval($exp, $base) if $exp;
return $txt;
} # showval
sub showstack() {
for (0..@stack-1) {
- addstr($height-$_, 1, "$_: ".showval($stack[$_], $base));
+ addstr($height-$_, 1, "$_: ".showval($stack[$_], $set{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;
+sub showmenu() {
+ clrtoeol($height+2, 1);
+ for (grep exists $menu[$_], 1..$set{menushow}) {
+ my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
+ addstr($height+2, $width/$set{menushow}*($_-1), $_);
+ attron(A_REVERSE);
+ addstr($s);
+ attroff(A_REVERSE);
+ addch('>') if $sub;
+ } # display menu txts
} # 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
+DRAW:
clear;
-showmenu(0);
+showmenu();
+showstack();
addstr($height+1, 0, "> ");
while (1) {
- addstr($height+1, 2, showval($val[0], $base));
+ addstr($height+1, 2, showval($val[0], $set{base}));
clrtoeol;
refresh;
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();
+ if (exists $action{$_} or /^\d$/) {
+ my ($type, $cmd) = @{ $action{$_} || $action{digit} };
+ if ($type==-2) {
+ unshift @stack, $val[0] and showstack() unless $nopush;
+ @val = (0, 0) if $nopush<2; # replace current
+ $nopush = 2;
+ } # modify value
+ $cmd->();
+ $nopush = 0 if $type>0;
+ showstack() if $type>=0;
} # some operation
+ elsif ($_ eq 'quit') {
+ last;
+ } # quit
+ elsif ($_ eq 'refresh') {
+ goto DRAW;
+ } # refresh
+
+ elsif (/>(\d+)$/) {
+ @menu = @{ $menus[$1] };
+ showmenu();
+ } # submenu
+
else {
- print "\n* error: ", join(' ', map ord, split //, $_), "\n";
+ 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
+ goto DRAW; # screen messed up
}
} # input loop
-}
ReadMode 0;
endwin;
git.shiar.nl / descalc.git / commitdiff