sdc.pl

   1 #!/usr/bin/perl
   2
   3 ### curses rpn desktop calculator ###
   4
   5 # by Shiar <shiar.org>
   6
   7 # 06-18       - start
   8 # 06-25       -
   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
  11
  12 use strict;
  13 use warnings;
  14 use utf8;
  15
  16 use Term::ReadKey;
  17 use Curses;
  18
  19 initscr;
  20 ReadMode 3;  # cbreak mode
  21 END {
  22         ReadMode 0;
  23         endwin;
  24 } # restore terminal on quit
  25
  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
  28
  29 my %val = qw(i 0  frac 0);  # i, frac
  30 my @stack;
  31 my %var;
  32 my @menu;
  33 my $menumin;
  34 my %set = (
  35         base     => 10,
  36         numb     =>  0,  # fixed scientific engineering
  37         card     =>  1,  # degrees radians grades
  38         coord    =>  0,  # cartesian polar spherical
  39         complex  =>  0,  # real complex
  40         menushow => 12,
  41 ); # %set
  42
  43 my @menus = (
  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
  52         [qw(main>0
  53                 vector> matrix> list> hyperbolic>9 real>10 base>2
  54                 probability> fft> complex> constants>
  55         )], #8 math
  56         [qw(math>8
  57                 sinh cosh tanh asinh acosh atanh
  58                 expm lnp1
  59         )], #9 math hyperbolic
  60         [qw(math>8
  61                 % %ch %t min max mod
  62                 abs sign mant xpon ip fp
  63                 rnd trnc floor ceil r>d d>r
  64         )], #10 math real
  65         [qw(main>0
  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
  69         )], #11 units
  70 #               mm cm m in ft yd km mile mmile lt-yr mil Ang fermi rod fath)],
  71         [qw(unit>11
  72                 _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
  73                 _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
  74         )], #12 length
  75         [qw(unit>11
  76                 _m^2 _cm^2 _b _yd^2 _ft^2 _in^2
  77                 _km^2 _ha _a _mi^2 _miUS^2 _acre
  78         )], #13 area
  79         [qw(unit>11
  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
  83                 _bbl _bu _pk _fbm
  84         )], #14 volume
  85         [qw(unit>11
  86                 _yr _d _h _min _s _Hz
  87         )], #15 time
  88         [qw(unit>11
  89                 _m/s _cm/s _ft/s _kph _mph _knot
  90                 _c _ga
  91         )], #16 speed
  92         [qw(unit>11
  93                 _kg _g _Lb _oz _slug _lbt
  94                 _ton _tonUS _t _ozt _ct _grain
  95                 _u _mol
  96         )], #17 mass
  97         [qw(unit>11
  98                 _N _dyn _gf _kip _lbf _pdl
  99         )], #18 force
 100         [qw(unit>11
 101                 _J _erg _Kcal _Cal _Btu _ftxlbf
 102                 _therm _MeV _eV
 103         )], #19 energy
 104         [qw(unit>11
 105                 _W _hp
 106         )], #20 power
 107         [qw(unit>11
 108                 _Pa _atm _bar _psi _torr _mmHg
 109                 _inHg _inH2O
 110         )], #21 pressure
 111         [qw(unit>11
 112         )], #22 temperature
 113         [qw(unit>11
 114         )], #23 electric_current
 115         [qw(unit>11
 116         )], #24 angle
 117         [qw(unit>11
 118         )], #25 light
 119         [qw(unit>11
 120         )], #26 radiation
 121         [qw(unit>11
 122         )], #27 viscosity
 123
 124
 125
 126 ); # @menus
 127 @menu = @{$menus[0]};
 128 $menumin = 0;
 129
 130 my %falias = (
 131         "\033"                         =>  0, # esc
 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
 158 ); # %falias
 159
 160 my %alias = (
 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
 173
 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)
 178
 179         '&' => 'and',
 180         '|' => 'or',
 181         '#' => 'xor',
 182         '~' => 'not',
 183
 184             "s" => 'sin',
 185         "\033s" => 'asin',
 186             "c" => 'cos',
 187         "\033c" => 'acos',
 188             "t" => 'tan',
 189         "\033t" => 'atan',
 190             "l" => 'log',
 191         "\033l" => 'alog',
 192             "n" => 'ln',
 193         "\033n" => 'exp',
 194             "q" => 'sq',
 195         "\033q" => 'sqrt',
 196         "\033^" => 'xroot',
 197 ); # %alias
 198
 199 =cut
 200 HP48 keys:
 201     S     T     U      V     W     X
 202  -  sin   cos   tan    sqrt  ^     1/x
 203  <  asin  acos  atan   sq    alog  exp
 204  >  [a]   ∫     ∑      xroot log   ln
 205 =cut
 206
 207 my %action = (
 208         'more' => [0, sub {
 209                 $menumin += $set{menushow};
 210                 $menumin = 0 if $menumin>=$#menu;
 211                 showmenu();
 212         }], # tab
 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
 216         'chs'  => [0, sub {
 217                 if (defined $val{i}) {
 218                         $val{i} = -$val{i};
 219                 } else {
 220                         $stack[0] = -$stack[0];
 221                 }
 222         }], # negative
 223
 224         'drop' => [0, sub {
 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
 228                 } else {
 229                         shift @stack;
 230                 }
 231         }], # backspace
 232         'clear'=> [0, sub {
 233                 #todo: if (val{i}) delete char after cursor
 234                 @stack = (); %val = (i=>undef, frac=>0)
 235         }], # clear all
 236
 237         'enter'=> [0, sub {
 238                 unshift @stack, $val{i};
 239                 %val = (i=>undef, frac=>0);
 240         }], # duplication
 241
 242         'swap' => [1, sub {@stack[0, 1] = @stack[1, 0]}], # swap x<->y
 243
 244         '='    => [1, sub {$var{a} = $stack[0]}], # copy
 245         '>'    => [1, sub {$var{a} = shift @stack}], # assign
 246
 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
 252
 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
 257
 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
 264
 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
 271
 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
 275
 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
 280
 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
 285
 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
 290
 291         'min'  => [2, sub {
 292                 local $_ = shift @stack;
 293                 $stack[0] = $_ if $_<$stack[0];
 294         }], # minimum
 295         'max'  => [2, sub {
 296                 local $_ = shift @stack;
 297                 $stack[0] = $_ if $_>$stack[0];
 298         }], # maximum
 299
 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
 305 ); # %action
 306
 307 my %unit;
 308 {
 309 my $i = 0;
 310 $unit{$_->[0]} = { name=>$_->[0], type=>$i, val=>$_->[1] } for map {$i++; @$_} (
 311         [
 312                 ['m', 1],
 313                 ['cm', .01],
 314                 ['mm', .001],
 315                 ['km', 1000],
 316                 ['ft', .3048],
 317                 ['in', .0254],
 318                 ['yd', .9144],
 319                 ['mile', 1609.344],
 320                 ['nmile', 1852],
 321                 ['lyr', 9.46052840488e+15],
 322                 ['mil', 2.54e-5],
 323         #               _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
 324         #               _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
 325         ], # lengths
 326         [
 327                 ['m^3', 1],
 328                 ['cm^3', 1e-6],
 329                 ['ft^3', .028316846592],
 330                 ['in^3', 1.6387064e-5],
 331         ], # volume
 332 );
 333 } # create unit table
 334
 335
 336 sub error($) {
 337         attron(A_REVERSE);
 338         addstr(0, 0, shift);
 339         attroff(A_REVERSE);
 340         clrtoeol;
 341         refresh;
 342
 343         ReadKey; # wait for confirm
 344         1 while defined (ReadKey -1); # clear key buffer
 345 } # error
 346
 347 sub showval($$);
 348 sub showval($$) {
 349         my ($val, $base) = @_;
 350         return '' unless defined $val;
 351         return $val if $base==10;
 352
 353         my $int = int $val;
 354         my $frac = $val-$int;
 355         my $exp = 0;
 356
 357         my $txt = '';
 358         while ($int>$base**10) {
 359                 $int /= $base;
 360                 $exp++;
 361         } # exponent part
 362         while ($int>=1) {
 363                 my $char = $int%$base;
 364                 $txt = ($char<10 ? $char : chr($char+55)).$txt;
 365                 $int /= $base;
 366         } # integer part
 367
 368         $txt .= '.' if $frac>0;
 369         for (my $i = 0; length $txt<$width-2 && $frac>0; $i++) {
 370                 $frac *= $base;
 371                 my $char = int $frac;
 372                 $frac -= $char;
 373                 $txt .= $char<10 ? $char : chr($char+55);
 374         } # fraction part
 375
 376         $txt .= 'e'.showval($exp, $base) if $exp;
 377
 378         return $txt;
 379 } # showval
 380
 381 sub showstack() {
 382         for (0..@stack-1) {
 383                 addstr($height-$_, 1, "$_: ".showval($stack[$_], $set{base}));
 384                 clrtoeol;
 385         } # show stack
 386         clrtoeol($height-$#stack-1, 1);
 387 } # showstack
 388
 389 sub showmenu() {
 390         clrtoeol($height+2, 1);
 391         my $nr = 0;
 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++), $_);
 395                 attron(A_REVERSE);
 396                 addstr($s);
 397                 attroff(A_REVERSE);
 398                 addch('>') if $sub;
 399         } # display menu txts
 400 } # showmenu
 401
 402
 403 DRAW:
 404 clear;
 405 showmenu();
 406 showstack();
 407 addstr($height+1, 0, "> ");  # prompt
 408
 409 while (1) {
 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};
 413         clrtoeol;
 414         refresh;
 415
 416         $_ = ReadKey;
 417         if ($_ eq chr 27) {
 418                 while (defined (my $key = ReadKey -1)) {
 419                         $_ .= $key;
 420                 } # read additional keys
 421         } # escape sequence
 422
 423         exists $alias{$_}  and $_ = $alias{$_};  # command shortkeys
 424         if (exists $falias{$_}) {
 425                 unless ($_ = $menu[$falias{$_}]) {
 426                         error("* no such menu entry *");
 427                         goto DRAW;
 428                 }
 429         } # function key
 430
 431         $_ = delete $val{bla} if exists $val{bla} and $_ eq 'enter';
 432
 433         if ($_ eq 'quit') {
 434                 last;
 435         } # quit
 436         elsif ($_ eq 'refresh') {
 437                 goto DRAW;
 438         } # refresh
 439
 440         elsif (exists $val{bla} or /^[A-Z]$/) {
 441                 if (defined $val{i}) {
 442                         unshift @stack, $val{i};
 443                         %val = (i=>undef, frac=>0);
 444                         showstack();
 445                 } # enter present value
 446                 if ($_ eq "drop") {
 447                         $val{bla} = substr $val{bla}, 0, -1;
 448                 } # backspace
 449                 else {
 450                         $val{bla} .= lc $_;
 451                 } # add character
 452         } # manual command
 453
 454         elsif (exists $action{$_} or /^\d$/) {
 455                 my ($type, $cmd) = @{ $action{$_} || $action{digit} };
 456                 if ($type==-2) {
 457                         $val{i} = 0 unless defined $val{i};
 458                 } # modify value
 459                 if ($type>0 and defined $val{i}) {
 460                         unshift @stack, $val{i};
 461                         %val = (i=>undef, frac=>0);
 462                 } # auto enter
 463                 if ($type>0 and $type>@stack) {
 464                         error("* insufficient stack arguments for operation *");
 465                         goto DRAW;
 466                 } # insufficient arguments
 467                 $cmd->();
 468                 showstack() if $type>=0;
 469         } # some operation
 470
 471         elsif (/>(\d+)$/) {
 472                 @menu = @{ $menus[$1] };
 473                 $menumin = 0;
 474                 showmenu();
 475         } # submenu
 476
 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};
 482                         showstack();
 483                         %val = (i=>undef, frac=>0);
 484                 } # convert
 485                 else {
 486                         $val{unit} = $_;
 487                 } # set source unit
 488         }} # conversion
 489
 490         else {
 491                 error("* error: ".join(' ', map ord, split //, $_)." *");
 492                 goto DRAW; # screen messed up
 493         } # error
 494 } # input loop
 495