#!/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)
-# 09-10 19:45 - hp48-like drop (bs); argument checking; command backspacing
+# 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;
use Term::ReadKey;
use Curses;
+use SDC::Menu 1.006;
initscr;
ReadMode 3; # cbreak mode
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;
chr 9 => 'more', # tab
'_' => 'chs', # change sign; 48: y
'e' => 'eex', # exponent; 48: z
-# "\033\133\062\176" => 'swap', # ins
+ "\033\133\062\176" => 'eex', # ins
"\033\133\063\176" => "clear", # del
chr 127 => 'drop', # backspace
chr 8 => 'drop', # backspace
# "\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)
'|' => 'or',
'#' => 'xor',
'~' => 'not',
-
- "s" => 'sin',
- "\033s" => 'asin',
- "c" => 'cos',
- "\033c" => 'acos',
- "t" => 'tan',
- "\033t" => 'atan',
- "l" => 'log',
- "\033l" => 'alog',
- "n" => 'ln',
- "\033n" => 'exp',
- "q" => 'sq',
- "\033q" => 'sqrt',
- "\033^" => '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
=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
+ '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, $val{i};
+ 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
'/' => [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
'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
'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
'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
'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;
showstack();
} # enter present value
if ($_ eq "drop") {
- $val{bla} = substr $val{bla}, 0, -1;
+ $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);
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
git.shiar.nl / descalc.git / commitdiff