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
  11 use strict;
  12 use warnings;
  13
  14 use Term::ReadKey;
  15 use Curses;
  16
  17 initscr;
  18 ReadMode 3;
  19
  20 my $height = $LINES-3 || 4;
  21 my $width = $COLS || 42;
  22
  23 my @val = (0, 0); # val, frac
  24 my $nopush = 1; # 0=push and reset next; 1=reset next; 2=do nothing
  25 my @stack;
  26 my %var;
  27 my @menu;
  28 my %set = (
  29         base  => 10,
  30         numb  => 0, # fixed scientific engineering
  31         card  => 1, # degrees radians grades
  32         coord => 0, # cartesian polar spherical
  33         complex => 0, # real complex
  34         menushow => 12,
  35 ); # %set
  36
  37 my @menus = (
  38         [qw(quit base>1 math>8 mode>7)],
  39         [qw(main>0 dec bin oct hex logic>3 bit>4)], #1 base
  40         [qw(main>0 log alog ln exp sin cos tan 0 asin acos atan)], #2 math
  41         [qw(base>1 and or xor not)], #3 base logic
  42         [qw(base>1 rl sl asr sr rr)], #4 base bit
  43         [qw(base>1 rlb slb srb rrb)], #5 base byte
  44         [qw(main>0 sq sqrt ^ xroot)], #6
  45         [qw(main>0 number_format angle_measure coord_system)], #7 mode
  46         [qw(main>0
  47                 vector> matrix> list> hyperbolic>9 real>10 base>1
  48                 probability> fft> complex> constants>
  49         )], #8 math
  50         [qw(math>8
  51                 sinh cosh tanh asinh acosh atanh
  52                 expm lnp1
  53         )], #9 math hyperbolic
  54         [qw(math>8
  55                 % %ch %t min max mod
  56                 abs sign mant xpon ip fp
  57                 rnd trnc floor ceil r>d d>r
  58         )], #10 math real
  59         [qw(main>0
  60                 tools> length> area> volume> time> speed>
  61                 mass> force> energy> power> pressure> temperature>
  62                 electric_current> angle> light> radiation> viscosity>
  63         )], #11 units
  64 ); # @menus
  65 @menu = @{$menus[0]};
  66
  67 my %falias = (
  68         "\033"                         =>  0, # esc
  69         "\033\117\120"                 =>  1, # f1
  70         "\033\133\061\061\176"         =>  1, # f1
  71         "\033\117\121"                 =>  2, # f2
  72         "\033\133\061\062\176"         =>  2, # f2
  73         "\033\117\122"                 =>  3, # f3
  74         "\033\133\061\063\176"         =>  3, # f3
  75         "\033\117\123"                 =>  4, # f4
  76         "\033\133\061\064\176"         =>  4, # f4
  77         "\033\133\061\065\176"         =>  5, # f5
  78         "\033\133\061\067\176"         =>  6, # f6
  79         "\033\133\061\070\176"         =>  7, # f7
  80         "\033\133\061\071\176"         =>  8, # f8
  81         "\033\133\062\060\176"         =>  9, # f9
  82         "\033\133\062\061\176"         => 10, # f10
  83         "\033\133\062\063\176"         => 11, # f11/F1
  84         "\033\133\062\064\176"         => 12, # f12/F2
  85         "\033\133\062\065\176"         => 13, # F3
  86         "\033\133\062\066\176"         => 14, # F4
  87         "\033\133\062\070\176"         => 15, # F5
  88         "\033\133\062\071\176"         => 16, # F6
  89         "\033\133\063\061\176"         => 17, # F7
  90         "\033\133\063\062\176"         => 18, # F8
  91         "\033\133\063\063\176"         => 19, # F9
  92         "\033\133\063\064\176"         => 20, # F10
  93         "\033\133\062\063\073\062\176" => 21, # F11
  94         "\033\133\062\064\073\062\176" => 22, # F12
  95 ); # %falias
  96
  97 my %alias = (
  98         chr 4 => 'quit', # ^D
  99         'q' => 'quit', # quit
 100         '_' => 'chs', # change sign
 101         'e' => 'eex', # exponent
 102         "\033\133\062\176" => 'swap', # ins
 103         chr(27).chr(91).chr(51).chr(126) => 'clx', # del
 104         chr 127 => '<-', # backspace
 105         chr 8 => '<-', # backspace
 106         "\014" => 'refresh', # ^L
 107         "\033\133\110" => 'refresh', # home
 108
 109         '&' => 'and',
 110         '|' => 'or',
 111         '#' => 'xor',
 112         '~' => 'not',
 113
 114                 's' => 'sin',
 115         chr(27).'s' => 'asin',
 116                 'u' => 'cos',
 117         chr(27).'u' => 'acos',
 118                 't' => 'tan',
 119         chr(27).'t' => 'atan',
 120                 'l' => 'log',
 121         chr(27).'l' => 'alog',
 122                 'n' => 'ln',
 123         chr(27).'n' => 'exp',
 124                 'x' => 'xroot',
 125
 126 ); # %alias
 127
 128 my %action = (
 129 #       'digit' => [-2, sub {
 130 #               if ($val[1] *= 10) {
 131 #                       $val[0] += $_/$val[1];
 132 #               } # fraction
 133 #               else {
 134 #                       $val[0] = $val[0]*10+$_;
 135 #               } # integer
 136 #       }],
 137         'digit'=> [-2, sub { $val[0] = ($val[1] *= 10) ? $val[0]+$_/$val[1] : $val[0]*10+$_ }],
 138         '.'    => [-2, sub { $val[1] = 1 }], # decimal point
 139         'eex'  => [-2, sub {}], # exponent
 140         'chs'  => [1, sub {$val[0] = -$val[0]}], # negative
 141
 142         '<-'   => [-1, sub {
 143                 $val[0] = ($val[1] = int $val[1]/10)
 144                         ? int($val[0]*$val[1])/$val[1] : int $val[0]/10
 145         }], # backspace
 146         'clx'  => [0, sub {@stack = (); @val = (0, 0); $nopush = 1}], # clear all
 147
 148         chr 13 => [0, sub {
 149                 unshift @stack, $val[0];
 150                 $nopush = 1;
 151         }], # duplication
 152
 153         'swap' => [1, sub {($val[0], $stack[0]) = ($stack[0], $val[0])}], # swap x<->y
 154
 155         '='    => [1, sub {$var{a} = $val[0]}], # copy
 156         '>'    => [1, sub {$var{a} = $val[0]; $val[0] = shift @stack}], # assign
 157
 158         '+'    => [2, sub {$val[0] += shift @stack}], # addition
 159         '-'    => [2, sub {$val[0] = shift(@stack) - $val[0]}], # substraction
 160         '*'    => [2, sub {$val[0] *= shift @stack}], # multiplication
 161         '/'    => [2, sub {$val[0] = shift(@stack) / $val[0]}], # division
 162         'mod'  => [2, sub {$val[0] = shift(@stack) % $val[0]}], # modulo
 163
 164         'sqrt' => [1, sub {$val[0] = sqrt $val[0]}], # square root
 165         'sq'   => [1, sub {$val[0] *= $val[0]}], # squared
 166         '^'    => [2, sub {$val[0] = shift(@stack) ** $val[0]}], # exponentiation
 167         'xroot'=> [2, sub {$val[0] = shift(@stack) ** (1/$val[0])}], # x-root of y
 168
 169         'log'  => [1, sub {$val[0] = log($val[0]) / log(10)}], # logarithm
 170         'alog' => [1, sub {$val[0] = 10 ** $val[0]}], # 10^x
 171         'ln'   => [1, sub {$val[0] = log $val[0]}], # natural logaritm
 172         'lnp1' => [1, sub {$val[0] = log($val[0]+1)}], # ln(x+1)
 173         'exp'  => [1, sub {$val[0] = exp($val[0])}], # e^x
 174         'expm' => [1, sub {$val[0] = exp($val[0])-1}], # exp(x)-1
 175
 176         'sin'  => [1, sub {$val[0] = sin $val[0]}], # sine
 177         'asin' => [1, sub {$val[0] = atan2($val[0], sqrt(1 - $val[0]*$val[0]))}], # inverse sine
 178         'cos'  => [1, sub {$val[0] = cos $val[0]}], # cosine
 179         'acos' => [1, sub {$val[0] = atan2(sqrt(1 - $val[0]*$val[0]), $val[0])}], # inverse cosine
 180         'tan'  => [1, sub {$val[0] = sin($val[0]) / cos($val[0])}], # tangent
 181 #       'atan' => [1, sub {}], # arctangent
 182
 183         '%'    => [2, sub {$val[0] /= shift(@stack)}], # percentage
 184         '%ch'  => [2, sub {$val[0] = 100*(shift(@stack)-$val[0])/$val[0]}], # percentage change
 185         '%t'   => [2, sub {$val[0] = 100*$val[0]/shift(@stack)}], # percentage total
 186
 187         'and'  => [2, sub {$val[0] = shift(@stack) & $val[0]}], # bitwise and
 188         'or'   => [2, sub {$val[0] = shift(@stack) | $val[0]}], # bitwise or
 189         'xor'  => [2, sub {$val[0] = shift(@stack) ^ $val[0]}], # bitwise xor
 190         'not'  => [2, sub {$val[0] = ~$val[0]}], # bitwise not
 191
 192         'abs'  => [1, sub {$val[0] = abs $val[0]}], # absolute #todo
 193         'sign' => [1, sub {$val[0] = $val[0] <=> 0}], # sign
 194         'ip'   => [1, sub {$val[0] = int $val[0]}], # integer part
 195         'fp'   => [1, sub {$val[0] -= int $val[0]}], # fractional part
 196
 197         'rnd'  => [1, sub {local $_ = 10**shift @stack; $val[0] = int(($val[0]+.5)*$_)/$_}], # round
 198         'trnc' => [1, sub {local $_ = 10**shift @stack; $val[0] = int($val[0]*$_)/$_}], # truncate
 199         'floor'=> [1, sub {$val[0] = int $val[0]}], # floor
 200         'ceil' => [1, sub {$val[0] = int $val[0]+.9999}], # ceil
 201
 202         'min'  => [2, sub {
 203                 local $_ = shift @stack;
 204                 $val[0] = $_ if $_<$val[0];
 205         }], # minimum
 206         'max'  => [2, sub {
 207                 local $_ = shift @stack;
 208                 $val[0] = $_ if $_>$val[0];
 209         }], # maximum
 210
 211         'dec'  => [0, sub {$set{base} = 10}], # decimal
 212         'bin'  => [0, sub {$set{base} = 2}], # binary
 213         'oct'  => [0, sub {$set{base} = 8}], # octal
 214         'hex'  => [0, sub {$set{base} = 16}], # hexadecimal
 215         'base36' => [0, sub {$set{base} = 36}], # alphanumerical
 216 ); # %action
 217
 218
 219 sub showval($$);
 220 sub showval($$) {
 221         my ($val, $base) = @_;
 222         return $val if $base==10;
 223
 224         my $int = int $val;
 225         my $frac = $val-$int;
 226         my $exp = 0;
 227
 228         my $txt = '';
 229         while ($int>$base**10) {
 230                 $int /= $base;
 231                 $exp++;
 232         } # exponent part
 233         while ($int>=1) {
 234                 my $char = $int%$base;
 235                 $txt = ($char<10 ? $char : chr($char+55)).$txt;
 236                 $int /= $base;
 237         } # integer part
 238
 239         $txt .= '.' if $frac>0;
 240         for (my $i = 0; length $txt<$width-2 && $frac>0; $i++) {
 241                 $frac *= $base;
 242                 my $char = int $frac;
 243                 $frac -= $char;
 244                 $txt .= $char<10 ? $char : chr($char+55);
 245         } # fraction part
 246
 247         $txt .= 'e'.showval($exp, $base) if $exp;
 248
 249         return $txt;
 250 } # showval
 251
 252 sub showstack() {
 253         for (0..@stack-1) {
 254                 addstr($height-$_, 1, "$_: ".showval($stack[$_], $set{base}));
 255                 clrtoeol;
 256         } # show stack
 257         clrtoeol($height-$#stack-1, 1);
 258 } # showstack
 259
 260 sub showmenu() {
 261         clrtoeol($height+2, 1);
 262         for (grep exists $menu[$_], 1..$set{menushow}) {
 263                 my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
 264                 addstr($height+2, $width/$set{menushow}*($_-1), $_);
 265                 attron(A_REVERSE);
 266                 addstr($s);
 267                 attroff(A_REVERSE);
 268                 addch('>') if $sub;
 269         } # display menu txts
 270 } # showmenu
 271
 272
 273 DRAW:
 274 clear;
 275 showmenu();
 276 showstack();
 277 addstr($height+1, 0, "> ");
 278
 279 while (1) {
 280         addstr($height+1, 2, showval($val[0], $set{base}));
 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
 290
 291         exists $alias{$_}  and $_ = $alias{$_};
 292         exists $falias{$_} and $_ = $menu[$falias{$_}];
 293
 294         if (exists $action{$_} or /^\d$/) {
 295                 my ($type, $cmd) = @{ $action{$_} || $action{digit} };
 296                 if ($type==-2) {
 297                         unshift @stack, $val[0] and showstack() unless $nopush;
 298                         @val = (0, 0) if $nopush<2; # replace current
 299                         $nopush = 2;
 300                 } # modify value
 301                 $cmd->();
 302                 $nopush = 0 if $type>0;
 303                 showstack() if $type>=0;
 304         } # some operation
 305
 306         elsif ($_ eq 'quit') {
 307                 last;
 308         } # quit
 309         elsif ($_ eq 'refresh') {
 310                 goto DRAW;
 311         } # refresh
 312
 313         elsif (/>(\d+)$/) {
 314                 @menu = @{ $menus[$1] };
 315                 showmenu();
 316         } # submenu
 317
 318         else {
 319                 attron(A_REVERSE);
 320                 addstr($height+1, 0, "* error: ".join(' ', map ord, split //, $_)." *");
 321                 attroff(A_REVERSE);
 322                 clrtoeol;
 323                 refresh;
 324
 325                 ReadKey; # wait for confirm
 326                 1 while defined (ReadKey -1); # clear key buffer
 327                 goto DRAW; # screen messed up
 328         }
 329 } # input loop
 330
 331 ReadMode 0;
 332 endwin;
 333