3 ### curses rpn desktop calculator ###
9 # 08-04 14:45 - error dialog (don't mess up screen)
10 # 09-10 19:45 - hp48-like drop (bs); argument checking; command backspacing
20 ReadMode 3; # cbreak mode
24 } # restore terminal on quit
26 my $height = $LINES<3 ? 4 : $LINES-3; # stack depth (lines of stack plus one)
27 my $width = $COLS || 42; # limit value precision, stetch menu
29 my %val = qw(i 0 frac 0); # i, frac
36 numb => 0, # fixed scientific engineering
37 card => 1, # degrees radians grades
38 coord => 0, # cartesian polar spherical
39 complex => 0, # real complex
44 [qw(refresh math>8 prog> mode>7 unit>11)],
45 [qw(main>0 log alog ln exp sin cos tan 0 asin acos atan)], #1 math
46 [qw(main>0 dec bin oct hex logic>3 bit>4)], #2 base
47 [qw(base>2 and or xor not)], #3 base logic
48 [qw(base>2 rl sl asr sr rr)], #4 base bit
49 [qw(base>2 rlb slb srb rrb)], #5 base byte
50 [qw(main>0 sq sqrt ^ xroot)], #6
51 [qw(main>0 number_format angle_measure coord_system)], #7 mode
53 vector> matrix> list> hyperbolic>9 real>10 base>2
54 probability> fft> complex> constants>
57 sinh cosh tanh asinh acosh atanh
59 )], #9 math hyperbolic
62 abs sign mant xpon ip fp
63 rnd trnc floor ceil r>d d>r
66 tools> length>12 area>13 volume>14 time>15 speed>16
67 mass>17 force>18 energy>19 power>20 pressure>21 temperature>22
68 electric_current>23 angle>24 light>25 radiation>26 viscosity>27
70 # mm cm m in ft yd km mile mmile lt-yr mil Ang fermi rod fath)],
72 _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
73 _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
76 _m^2 _cm^2 _b _yd^2 _ft^2 _in^2
77 _km^2 _ha _a _mi^2 _miUS^2 _acre
80 _m^3 _st _cm^3 _yd^3 _ft^3 _in^3
81 _l _galUK _galC _gal _qt _pt
82 _ml _cu _ozfl _ozUK _tbsp _tsp
89 _m/s _cm/s _ft/s _kph _mph _knot
93 _kg _g _Lb _oz _slug _lbt
94 _ton _tonUS _t _ozt _ct _grain
98 _N _dyn _gf _kip _lbf _pdl
101 _J _erg _Kcal _Cal _Btu _ftxlbf
108 _Pa _atm _bar _psi _torr _mmHg
114 )], #23 electric_current
127 @menu = @{$menus[0]};
132 "\033\117\120" => 1, # f1
133 "\033\133\061\061\176" => 1, # f1
134 "\033\133\061\062\176" => 2, # f2
135 "\033\133\061\063\176" => 3, # f3
136 "\033\133\061\064\176" => 4, # f4
137 "\033\117\121" => 2, # f2
138 "\033\117\122" => 3, # f3
139 "\033\117\123" => 4, # f4
140 "\033\133\061\065\176" => 5, # f5
141 "\033\133\061\067\176" => 6, # f6
142 "\033\133\061\070\176" => 7, # f7
143 "\033\133\061\071\176" => 8, # f8
144 "\033\133\062\060\176" => 9, # f9
145 "\033\133\062\061\176" => 10, # f10
146 "\033\133\062\063\176" => 11, # f11/F1
147 "\033\133\062\064\176" => 12, # f12/F2
148 "\033\133\062\065\176" => 13, # F3
149 "\033\133\062\066\176" => 14, # F4
150 "\033\133\062\070\176" => 15, # F5
151 "\033\133\062\071\176" => 16, # F6
152 "\033\133\063\061\176" => 17, # F7
153 "\033\133\063\062\176" => 18, # F8
154 "\033\133\063\063\176" => 19, # F9
155 "\033\133\063\064\176" => 20, # F10
156 "\033\133\062\063\073\062\176" => 21, # F11
157 "\033\133\062\064\073\062\176" => 22, # F12
161 chr 4 => 'quit', # ^D
162 chr 9 => 'more', # tab
163 '_' => 'chs', # change sign; 48: y
164 'e' => 'eex', # exponent; 48: z
165 # "\033\133\062\176" => 'swap', # ins
166 "\033\133\063\176" => "clear", # del
167 chr 127 => 'drop', # backspace
168 chr 8 => 'drop', # backspace
169 chr 13 => 'enter', # enter
170 ' ' => 'enter', # space
171 "\014" => 'refresh', # ^L
172 # "\033\133\110" => 'refresh', # home
174 # "\033\133\101" => '', # up; 48: k (stack)
175 # "\033\133\104" => '', # left; 48: p (picture)
176 # "\033\133\102" => '', # down; 48: q (view)
177 "\033\133\103" => 'swap', # right; 48: r (swap)
202 - sin cos tan sqrt ^ 1/x
203 < asin acos atan sq alog exp
204 > [a] ∫ ∑ xroot log ln
209 $menumin += $set{menushow};
210 $menumin = 0 if $menumin>=$#menu;
213 'digit'=> [-2, sub { $val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_ }],
214 '.' => [-2, sub { $val{frac} = 1 }], # decimal point
215 'eex' => [-2, sub {}], # exponent
217 if (defined $val{i}) {
220 $stack[0] = -$stack[0];
225 if (defined $val{i}) {
226 $val{i} = ($val{frac} = int $val{frac}/10)
227 ? int($val{i}*$val{frac})/$val{frac} : int $val{i}/10
233 #todo: if (val{i}) delete char after cursor
234 @stack = (); %val = (i=>undef, frac=>0)
238 unshift @stack, $val{i};
239 %val = (i=>undef, frac=>0);
242 'swap' => [1, sub {@stack[0, 1] = @stack[1, 0]}], # swap x<->y
244 '=' => [1, sub {$var{a} = $stack[0]}], # copy
245 '>' => [1, sub {$var{a} = shift @stack}], # assign
247 '+' => [2, sub {$stack[1] += shift @stack}], # addition
248 '-' => [2, sub {$stack[1] -= shift @stack}], # substraction
249 '*' => [2, sub {$stack[1] *= shift @stack}], # multiplication
250 '/' => [2, sub {$stack[1] /= shift @stack}], # division
251 'mod' => [2, sub {$stack[1] %= shift @stack}], # modulo
253 'sqrt' => [1, sub {$stack[0] = sqrt $stack[0]}], # square root
254 'sq' => [1, sub {$stack[0] *= $stack[0]}], # squared
255 '^' => [2, sub {$stack[1] **= shift @stack}], # exponentiation
256 'xroot'=> [2, sub {$stack[1] **= 1 / shift @stack}], # x-root of y
258 'log' => [1, sub {$stack[0] = log($stack[0]) / log(10)}], # logarithm
259 'alog' => [1, sub {$stack[0] = 10 ** $stack[0]}], # 10^x
260 'ln' => [1, sub {$stack[0] = log $stack[0]}], # natural logaritm
261 'lnp1' => [1, sub {$stack[0] = log($stack[0]+1)}], # ln(x+1)
262 'exp' => [1, sub {$stack[0] = exp($stack[0])}], # e^x
263 'expm' => [1, sub {$stack[0] = exp($stack[0])-1}], # exp(x)-1
265 'sin' => [1, sub {$stack[0] = sin $stack[0]}], # sine
266 'asin' => [1, sub {$stack[0] = atan2($stack[0], sqrt(1 - $stack[0]*$stack[0]))}], # inverse sine
267 'cos' => [1, sub {$stack[0] = cos $stack[0]}], # cosine
268 'acos' => [1, sub {$stack[0] = atan2(sqrt(1 - $stack[0]*$stack[0]), $stack[0])}], # inverse cosine
269 'tan' => [1, sub {$stack[0] = sin($stack[0]) / cos($stack[0])}], # tangent
270 # 'atan' => [1, sub {}], # arctangent
272 '%' => [2, sub {$stack[0] /= shift @stack}], # percentage
273 '%ch' => [2, sub {$val{i} = 100*(shift(@stack)-$val{i})/$val{i}}], # percentage change
274 '%t' => [2, sub {$val{i} = 100*$val{i}/shift(@stack)}], # percentage total
276 'and' => [2, sub {$stack[1] &= shift @stack}], # bitwise and
277 'or' => [2, sub {$stack[1] |= shift @stack}], # bitwise or
278 'xor' => [2, sub {$stack[1] ^= shift @stack}], # bitwise xor
279 'not' => [2, sub {$stack[0] = ~$stack[0]}], # bitwise not
281 'abs' => [1, sub {$stack[0] = abs $stack[0]}], # absolute #todo
282 'sign' => [1, sub {$stack[0] = $stack[0] <=> 0}], # sign
283 'ip' => [1, sub {$stack[0] = int $stack[0]}], # integer part
284 'fp' => [1, sub {$stack[0] -= int $stack[0]}], # fractional part
286 'rnd' => [1, sub {local $_ = 10**shift @stack; $val{i} = int(($val{i}+.5)*$_)/$_}], # round
287 'trnc' => [1, sub {local $_ = 10**shift @stack; $val{i} = int($val{i}*$_)/$_}], # truncate
288 'floor'=> [1, sub {$stack[0] = int $stack[0]}], # floor
289 'ceil' => [1, sub {$stack[0] = int $stack[0]+.9999}], # ceil
292 local $_ = shift @stack;
293 $stack[0] = $_ if $_<$stack[0];
296 local $_ = shift @stack;
297 $stack[0] = $_ if $_>$stack[0];
300 'dec' => [0, sub {$set{base} = 10}], # decimal
301 'bin' => [0, sub {$set{base} = 2}], # binary
302 'oct' => [0, sub {$set{base} = 8}], # octal
303 'hex' => [0, sub {$set{base} = 16}], # hexadecimal
304 'base' => [1, sub {$set{base} = shift @stack}], # alphanumerical
310 $unit{$_->[0]} = { name=>$_->[0], type=>$i, val=>$_->[1] } for map {$i++; @$_} (
321 ['lyr', 9.46052840488e+15],
323 # _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
324 # _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
329 ['ft^3', .028316846592],
330 ['in^3', 1.6387064e-5],
333 } # create unit table
343 ReadKey; # wait for confirm
344 1 while defined (ReadKey -1); # clear key buffer
349 my ($val, $base) = @_;
350 return '' unless defined $val;
351 return $val if $base==10;
354 my $frac = $val-$int;
358 while ($int>$base**10) {
363 my $char = $int%$base;
364 $txt = ($char<10 ? $char : chr($char+55)).$txt;
368 $txt .= '.' if $frac>0;
369 for (my $i = 0; length $txt<$width-2 && $frac>0; $i++) {
371 my $char = int $frac;
373 $txt .= $char<10 ? $char : chr($char+55);
376 $txt .= 'e'.showval($exp, $base) if $exp;
383 addstr($height-$_, 1, "$_: ".showval($stack[$_], $set{base}));
386 clrtoeol($height-$#stack-1, 1);
390 clrtoeol($height+2, 1);
392 for (grep exists $menu[$_], $menumin+1..$menumin+$set{menushow}) {
393 my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
394 addstr($height+2, $width/$set{menushow}*($nr++), $_);
399 } # display menu txts
407 addstr($height+1, 0, "> "); # prompt
410 addstr($height+1, 2, showval($val{i}, $set{base}));
411 addstr('_'.$val{unit}{name}) if exists $val{unit};
412 addstr($val{bla}) if exists $val{bla};
418 while (defined (my $key = ReadKey -1)) {
420 } # read additional keys
423 exists $alias{$_} and $_ = $alias{$_}; # command shortkeys
424 if (exists $falias{$_}) {
425 unless ($_ = $menu[$falias{$_}]) {
426 error("* no such menu entry *");
431 $_ = delete $val{bla} if exists $val{bla} and $_ eq 'enter';
436 elsif ($_ eq 'refresh') {
440 elsif (exists $val{bla} or /^[A-Z]$/) {
441 if (defined $val{i}) {
442 unshift @stack, $val{i};
443 %val = (i=>undef, frac=>0);
445 } # enter present value
447 $val{bla} = substr $val{bla}, 0, -1;
454 elsif (exists $action{$_} or /^\d$/) {
455 my ($type, $cmd) = @{ $action{$_} || $action{digit} };
457 $val{i} = 0 unless defined $val{i};
459 if ($type>0 and defined $val{i}) {
460 unshift @stack, $val{i};
461 %val = (i=>undef, frac=>0);
463 if ($type>0 and $type>@stack) {
464 error("* insufficient stack arguments for operation *");
466 } # insufficient arguments
468 showstack() if $type>=0;
472 @menu = @{ $menus[$1] };
477 elsif ($_ =~ /^_/) {{
478 $_ = $unit{substr $_, 1} or next;
479 if (exists $val{unit} and $val{unit}{type}==$_->{type}) {
480 unshift @stack, $val{i} if defined $val{i};
481 $stack[0] *= delete($val{unit})->{val} / $_->{val};
483 %val = (i=>undef, frac=>0);
491 error("* error: ".join(' ', map ord, split //, $_)." *");
492 goto DRAW; # screen messed up