dct.pl

   1 #!/usr/bin/perl
   2
   3 # DCT - desktop calculator thingy
   4
   5 # reverse polish notition calculator using curses
   6 # by Shiar <shiar.org>
   7
   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
  15 #                  - ^L redraws screen
  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
  24 #                  - x and v shortkeys
  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
  32 #                  - fixed %
  33 #                  - stack command (cursor up) cycles through values in stack
  34 #      09-27 00:57 - all key aliases moved to module DCT::Bindings
  35 our $VERSION = 1.008;
  36
  37 use strict;
  38 use warnings;
  39 use utf8;
  40
  41 use Term::ReadKey;
  42 use Curses;
  43 use DCT::Menu 1.006;
  44 use DCT::Bindings 1.008;
  45
  46 initscr;
  47 ReadMode 3;  # cbreak mode
  48 END {
  49         ReadMode 0;
  50         endwin;
  51 } # restore terminal on quit
  52
  53 my %val = qw(i 0  frac 0);  # i, frac
  54 my @stack;
  55 my %var;
  56
  57 my %set = (
  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
  63
  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
  67 ); # %set
  68
  69 #%alias = (' '=>'enter', "\004"=>'quit', 'q'=>'quit') unless %alias;  # rudimentary defaults
  70
  71 my @menu = @{$menus[0]};
  72 my $menumin = 0;
  73
  74 my %action = (
  75         'more' => [-1, sub {
  76                 $menumin += $set{menushow};
  77                 $menumin = 0 if $menumin>=$#menu;
  78                 showmenu();
  79         }], # tab
  80         'chs'  => [0, sub {$stack[0] = -$stack[0]}], # negative
  81
  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
  84
  85         'enter'=> [0, sub {
  86                 unshift @stack, defined $val{i} ? $val{i} : $stack[0];
  87                 %val = (i=>undef, frac=>0);
  88         }], # duplication
  89
  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
  93         'stack'=> [0, sub {
  94                 $var{stackpos} = 0 unless $var{stackpos};  # initialize
  95                 $var{stackpos} %= @stack;  # cycle
  96                 $val{i} = $stack[$var{stackpos}++];
  97         }], # stack
  98
  99         'version' => [0, sub{error("Desktop Calculator Thingy $VERSION by Shiar")}], # version
 100
 101         '='    => [1, sub {$var{a} = $stack[0]}], # copy
 102         '?'    => [1, sub {$var{a} = shift @stack}], # assign
 103
 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
 109
 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
 115
 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
 122
 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
 129
 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
 136
 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
 140
 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
 147
 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
 152
 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
 157
 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
 160
 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
 166
 167         '!'    => [1, sub {local $_ = $stack[0]; $stack[0] *= $_ while --$_>1}], # factor
 168         'rand' => [0, sub {unshift @stack, rand}], # random value <1
 169 ); # %action
 170
 171 my %unit;
 172 {
 173 my $i = 0;
 174 $unit{$_->[0]} = { name=>$_->[0], type=>$i, val=>$_->[1] } for map {$i++; @$_} (
 175         [
 176                 ['m', 1],
 177                 ['cm', .01],
 178                 ['mm', .001],
 179                 ['km', 1000],
 180                 ['ft', .3048],
 181                 ['in', .0254],
 182                 ['yd', .9144],
 183                 ['mile', 1609.344],
 184                 ['nmile', 1852],
 185                 ['lyr', 9.46052840488e+15],
 186                 ['mil', 2.54e-5],
 187         #               _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
 188         #               _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
 189         ], # lengths
 190         [
 191                 ['m^3', 1],
 192                 ['cm^3', 1e-6],
 193                 ['ft^3', .028316846592],
 194                 ['in^3', 1.6387064e-5],
 195         ], # volume
 196 );
 197 } # create unit table
 198
 199
 200 sub error($) {
 201         attron(A_REVERSE);
 202         addstr(0, 0, shift);
 203         attroff(A_REVERSE);
 204         clrtoeol;
 205         refresh;
 206
 207         ReadKey; # wait for confirm
 208         1 while defined (ReadKey -1); # clear key buffer
 209 } # error
 210
 211 sub showval($$);
 212 sub showval($$) {
 213         my ($val, $base) = @_;
 214         return '' unless defined $val;
 215         return $val if $base==10;
 216
 217         my $sign = $val<0;
 218         $val = abs $val;
 219         my $int = int $val;
 220         my $frac = $val-$int;
 221         my $exp = 0;
 222
 223         my $txt = '';
 224
 225         while ($int>$base**10) {
 226                 $int /= $base;
 227                 $exp++;
 228         } # exponent part
 229         while ($int>=1) {
 230                 my $char = $int%$base;
 231                 $txt = ($char<10 ? $char : chr($char+55)).$txt;
 232                 $int /= $base;
 233         } # integer part
 234
 235         $txt .= '.' if $frac>0;
 236         for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
 237                 $frac *= $base;
 238                 my $char = int $frac;
 239                 $frac -= $char;
 240                 $txt .= $char<10 ? $char : chr($char+55);
 241         } # fraction part
 242
 243         $txt = "-".$txt if $sign;
 244         $txt .= 'e'.showval($exp, $base) if $exp;
 245
 246         return $txt;
 247 } # showval
 248
 249 sub showstack() {
 250         for (0..@stack-1) {
 251                 addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base}));
 252                 clrtoeol;
 253         } # show stack
 254         clrtoeol($set{height}-$#stack-1, 1);
 255 } # showstack
 256
 257 sub showmenu() {
 258         clrtoeol($set{height}+2, 1);
 259         my $nr = 0;
 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++), $_);
 263                 attron(A_REVERSE);
 264                 addstr($s);
 265                 attroff(A_REVERSE);
 266                 addch('>') if $sub;
 267         } # display menu txts
 268 } # showmenu
 269
 270
 271 DRAW:
 272 clear;
 273 showmenu();
 274 showstack();
 275 addstr($set{height}+1, 0, "> ");  # prompt
 276
 277 while (1) {
 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};
 281         clrtoeol;
 282         refresh;
 283
 284         $_ = ReadKey;
 285         if ($_ eq chr 27) {
 286                 while (defined (my $key = ReadKey -1)) {
 287                         $_ .= $key;
 288                 } # read additional keys
 289         } # escape sequence
 290
 291         exists $alias{$_}  and $_ = $alias{$_};  # command shortkeys
 292         if (exists $falias{$_}) {
 293                 unless ($_ = $menu[$falias{$_}]) {
 294                         error("* no such menu entry *");
 295                         goto DRAW;
 296                 }
 297         } # function key
 298
 299         $_ = delete $val{bla} if exists $val{bla} and $_ eq 'enter';
 300
 301         if ($_ eq 'quit') {
 302                 last;
 303         } # quit
 304         elsif ($_ eq 'refresh') {
 305                 goto DRAW;
 306         } # refresh
 307
 308         elsif (exists $val{bla} or /^[A-Z]$/) {
 309                 if (defined $val{i}) {
 310                         unshift @stack, $val{i};
 311                         %val = (i=>undef, frac=>0);
 312                         showstack();
 313                 } # enter present value
 314                 if ($_ eq "drop") {
 315                         $val{bla} = substr $val{bla}, 0, -1 or delete $val{bla};
 316                 } # backspace
 317                 else {
 318                         $val{bla} .= lc $_;
 319                 } # add character
 320         } # manual command
 321
 322         elsif (/^\d$/) {
 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+$_;
 326         }
 327         elsif ($_ eq '.') {
 328                 $val{i} = 0 unless defined $val{i};
 329                 $val{frac} = 1;
 330         } # decimal point
 331         elsif ($_ eq 'eex') {
 332                 $val{i} = 1 unless defined $val{i};
 333                 #todo
 334         } # exponent
 335         elsif ($_ eq 'chs' and defined $val{i}) {
 336                 $val{i} = -$val{i};
 337         } # change sign
 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
 341         } # backspace
 342
 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);
 348                 } # auto enter
 349                 if ($type>0 and $type>@stack) {
 350                         error("* insufficient stack arguments for operation *");
 351                         goto DRAW;
 352                 } # insufficient arguments
 353                 $var{undo} = [@stack] if $type>=0 and $_ ne 'undo';
 354                 $cmd->();
 355                 showstack() if $type>=0;
 356         } # some operation
 357
 358         elsif (/>(\d+)$/) {
 359                 @menu = @{ $menus[$1] };
 360                 $menumin = 0;
 361                 showmenu();
 362         } # submenu
 363
 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};
 369                         showstack();
 370                         %val = (i=>undef, frac=>0);
 371                 } # convert
 372                 else {
 373                         $val{unit} = $_;
 374                 } # set source unit
 375         }} # conversion
 376
 377         else {
 378                 error("* unrecognised command: ".join(' ', map ord, split //, $_)." *");
 379                 goto DRAW; # screen messed up
 380         } # error
 381 } # input loop
 382