sdc.pl

   1 #!/usr/bin/perl
   2
   3 ### SDC - small desktop calculator ###
   4 # reverse polish notition calculator using curses
   5 # by Shiar <shiar.org>
   6
   7 # 1.01 06-18       - start
   8 # 1.03 06-25       -
   9 # 1.04 08-04 14:45 - error dialog (don't mess up screen)
  10 # 1.05 09-10 19:45 - hp48-like drop (backspace but not editing value)
  11 #                  - argument checking
  12 #                  - command backspacing
  13 # 1.06 09-15 23:10 - menu contents in module
  14 #                  - new commands: a?(sin|cos|tan)h, inv, !, rand
  15 #                  - x and v shortkeys
  16 # 1.07 09-24 23:50 - numeric modifiers hardcoded instead of in action hash
  17 #                  - action undo: last stack alteration can be undone
  18 #                  - enter on no value repeats last val on stack
  19 #                  - new commands: sr/sr, shortkeys ( )
  20
  21 use strict;
  22 use warnings;
  23 use utf8;
  24
  25 use Term::ReadKey;
  26 use Curses;
  27 use SDC::Menu 1.006;
  28
  29 initscr;
  30 ReadMode 3;  # cbreak mode
  31 END {
  32         ReadMode 0;
  33         endwin;
  34 } # restore terminal on quit
  35
  36 my $height = $LINES<3 ? 4 : $LINES-3;  # stack depth (lines of stack plus one)
  37 my $width = $COLS || 42;  # limit value precision, stetch menu
  38
  39 my %val = qw(i 0  frac 0);  # i, frac
  40 my @stack;
  41 my %var;
  42 my @menu;
  43 my $menumin;
  44 my %set = (
  45         base     => 10,
  46         numb     =>  0,  # fixed scientific engineering
  47         card     =>  1,  # degrees radians grades
  48         coord    =>  0,  # cartesian polar spherical
  49         complex  =>  0,  # real complex
  50         menushow => 12,
  51 ); # %set
  52
  53 @menu = @{$menus[0]};
  54 $menumin = 0;
  55
  56 my %falias = (
  57         "\033"                         =>  0, # esc
  58         "\033\117\120"                 =>  1, # f1
  59         "\033\133\061\061\176"         =>  1, # f1
  60         "\033\133\061\062\176"         =>  2, # f2
  61         "\033\133\061\063\176"         =>  3, # f3
  62         "\033\133\061\064\176"         =>  4, # f4
  63         "\033\117\121"                 =>  2, # f2
  64         "\033\117\122"                 =>  3, # f3
  65         "\033\117\123"                 =>  4, # f4
  66         "\033\133\061\065\176"         =>  5, # f5
  67         "\033\133\061\067\176"         =>  6, # f6
  68         "\033\133\061\070\176"         =>  7, # f7
  69         "\033\133\061\071\176"         =>  8, # f8
  70         "\033\133\062\060\176"         =>  9, # f9
  71         "\033\133\062\061\176"         => 10, # f10
  72         "\033\133\062\063\176"         => 11, # f11/F1
  73         "\033\133\062\064\176"         => 12, # f12/F2
  74         "\033\133\062\065\176"         => 13, # F3
  75         "\033\133\062\066\176"         => 14, # F4
  76         "\033\133\062\070\176"         => 15, # F5
  77         "\033\133\062\071\176"         => 16, # F6
  78         "\033\133\063\061\176"         => 17, # F7
  79         "\033\133\063\062\176"         => 18, # F8
  80         "\033\133\063\063\176"         => 19, # F9
  81         "\033\133\063\064\176"         => 20, # F10
  82         "\033\133\062\063\073\062\176" => 21, # F11
  83         "\033\133\062\064\073\062\176" => 22, # F12
  84 ); # %falias
  85
  86 my %alias = (
  87         chr 4 => 'quit', # ^D
  88         chr 9 => 'more', # tab
  89         '_'   => 'chs', # change sign; 48: y
  90         'e'   => 'eex', # exponent; 48: z
  91         "\033\133\062\176" => 'eex', # ins
  92         "\033\133\063\176" => "clear", # del
  93         chr 127 => 'drop', # backspace
  94         chr 8   => 'drop', # backspace
  95         chr 13  => 'enter', # enter
  96         ' '     => 'enter', # space
  97         "\014"  => 'refresh', # ^L
  98 #       "\033\133\110" => 'refresh', # home
  99
 100 #       "\033\133\101" => '', # up; 48: k (stack)
 101         "\033\133\104" => 'undo', # left; 48: p (picture)
 102 #       "\033\133\102" => '', # down; 48: q (view)
 103         "\033\133\103" => 'swap', # right; 48: r (swap)
 104
 105         '&' => 'and',
 106         '|' => 'or',
 107         '#' => 'xor',
 108         '~' => 'not',
 109         '(' => 'sl',
 110         ')' => 'sr',
 111
 112             "s" => "sin",
 113         "\033s" => "asin",
 114             "c" => "cos",
 115         "\033c" => "acos",
 116             "t" => "tan",
 117         "\033t" => "atan",
 118             "l" => "log",
 119         "\033l" => "alog",
 120             "n" => "ln",
 121         "\033n" => "exp",
 122             "q" => "sq",
 123         "\033q" => "sqrt",
 124             "x" => "^",
 125         "\033x" => "xroot",
 126         "\033^" => "xroot",
 127             "v" => "inv",
 128 ); # %alias
 129
 130 =cut
 131 HP48 keys:
 132     S     T     U      V     W     X
 133  -  sin   cos   tan    sqrt  ^     1/x
 134  <  asin  acos  atan   sq    alog  exp
 135  >  [a]   ∫     ∑      xroot log   ln
 136 =cut
 137
 138 my %action = (
 139         'more' => [-1, sub {
 140                 $menumin += $set{menushow};
 141                 $menumin = 0 if $menumin>=$#menu;
 142                 showmenu();
 143         }], # tab
 144         'chs'  => [0, sub {$stack[0] = -$stack[0]}], # negative
 145
 146         'drop' => [0, sub {shift @stack}], # backspace
 147         'clear'=> [0, sub {@stack = (); %val = (i=>undef, frac=>0) }], # clear all #todo: if (val{i}) delete char after cursor
 148
 149         'enter'=> [0, sub {
 150                 unshift @stack, defined $val{i} ? $val{i} : $stack[0];
 151                 %val = (i=>undef, frac=>0);
 152         }], # duplication
 153
 154         'swap' => [1, sub {@stack[0, 1] = @stack[1, 0]}], # swap x<->y
 155
 156         '='    => [1, sub {$var{a} = $stack[0]}], # copy
 157         '?'    => [1, sub {$var{a} = shift @stack}], # assign
 158
 159         '+'    => [2, sub {$stack[1] += shift @stack}], # addition
 160         '-'    => [2, sub {$stack[1] -= shift @stack}], # substraction
 161         '*'    => [2, sub {$stack[1] *= shift @stack}], # multiplication
 162         '/'    => [2, sub {$stack[1] /= shift @stack}], # division
 163         'mod'  => [2, sub {$stack[1] %= shift @stack}], # modulo
 164
 165         'inv'  => [1, sub {$stack[0] = 1 / $stack[0]}], # 1/x
 166         'sqrt' => [1, sub {$stack[0] = sqrt $stack[0]}], # square root
 167         'sq'   => [1, sub {$stack[0] *= $stack[0]}], # squared
 168         '^'    => [2, sub {$stack[1] **= shift @stack}], # exponentiation
 169         'xroot'=> [2, sub {$stack[1] **= 1 / shift @stack}], # x-root of y
 170
 171         'log'  => [1, sub {$stack[0] = log($stack[0]) / log(10)}], # logarithm
 172         'alog' => [1, sub {$stack[0] = 10 ** $stack[0]}], # 10^x
 173         'ln'   => [1, sub {$stack[0] = log $stack[0]}], # natural logaritm
 174         'lnp1' => [1, sub {$stack[0] = log($stack[0]+1)}], # ln(x+1)
 175         'exp'  => [1, sub {$stack[0] = exp($stack[0])}], # e^x
 176         'expm' => [1, sub {$stack[0] = exp($stack[0])-1}], # exp(x)-1
 177
 178         'sin'  => [1, sub {$stack[0] = sin $stack[0]}], # sine
 179         'asin' => [1, sub {$stack[0] = atan2($stack[0], sqrt(1 - $stack[0]*$stack[0]))}], # inverse sine
 180         'cos'  => [1, sub {$stack[0] = cos $stack[0]}], # cosine
 181         'acos' => [1, sub {$stack[0] = atan2(sqrt(1 - $stack[0]*$stack[0]), $stack[0])}], # inverse cosine
 182         'tan'  => [1, sub {$stack[0] = sin($stack[0]) / cos($stack[0])}], # tangent
 183 #       'atan' => [1, sub {}], # arctangent
 184
 185         'sinh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/2}], # hyperbolic sine
 186         'cosh' => [1, sub {$stack[0] = ( exp($stack[0]) + exp(-$stack[0]) )/2}], # hyperbolic cosine
 187         'tanh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/( exp($stack[0]) + exp(-$stack[0]) )}], # hyperbolic tangent (sinh/cosh)
 188         'asinh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2+1)+$stack[0] )}], # inverse hyperbolic sine
 189         'acosh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2-1)+$stack[0] )}], # inverse hyperbolic cosine
 190         'atanh'=> [1, sub {$stack[0] = log( (1+$stack[0]) / (1-$stack[0]) )/2}], # inverse hyperbolic tangent
 191
 192         '%'    => [2, sub {$stack[0] /= shift @stack}], # percentage
 193         '%ch'  => [2, sub {$val{i} = 100*(shift(@stack)-$val{i})/$val{i}}], # percentage change
 194         '%t'   => [2, sub {$val{i} = 100*$val{i}/shift(@stack)}], # percentage total
 195
 196         'and'  => [2, sub {$stack[1] &= shift @stack}], # bitwise and
 197         'or'   => [2, sub {$stack[1] |= shift @stack}], # bitwise or
 198         'xor'  => [2, sub {$stack[1] ^= shift @stack}], # bitwise xor
 199         'not'  => [2, sub {$stack[0] = ~$stack[0]}], # bitwise not
 200         'sl'   => [1, sub {$stack[0] *= 2}], # shift left
 201         'sr'   => [1, sub {$stack[0] /= 2}], # shift right
 202
 203         'abs'  => [1, sub {$stack[0] = abs $stack[0]}], # absolute #todo
 204         'sign' => [1, sub {$stack[0] = $stack[0] <=> 0}], # sign
 205         'ip'   => [1, sub {$stack[0] = int $stack[0]}], # integer part
 206         'fp'   => [1, sub {$stack[0] -= int $stack[0]}], # fractional part
 207
 208         'rnd'  => [1, sub {local $_ = 10**shift @stack; $val{i} = int(($val{i}+.5)*$_)/$_}], # round
 209         'trnc' => [1, sub {local $_ = 10**shift @stack; $val{i} = int($val{i}*$_)/$_}], # truncate
 210         'floor'=> [1, sub {$stack[0] = int $stack[0]}], # floor
 211         'ceil' => [1, sub {$stack[0] = int $stack[0]+.9999}], # ceil
 212
 213         'min'  => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_<$stack[0] }], # minimum
 214         'max'  => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_>$stack[0] }], # maximum
 215
 216         'dec'  => [0, sub {$set{base} = 10}], # decimal
 217         'bin'  => [0, sub {$set{base} = 2}], # binary
 218         'oct'  => [0, sub {$set{base} = 8}], # octal
 219         'hex'  => [0, sub {$set{base} = 16}], # hexadecimal
 220         'base' => [1, sub {$set{base} = shift @stack}], # alphanumerical
 221
 222         '!'    => [1, sub {local $_ = $stack[0]; $stack[0] *= $_ while --$_>1}], # factor
 223         'rand' => [0, sub {unshift @stack, rand}], # random value <1
 224
 225         'undo' => [0, sub {@stack = @{ $var{undo} }}], # undo
 226 ); # %action
 227
 228 my %unit;
 229 {
 230 my $i = 0;
 231 $unit{$_->[0]} = { name=>$_->[0], type=>$i, val=>$_->[1] } for map {$i++; @$_} (
 232         [
 233                 ['m', 1],
 234                 ['cm', .01],
 235                 ['mm', .001],
 236                 ['km', 1000],
 237                 ['ft', .3048],
 238                 ['in', .0254],
 239                 ['yd', .9144],
 240                 ['mile', 1609.344],
 241                 ['nmile', 1852],
 242                 ['lyr', 9.46052840488e+15],
 243                 ['mil', 2.54e-5],
 244         #               _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
 245         #               _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
 246         ], # lengths
 247         [
 248                 ['m^3', 1],
 249                 ['cm^3', 1e-6],
 250                 ['ft^3', .028316846592],
 251                 ['in^3', 1.6387064e-5],
 252         ], # volume
 253 );
 254 } # create unit table
 255
 256
 257 sub error($) {
 258         attron(A_REVERSE);
 259         addstr(0, 0, shift);
 260         attroff(A_REVERSE);
 261         clrtoeol;
 262         refresh;
 263
 264         ReadKey; # wait for confirm
 265         1 while defined (ReadKey -1); # clear key buffer
 266 } # error
 267
 268 sub showval($$);
 269 sub showval($$) {
 270         my ($val, $base) = @_;
 271         return '' unless defined $val;
 272         return $val if $base==10;
 273
 274         my $int = int $val;
 275         my $frac = $val-$int;
 276         my $exp = 0;
 277
 278         my $txt = '';
 279         while ($int>$base**10) {
 280                 $int /= $base;
 281                 $exp++;
 282         } # exponent part
 283         while ($int>=1) {
 284                 my $char = $int%$base;
 285                 $txt = ($char<10 ? $char : chr($char+55)).$txt;
 286                 $int /= $base;
 287         } # integer part
 288
 289         $txt .= '.' if $frac>0;
 290         for (my $i = 0; length $txt<$width-2 && $frac>0; $i++) {
 291                 $frac *= $base;
 292                 my $char = int $frac;
 293                 $frac -= $char;
 294                 $txt .= $char<10 ? $char : chr($char+55);
 295         } # fraction part
 296
 297         $txt .= 'e'.showval($exp, $base) if $exp;
 298
 299         return $txt;
 300 } # showval
 301
 302 sub showstack() {
 303         for (0..@stack-1) {
 304                 addstr($height-$_, 1, "$_: ".showval($stack[$_], $set{base}));
 305                 clrtoeol;
 306         } # show stack
 307         clrtoeol($height-$#stack-1, 1);
 308 } # showstack
 309
 310 sub showmenu() {
 311         clrtoeol($height+2, 1);
 312         my $nr = 0;
 313         for (grep exists $menu[$_], $menumin+1..$menumin+$set{menushow}) {
 314                 my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
 315                 addstr($height+2, $width/$set{menushow}*($nr++), $_);
 316                 attron(A_REVERSE);
 317                 addstr($s);
 318                 attroff(A_REVERSE);
 319                 addch('>') if $sub;
 320         } # display menu txts
 321 } # showmenu
 322
 323
 324 DRAW:
 325 clear;
 326 showmenu();
 327 showstack();
 328 addstr($height+1, 0, "> ");  # prompt
 329
 330 while (1) {
 331         addstr($height+1, 2, showval($val{i}, $set{base}));
 332         addstr('_'.$val{unit}{name}) if exists $val{unit};
 333         addstr($val{bla}) if exists $val{bla};
 334         clrtoeol;
 335         refresh;
 336
 337         $_ = ReadKey;
 338         if ($_ eq chr 27) {
 339                 while (defined (my $key = ReadKey -1)) {
 340                         $_ .= $key;
 341                 } # read additional keys
 342         } # escape sequence
 343
 344         exists $alias{$_}  and $_ = $alias{$_};  # command shortkeys
 345         if (exists $falias{$_}) {
 346                 unless ($_ = $menu[$falias{$_}]) {
 347                         error("* no such menu entry *");
 348                         goto DRAW;
 349                 }
 350         } # function key
 351
 352         $_ = delete $val{bla} if exists $val{bla} and $_ eq 'enter';
 353
 354         if ($_ eq 'quit') {
 355                 last;
 356         } # quit
 357         elsif ($_ eq 'refresh') {
 358                 goto DRAW;
 359         } # refresh
 360
 361         elsif (exists $val{bla} or /^[A-Z]$/) {
 362                 if (defined $val{i}) {
 363                         unshift @stack, $val{i};
 364                         %val = (i=>undef, frac=>0);
 365                         showstack();
 366                 } # enter present value
 367                 if ($_ eq "drop") {
 368                         $val{bla} = substr $val{bla}, 0, -1 or delete $val{bla};
 369                 } # backspace
 370                 else {
 371                         $val{bla} .= lc $_;
 372                 } # add character
 373         } # manual command
 374
 375         elsif (/^\d$/) {
 376                 $val{i} = 0 unless defined $val{i};
 377                 $val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_;
 378         }
 379         elsif ($_ eq '.') {
 380                 $val{i} = 0 unless defined $val{i};
 381                 $val{frac} = 1;
 382         } # decimal point
 383         elsif ($_ eq 'eex') {
 384                 $val{i} = 1 unless defined $val{i};
 385                 #todo
 386         } # exponent
 387         elsif ($_ eq 'chs' and defined $val{i}) {
 388                 $val{i} = -$val{i};
 389         } # change sign
 390         elsif ($_ eq 'drop' and defined $val{i}) {
 391                 $val{i} = ($val{frac} = int $val{frac}/10)
 392                         ? int($val{i}*$val{frac})/$val{frac} : int $val{i}/10
 393         } # backspace
 394
 395         elsif (exists $action{$_} or /^\d$/) {
 396                 my ($type, $cmd) = @{ $action{$_} };
 397                 if ($type>0 and defined $val{i}) {
 398                         unshift @stack, $val{i};
 399                         %val = (i=>undef, frac=>0);
 400                 } # auto enter
 401                 if ($type>0 and $type>@stack) {
 402                         error("* insufficient stack arguments for operation *");
 403                         goto DRAW;
 404                 } # insufficient arguments
 405                 $var{undo} = [@stack] if $type>=0 and $_ ne 'undo';
 406                 $cmd->();
 407                 showstack() if $type>=0;
 408         } # some operation
 409
 410         elsif (/>(\d+)$/) {
 411                 @menu = @{ $menus[$1] };
 412                 $menumin = 0;
 413                 showmenu();
 414         } # submenu
 415
 416         elsif ($_ =~ /^_/) {{
 417                 $_ = $unit{substr $_, 1} or next;
 418                 if (exists $val{unit} and $val{unit}{type}==$_->{type}) {
 419                         unshift @stack, $val{i} if defined $val{i};
 420                         $stack[0] *= delete($val{unit})->{val} / $_->{val};
 421                         showstack();
 422                         %val = (i=>undef, frac=>0);
 423                 } # convert
 424                 else {
 425                         $val{unit} = $_;
 426                 } # set source unit
 427         }} # conversion
 428
 429         else {
 430                 error("* error: ".join(' ', map ord, split //, $_)." *");
 431                 goto DRAW; # screen messed up
 432         } # error
 433 } # input loop
 434