X-Git-Url: http://git.shiar.nl/descalc.git/blobdiff_plain/375edfcd40c9aae752068931a7831a1dae3d0d7e..cbe6b523381a22a69f29a0e0865a83e7bb171838:/sdc.pl diff --git a/sdc.pl b/sdc.pl old mode 100644 new mode 100755 index 09541a0..b91c209 --- a/sdc.pl +++ b/sdc.pl @@ -1,42 +1,356 @@ #!/usr/bin/perl +### curses rpn desktop calculator ### + +# by Shiar + +# 06-18 - start +# 06-25 - +# 08-04 14:45 - error dialog (don't mess up screen) + use strict; use warnings; +use utf8; use Term::ReadKey; use Curses; initscr; -ReadMode 3; +ReadMode 3; # cbreak mode +END { + ReadMode 0; + endwin; +} # restore terminal on quit -my $height = $LINES-3; -my $width = 42; #COLS +my $height = $LINES<3 ? 4 : $LINES-3; # stack depth (lines of stack plus one) +my $width = $COLS || 42; # limit value precision, stetch menu +my %val = qw(i 0 frac 0); # i, frac 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 $menumin; +my %set = ( + base => 10, + numb => 0, # fixed scientific engineering + card => 1, # degrees radians grades + coord => 0, # cartesian polar spherical + complex => 0, # real complex + menushow => 6, +); # %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; + +my %falias = ( + "\033" => 0, # esc + "\033\117\120" => 1, # f1 + "\033\133\061\061\176" => 1, # f1 + "\033\133\061\062\176" => 2, # f2 + "\033\133\061\063\176" => 3, # f3 + "\033\133\061\064\176" => 4, # f4 + "\033\117\121" => 2, # f2 + "\033\117\122" => 3, # f3 + "\033\117\123" => 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 -INIT: { +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 + chr 127 => 'drop', # backspace + chr 8 => 'drop', # backspace + chr 13 => ' ', # enter + "\014" => 'refresh', # ^L +# "\033\133\110" => 'refresh', # home + +# "\033\133\101" => '', # up; 48: k (stack) +# "\033\133\104" => '', # left; 48: p (picture) +# "\033\133\102" => '', # down; 48: q (view) + "\033\133\103" => 'swap', # right; 48: r (swap) + + '&' => 'and', + '|' => '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', +); # %alias -@stack = (); -@val = (0, 0); # val, frac -$nopush = 1; +=cut +HP48 keys: + S T U V W X + - sin cos tan sqrt ^ 1/x + < asin acos atan sq alog exp + > [a] ∫ ∑ xroot log ln +=cut +my %action = ( + 'more' => [0, 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 + + '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}; + %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 + + '+' => [2, sub {$stack[1] += shift @stack}], # addition + '-' => [2, sub {$stack[1] -= shift @stack}], # substraction + '*' => [2, sub {$stack[1] *= shift @stack}], # multiplication + '/' => [2, sub {$stack[1] /= shift @stack}], # division + 'mod' => [2, sub {$stack[1] %= shift @stack}], # modulo + + '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 + 'xroot'=> [2, sub {$stack[1] **= 1 / shift @stack}], # x-root of y + + 'log' => [1, sub {$stack[0] = log($stack[0]) / log(10)}], # logarithm + 'alog' => [1, sub {$stack[0] = 10 ** $stack[0]}], # 10^x + 'ln' => [1, sub {$stack[0] = log $stack[0]}], # natural logaritm + 'lnp1' => [1, sub {$stack[0] = log($stack[0]+1)}], # ln(x+1) + 'exp' => [1, sub {$stack[0] = exp($stack[0])}], # e^x + 'expm' => [1, sub {$stack[0] = exp($stack[0])-1}], # exp(x)-1 + + 'sin' => [1, sub {$stack[0] = sin $stack[0]}], # sine + 'asin' => [1, sub {$stack[0] = atan2($stack[0], sqrt(1 - $stack[0]*$stack[0]))}], # inverse sine + 'cos' => [1, sub {$stack[0] = cos $stack[0]}], # cosine + 'acos' => [1, sub {$stack[0] = atan2(sqrt(1 - $stack[0]*$stack[0]), $stack[0])}], # inverse cosine + 'tan' => [1, sub {$stack[0] = sin($stack[0]) / cos($stack[0])}], # tangent +# 'atan' => [1, sub {}], # arctangent + + '%' => [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 + + 'and' => [2, sub {$stack[1] &= shift @stack}], # bitwise and + '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 + + 'abs' => [1, sub {$stack[0] = abs $stack[0]}], # absolute #todo + 'sign' => [1, sub {$stack[0] = $stack[0] <=> 0}], # sign + 'ip' => [1, sub {$stack[0] = int $stack[0]}], # integer part + 'fp' => [1, sub {$stack[0] -= int $stack[0]}], # fractional part + + 'rnd' => [1, sub {local $_ = 10**shift @stack; $val{i} = int(($val{i}+.5)*$_)/$_}], # round + 'trnc' => [1, sub {local $_ = 10**shift @stack; $val{i} = int($val{i}*$_)/$_}], # truncate + '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 + + '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 + +my %unit; +{ +my $i = 0; +$unit{$_->[0]} = { name=>$_->[0], type=>$i, val=>$_->[1] } for map {$i++; @$_} ( + [ + ['m', 1], + ['cm', .01], + ['mm', .001], + ['km', 1000], + ['ft', .3048], + ['in', .0254], + ['yd', .9144], + ['mile', 1609.344], + ['nmile', 1852], + ['lyr', 9.46052840488e+15], + ['mil', 2.54e-5], + # _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi + # _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi + ], # lengths + [ + ['m^3', 1], + ['cm^3', 1e-6], + ['ft^3', .028316846592], + ['in^3', 1.6387064e-5], + ], # volume +); +} # create unit table + + +sub showval($$); sub showval($$) { my ($val, $base) = @_; + return '' unless defined $val; 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++) { @@ -44,148 +358,45 @@ sub showval($$) { 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); + my $nr = 0; + for (grep exists $menu[$_], $menumin+1..$menumin+$set{menushow}) { + my $sub = (my $s = $menu[$_]) =~ s/>\d+$//; + addstr($height+2, $width/$set{menushow}*($nr++), $_); + 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{i}, $set{base})); + addstr('_'.$val{unit}{name}) if exists $val{unit}; + addstr($val{bla}) if exists $val{bla}; clrtoeol; refresh; @@ -194,54 +405,70 @@ while (1) { while (defined (my $key = ReadKey -1)) { $_ .= $key; } # read additional keys - } # escape + } # escape sequence 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 + $_ = delete $val{bla} if exists $val{bla} and $_ eq ' '; + + if ($_ eq 'quit') { + last; + } # quit + elsif ($_ eq 'refresh') { + 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(); } - } # backspace - - elsif (exists $action{$_}) { - unshift @stack, $val[0]; - $nopush = 0; - $action{$_}(); - $val[0] = shift @stack; - showstack(); + $val{bla} .= lc $_; + } # manual command + + elsif (exists $action{$_} or /^\d$/) { + my ($type, $cmd) = @{ $action{$_} || $action{digit} }; + if ($type==-2) { + $val{i} = 0 unless defined $val{i}; + } # modify value + if ($type>0 and defined $val{i}) { + unshift @stack, $val{i}; + %val = (i=>undef, frac=>0); + } # auto enter + $cmd->(); + showstack() if $type>=0; } # some operation + 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}; + $stack[0] *= delete($val{unit})->{val} / $_->{val}; + %val = (i=>undef, frac=>0); + } # convert + else { + $val{unit} = $_; + } # set source unit + }} # conversion + else { - print "\n* error: ", join(' ', map ord, split //, $_), "\n"; - } -} # input loop -} + attron(A_REVERSE); + addstr($height+1, 0, "* error: ".join(' ', map ord, split //, $_)." *"); + attroff(A_REVERSE); + clrtoeol; + refresh; -ReadMode 0; -endwin; + ReadKey; # wait for confirm + 1 while defined (ReadKey -1); # clear key buffer + goto DRAW; # screen messed up + } # error +} # input loop