3 # DCT - desktop calculator thingy
5 # reverse polish notition calculator using curses
8 # 1.01 06-18 - start (curses, some basic commands)
9 # 1.02 06-20 - function keys select command/submenu from (sub)menu
10 # - backspace to undo last digit
11 # 1.03 06-25 - values displayable in arbitrary base
12 # - can enter fractions (.) and negative values (_)
13 # 1.04 08-04 14:45 - error dialog (don't mess up screen)
14 # - manual command input using capital letters
16 # pre 09-09 22:00 - overhaul in stack handling
17 # 1.05 09-10 19:45 - hp48-like drop (backspace but not editing value)
18 # - error on insufficient arguments for command
19 # - command backspacing
20 # - some unit conversion (mostly lengths) from menu
21 # - q for sq(rt) (formerly quit, now only ^D/quit)
22 # 1.06 09-15 23:10 - menu contents in module
23 # - new commands: a?(sin|cos|tan)h, inv, !, rand
25 # 1.07 09-24 23:50 - numeric modifiers hardcoded instead of in action hash
26 # - action undo: last stack alteration can be undone
27 # - enter on no value repeats last val on stack
28 # - new commands: sr/sr, shortkeys ( )
29 # 1.08 09-26 22:10 - additional digits were not correctly applied to negative values
30 # - negative numbers displayed correctly in different bases
31 # - second undo redoes
33 # - stack command (cursor up) cycles through values in stack
34 # 09-27 00:57 - all key aliases moved to module DCT::Bindings
44 use DCT::Bindings 1.008;
47 ReadMode 3; # cbreak mode
51 } # restore terminal on quit
53 my %val = qw(i 0 frac 0); # i, frac
58 base => 10, # decimal; set using commands bin/oct/dec/hex/base
59 numb => 0, # fixed scientific engineering
60 card => 1, # degrees radians grades
61 coord => 0, # cartesian polar spherical
62 complex => 0, # real complex
64 height => $LINES<3 ? 4 : $LINES-3, # stack depth (lines of stack plus one)
65 width => $COLS || 42, # limit value precision, stetch menu
66 menushow => 12, # menu items to show simultaneously
69 #%alias = (' '=>'enter', "\004"=>'quit', 'q'=>'quit') unless %alias; # rudimentary defaults
71 my @menu = @{$menus[0]};
76 $menumin += $set{menushow};
77 $menumin = 0 if $menumin>=$#menu;
80 'chs' => [0, sub {$stack[0] = -$stack[0]}], # negative
82 'drop' => [0, sub {shift @stack}], # backspace
83 'clear'=> [0, sub {@stack = (); %val = (i=>undef, frac=>0) }], # clear all #todo: if (val{i}) delete char after cursor
86 unshift @stack, defined $val{i} ? $val{i} : $stack[0];
87 %val = (i=>undef, frac=>0);
90 # 'undo' => [0, sub {@stack = @{ $var{undo} }}], # undo
91 'undo' => [0, sub {($var{undo}, @stack) = ([@stack], @{ $var{undo} }) }], # undo
92 'swap' => [1, sub {@stack[0, 1] = @stack[1, 0]}], # swap x<->y
94 $var{stackpos} = 0 unless $var{stackpos}; # initialize
95 $var{stackpos} %= @stack; # cycle
96 $val{i} = $stack[$var{stackpos}++];
99 'version' => [0, sub{error("Desktop Calculator Thingy $VERSION by Shiar")}], # version
101 '=' => [1, sub {$var{a} = $stack[0]}], # copy
102 '?' => [1, sub {$var{a} = shift @stack}], # assign
104 '+' => [2, sub {$stack[1] += shift @stack}], # addition
105 '-' => [2, sub {$stack[1] -= shift @stack}], # substraction
106 '*' => [2, sub {$stack[1] *= shift @stack}], # multiplication
107 '/' => [2, sub {$stack[1] /= shift @stack}], # division
108 'mod' => [2, sub {$stack[1] %= shift @stack}], # modulo
110 'inv' => [1, sub {$stack[0] = 1 / $stack[0]}], # 1/x
111 'sqrt' => [1, sub {$stack[0] = sqrt $stack[0]}], # square root
112 'sq' => [1, sub {$stack[0] *= $stack[0]}], # squared
113 '^' => [2, sub {$stack[1] **= shift @stack}], # exponentiation
114 'xroot'=> [2, sub {$stack[1] **= 1 / shift @stack}], # x-root of y
116 'log' => [1, sub {$stack[0] = log($stack[0]) / log(10)}], # logarithm
117 'alog' => [1, sub {$stack[0] = 10 ** $stack[0]}], # 10^x
118 'ln' => [1, sub {$stack[0] = log $stack[0]}], # natural logaritm
119 'lnp1' => [1, sub {$stack[0] = log($stack[0]+1)}], # ln(x+1)
120 'exp' => [1, sub {$stack[0] = exp($stack[0])}], # e^x
121 'expm' => [1, sub {$stack[0] = exp($stack[0])-1}], # exp(x)-1
123 'sin' => [1, sub {$stack[0] = sin $stack[0]}], # sine
124 'asin' => [1, sub {$stack[0] = atan2($stack[0], sqrt(1 - $stack[0]*$stack[0]))}], # inverse sine
125 'cos' => [1, sub {$stack[0] = cos $stack[0]}], # cosine
126 'acos' => [1, sub {$stack[0] = atan2(sqrt(1 - $stack[0]*$stack[0]), $stack[0])}], # inverse cosine
127 'tan' => [1, sub {$stack[0] = sin($stack[0]) / cos($stack[0])}], # tangent
128 # 'atan' => [1, sub {}], # arctangent
130 'sinh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/2}], # hyperbolic sine
131 'cosh' => [1, sub {$stack[0] = ( exp($stack[0]) + exp(-$stack[0]) )/2}], # hyperbolic cosine
132 'tanh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/( exp($stack[0]) + exp(-$stack[0]) )}], # hyperbolic tangent (sinh/cosh)
133 'asinh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2+1)+$stack[0] )}], # inverse hyperbolic sine
134 'acosh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2-1)+$stack[0] )}], # inverse hyperbolic cosine
135 'atanh'=> [1, sub {$stack[0] = log( (1+$stack[0]) / (1-$stack[0]) )/2}], # inverse hyperbolic tangent
137 '%' => [2, sub {$stack[0] = shift(@stack)/$stack[0]}], # percentage
138 '%ch' => [2, sub {$val{i} = 100*(shift(@stack)-$val{i})/$val{i}}], # percentage change
139 '%t' => [2, sub {$val{i} = 100*$val{i}/shift(@stack)}], # percentage total
141 'and' => [2, sub {$stack[1] &= shift @stack}], # bitwise and
142 'or' => [2, sub {$stack[1] |= shift @stack}], # bitwise or
143 'xor' => [2, sub {$stack[1] ^= shift @stack}], # bitwise xor
144 'not' => [2, sub {$stack[0] = ~$stack[0]}], # bitwise not
145 'sl' => [1, sub {$stack[0] *= 2}], # shift left
146 'sr' => [1, sub {$stack[0] /= 2}], # shift right
148 'abs' => [1, sub {$stack[0] = abs $stack[0]}], # absolute #todo
149 'sign' => [1, sub {$stack[0] = $stack[0] <=> 0}], # sign
150 'ip' => [1, sub {$stack[0] = int $stack[0]}], # integer part
151 'fp' => [1, sub {$stack[0] -= int $stack[0]}], # fractional part
153 'rnd' => [1, sub {local $_ = 10**shift @stack; $val{i} = int(($val{i}+.5)*$_)/$_}], # round
154 'trnc' => [1, sub {local $_ = 10**shift @stack; $val{i} = int($val{i}*$_)/$_}], # truncate
155 'floor'=> [1, sub {$stack[0] = int $stack[0]}], # floor
156 'ceil' => [1, sub {$stack[0] = int $stack[0]+.9999}], # ceil
158 'min' => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_<$stack[0] }], # minimum
159 'max' => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_>$stack[0] }], # maximum
161 'dec' => [0, sub {$set{base} = 10}], # decimal
162 'bin' => [0, sub {$set{base} = 2}], # binary
163 'oct' => [0, sub {$set{base} = 8}], # octal
164 'hex' => [0, sub {$set{base} = 16}], # hexadecimal
165 'base' => [1, sub {$set{base} = shift @stack}], # alphanumerical
167 '!' => [1, sub {local $_ = $stack[0]; $stack[0] *= $_ while --$_>1}], # factor
168 'rand' => [0, sub {unshift @stack, rand}], # random value <1
174 $unit{$_->[0]} = { name=>$_->[0], type=>$i, val=>$_->[1] } for map {$i++; @$_} (
185 ['lyr', 9.46052840488e+15],
187 # _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
188 # _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
193 ['ft^3', .028316846592],
194 ['in^3', 1.6387064e-5],
197 } # create unit table
207 ReadKey; # wait for confirm
208 1 while defined (ReadKey -1); # clear key buffer
213 my ($val, $base) = @_;
214 return '' unless defined $val;
215 return $val if $base==10;
220 my $frac = $val-$int;
225 while ($int>$base**10) {
230 my $char = $int%$base;
231 $txt = ($char<10 ? $char : chr($char+55)).$txt;
235 $txt .= '.' if $frac>0;
236 for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
238 my $char = int $frac;
240 $txt .= $char<10 ? $char : chr($char+55);
243 $txt = "-".$txt if $sign;
244 $txt .= 'e'.showval($exp, $base) if $exp;
251 addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base}));
254 clrtoeol($set{height}-$#stack-1, 1);
258 clrtoeol($set{height}+2, 1);
260 for (grep exists $menu[$_], $menumin+1..$menumin+$set{menushow}) {
261 my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
262 addstr($set{height}+2, $set{width}/$set{menushow}*($nr++), $_);
267 } # display menu txts
275 addstr($set{height}+1, 0, "> "); # prompt
278 addstr($set{height}+1, 2, showval($val{i}, $set{base}));
279 addstr('_'.$val{unit}{name}) if exists $val{unit};
280 addstr($val{bla}) if exists $val{bla};
286 while (defined (my $key = ReadKey -1)) {
288 } # read additional keys
291 exists $alias{$_} and $_ = $alias{$_}; # command shortkeys
292 if (exists $falias{$_}) {
293 unless ($_ = $menu[$falias{$_}]) {
294 error("* no such menu entry *");
299 $_ = delete $val{bla} if exists $val{bla} and $_ eq 'enter';
304 elsif ($_ eq 'refresh') {
308 elsif (exists $val{bla} or /^[A-Z]$/) {
309 if (defined $val{i}) {
310 unshift @stack, $val{i};
311 %val = (i=>undef, frac=>0);
313 } # enter present value
315 $val{bla} = substr $val{bla}, 0, -1 or delete $val{bla};
323 $val{i} = 0 unless defined $val{i};
324 $_ = -$_ if $val{i}<0;
325 $val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_;
328 $val{i} = 0 unless defined $val{i};
331 elsif ($_ eq 'eex') {
332 $val{i} = 1 unless defined $val{i};
335 elsif ($_ eq 'chs' and defined $val{i}) {
338 elsif ($_ eq 'drop' and defined $val{i}) {
339 $val{i} = ($val{frac} = int $val{frac}/10)
340 ? int($val{i}*$val{frac})/$val{frac} : int $val{i}/10
343 elsif (exists $action{$_} or /^\d$/) {
344 my ($type, $cmd) = @{ $action{$_} };
345 if ($type>0 and defined $val{i}) {
346 unshift @stack, $val{i};
347 %val = (i=>undef, frac=>0);
349 if ($type>0 and $type>@stack) {
350 error("* insufficient stack arguments for operation *");
352 } # insufficient arguments
353 $var{undo} = [@stack] if $type>=0 and $_ ne 'undo';
355 showstack() if $type>=0;
359 @menu = @{ $menus[$1] };
364 elsif ($_ =~ /^_/) {{
365 $_ = $unit{substr $_, 1} or next;
366 if (exists $val{unit} and $val{unit}{type}==$_->{type}) {
367 unshift @stack, $val{i} if defined $val{i};
368 $stack[0] *= delete($val{unit})->{val} / $_->{val};
370 %val = (i=>undef, frac=>0);
378 error("* unrecognised command: ".join(' ', map ord, split //, $_)." *");
379 goto DRAW; # screen messed up