sdc.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Term::ReadKey;
   7 use Curses;
   8
   9 initscr;
  10 ReadMode 3;
  11
  12 my $height = $LINES-3;
  13 my $width = 42; #COLS
  14
  15 my @stack;
  16 my @val;
  17 my $nopush; # 0=push and reset next; 1=reset next; 2=do nothing
  18 my $base = 10;
  19 my @menu;
  20
  21 INIT: {
  22
  23 @stack = ();
  24 @val = (0, 0); # val, frac
  25 $nopush = 1;
  26
  27 sub showval($$) {
  28         my ($val, $base) = @_;
  29         return $val if $base==10;
  30
  31         my $int = int $val;
  32         my $frac = $val-$int;
  33
  34         my $txt = '';
  35         while ($int>=1) {
  36                 my $char = $int%$base;
  37                 $txt = ($char<10 ? $char : chr($char+55)).$txt;
  38                 $int /= $base;
  39         }
  40
  41         $txt .= '.' if $frac>0;
  42         for (my $i = 0; length $txt<$width-2 && $frac>0; $i++) {
  43                 $frac *= $base;
  44                 my $char = int $frac;
  45                 $frac -= $char;
  46                 $txt .= $char<10 ? $char : chr($char+55);
  47         }
  48
  49         return $txt;
  50 } # showval
  51
  52 sub showstack() {
  53         for (0..@stack-1) {
  54                 addstr($height-$_, 1, "$_: ".showval($stack[$_], $base));
  55                 clrtoeol;
  56         } # show stack
  57         clrtoeol($height-$#stack-1, 1);
  58 } # showstack
  59
  60 sub showmenu($) {
  61         my @menus = ([qw(xroot log alog)], [qw(dec bin oct hex)]);
  62         @menu = @{$menus[shift]};
  63         attron(A_REVERSE);
  64         addstr($height+2, $width/6*$_+1, join " ", $menu[$_]) for grep exists $menu[$_], 0..5;
  65         attroff(A_REVERSE);
  66         clrtoeol;
  67         addstr($height+2, $width/6*$_, $_+1) for grep exists $menu[$_], 0..5;
  68 } # showmenu
  69
  70 my %falias = (
  71         chr(27).chr(79).chr(80)                  =>  0, # F1
  72         chr(27).chr(79).chr(81)                  =>  1, # F2
  73         chr(27).chr(79).chr(82)                  =>  2, # F3
  74         chr(27).chr(79).chr(83)                  =>  3, # F4
  75         chr(27).chr(91).chr(49).chr(53).chr(126) =>  4, # F5
  76         chr(27).chr(91).chr(49).chr(55).chr(126) =>  5, # F6
  77         chr(27).chr(91).chr(49).chr(56).chr(126) =>  6, # F7
  78         chr(27).chr(91).chr(49).chr(57).chr(126) =>  7, # F8
  79         chr(27).chr(91).chr(50).chr(48).chr(126) =>  8, # F9
  80         chr(27).chr(91).chr(50).chr(49).chr(126) =>  9, # F10
  81         chr(27).chr(91).chr(50).chr(51).chr(126) => 10, # F11
  82         chr(27).chr(91).chr(50).chr(52).chr(126) => 10, # F12
  83 ); # %falias
  84
  85 my %alias = (
  86         q     => chr 4,   # quit
  87         s     => 'sin',
  88         c     => 'cos',
  89         t     => 'tan',
  90         l     => 'log',
  91         x     => 'xroot',
  92         chr 8 => chr 127, # backspace
  93 ); # %alias
  94
  95 my %action = (
  96         chr 13 => sub {
  97                 unshift @stack, $stack[0];
  98                 $nopush = 1;
  99         }, # duplication
 100
 101         '+' => sub {
 102                 $stack[1] += shift @stack;
 103         }, # addition
 104         '-' => sub {
 105                 $stack[1] -= shift @stack;
 106         }, # substraction
 107         '*' => sub {
 108                 $stack[1] *= shift @stack;
 109         }, # multiplication
 110         '/' => sub {
 111                 $stack[1] /= shift @stack;
 112         }, # division
 113         '%' => sub {
 114                 $stack[1] %= shift @stack;
 115         }, # modulus
 116
 117         '^' => sub {
 118                 $stack[1] **= shift @stack;
 119         }, # exponentiation
 120         'xroot' => sub {
 121                 $stack[1] **= 1/shift @stack;
 122         }, # x-root of y
 123
 124         '&' => sub {
 125                 $stack[1] &= shift @stack;
 126         }, # bitwise and
 127         '|' => sub {
 128                 $stack[1] |= shift @stack;
 129         }, # bitwise or
 130         '#' => sub {
 131                 $stack[1] ^= shift @stack;
 132         }, # bitwise xor
 133         '~' => sub {
 134                 unshift @stack, ~(shift @stack);
 135         }, # bitwise not
 136
 137         'log' => sub {
 138                 unshift @stack, log shift @stack;
 139         }, # logarithm
 140         'alog' => sub {
 141                 unshift @stack, 10 ** shift @stack;
 142         }, # 10^x
 143
 144         'sin' => sub {
 145                 unshift @stack, sin shift @stack;
 146         }, # sine
 147         'cos' => sub {
 148                 unshift @stack, cos shift @stack;
 149         }, # cosine
 150         'tan' => sub {
 151                 local $_ = shift @stack;
 152                 unshift @stack, sin($_) / cos($_);
 153         }, # tangent
 154
 155         'abs' => sub {
 156                 unshift @stack, abs shift @stack;
 157         }, # absolute
 158         '_' => sub {
 159                 unshift @stack, -shift @stack;
 160         }, # negative
 161         'min' => sub {
 162                 local $_ = shift @stack;
 163                 $stack[1] = $_ if $_<$stack[1];
 164         }, # minimum
 165
 166         'dec' => sub {
 167                 $base = 10;
 168         }, # decimal
 169         'bin' => sub {
 170                 $base = 2;
 171         }, # binary
 172         'oct' => sub {
 173                 $base = 8;
 174         }, # octal
 175         'hex' => sub {
 176                 $base = 16;
 177         }, # hexadecimal
 178         'base36' => sub {
 179                 $base = 36;
 180         }, # alphanumerical
 181 ); # %action
 182
 183 clear;
 184 showmenu(0);
 185 addstr($height+1, 0, "> ");
 186
 187 while (1) {
 188         addstr($height+1, 2, showval($val[0], $base));
 189         clrtoeol;
 190         refresh;
 191
 192         $_ = ReadKey;
 193         if ($_ eq chr 27) {
 194                 while (defined (my $key = ReadKey -1)) {
 195                         $_ .= $key;
 196                 } # read additional keys
 197         } # escape
 198
 199         exists $alias{$_}  and $_ = $alias{$_};
 200         exists $falias{$_} and $_ = $menu[$falias{$_}];
 201
 202         if ($_ eq chr 4) {
 203                 last INIT;
 204         } # ^D
 205         elsif ($_ eq chr 27) {
 206                 redo INIT;
 207         } # escape
 208
 209         elsif (/^[\d.]$/) {
 210                 unshift @stack, $val[0] and showstack() unless $nopush;
 211                 @val = (0, 0) if $nopush<2; # replace current
 212                 $nopush = 2;
 213                 if ($_ eq '.') {
 214                         $val[1] = 1;
 215                 } # dot
 216                 elsif ($val[1] *= 10) {
 217                         $val[0] += $_/$val[1];
 218                 } # fraction
 219                 else {
 220                         $val[0] = $val[0]*10+$_;
 221                 } # integer
 222         } # number
 223         elsif ($_ eq chr 127) {
 224                 if ($val[1] = int $val[1]/10) {
 225                         $val[0] = int($val[0]*$val[1])/$val[1];
 226                 } else {
 227                         $val[0] = int $val[0]/10
 228                 }
 229         } # backspace
 230
 231         elsif (exists $action{$_}) {
 232                 unshift @stack, $val[0];
 233                 $nopush = 0;
 234                 $action{$_}();
 235                 $val[0] = shift @stack;
 236                 showstack();
 237         } # some operation
 238
 239         else {
 240                 print "\n* error: ", join(' ', map ord, split //, $_), "\n";
 241         }
 242 } # input loop
 243 }
 244
 245 ReadMode 0;
 246 endwin;
 247