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 our $VERSION = 1.009;
   9
  10 use strict;
  11 use warnings;
  12 use utf8;
  13
  14 use Term::ReadKey;
  15 use Curses;
  16
  17 use vars qw(@stack %val %var %set %alias %action %hook);
  18
  19 %set = (
  20         base     => 10,  # decimal; set using commands bin/oct/dec/hex/base
  21         numb     =>  0,  # fixed scientific engineering
  22         card     =>  1,  # degrees radians grades
  23         coord    =>  0,  # cartesian polar spherical
  24         complex  =>  0,  # real complex
  25
  26         height   =>  4,  # stack depth (lines of stack plus one)
  27         width    => 42,  # limit value precision, stetch menu
  28 ); # %set
  29
  30 %alias = (' '=>'enter', "\004"=>'quit', 'q'=>'quit');  # rudimentary default key bindings
  31
  32 %action = (
  33         "chs"   => [1, sub { -$_[0] }], # negative
  34
  35         "drop"  => [1, sub { defined $val{i} ? '' : () }], # drop
  36         "back"  => [1, sub { () }], # drop essentially
  37         "clear" => [0, sub { @stack = (); undef %val; () }], # clear all  #todo: if (val{i}) delete char after cursor
  38
  39         "enter" => [0, sub {
  40                 local $_ = defined $val{i} ? $val{i} : $stack[0];
  41                 undef %val;
  42                 return defined $_ ? $_ : ();
  43         }], # duplication
  44
  45         "swap"  => [2, sub { reverse @_ }], # swap x<->y
  46         "undo"  => [-1, sub {
  47                 ($var{undo}, @stack) = ([@stack], @{ $var{undo} });
  48         }], # undo/redo
  49         "stack" => [-1, sub {
  50                 $var{stackpos} = 0 unless $var{stackpos};  # initialize
  51                 $var{stackpos} %= @stack;  # cycle
  52                 $val{i} = $stack[$var{stackpos}++];
  53         }], # stack
  54
  55         "version" => [-1, sub { error("Desktop Calculator Thingy $VERSION by Shiar"); () }], # version
  56
  57         "sto"   => [1, sub { $var{a} = $_[0] }], # copy
  58         '?'     => [1, sub { $var{a} = $_[0] }], # assign
  59 ); # %action
  60
  61
  62 sub error($) {
  63         attron(A_REVERSE);
  64         addstr(0, 0, shift);
  65         attroff(A_REVERSE);
  66         clrtoeol;
  67         refresh;
  68
  69         ReadKey; # wait for confirm
  70         1 while defined ReadKey(-1); # clear key buffer
  71 } # error
  72
  73 sub showval($$);
  74 sub showval($$) {
  75         my ($val, $base) = @_;
  76         return '' unless defined $val;
  77         return $val if $base==10;
  78
  79         my $sign = $val<0;
  80         $val = abs $val;
  81         my $int = int $val;
  82         my $frac = $val-$int;
  83         my $exp = 0;
  84
  85         my $txt = '';
  86
  87         while ($int>$base**10) {
  88                 $int /= $base;
  89                 $exp++;
  90         } # exponent part
  91
  92         while ($int>=1) {
  93                 my $char = $int%$base;
  94                 $txt = ($char<10 ? $char : chr($char+55)).$txt;
  95                 $int /= $base;
  96         } # integer part
  97
  98         $txt .= '.' if $frac>0;
  99         for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
 100                 $frac *= $base;
 101                 my $char = int $frac;
 102                 $frac -= $char;
 103                 $txt .= $char<10 ? $char : chr($char+55);
 104         } # fraction part
 105
 106         $txt = "-".$txt if $sign;
 107         $txt .= 'e'.showval($exp, $base) if $exp;
 108
 109         return $txt;
 110 } # showval
 111
 112 sub showstack() {
 113         for (0..@stack-1) {
 114                 addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base}));
 115                 clrtoeol;
 116         } # show stack
 117         clrtoeol($set{height}-@stack, 1);
 118 } # showstack
 119
 120
 121 my @modules;
 122 eval 'require $_' ? push @modules, $_
 123 : print STDERR "error loading $_\n".(join "", map "\t$_\n", split /\n/, $@)
 124         for glob "*.pm";
 125
 126 initscr;
 127 ReadMode 3;  # cbreak mode
 128 END {
 129         ReadMode 0;
 130         endwin;
 131 } # restore terminal on quit
 132
 133 $set{height} = $LINES-2 if $LINES>=3;
 134 $set{width} = $COLS if $COLS;
 135 $_->() for @{ $hook{init} };
 136
 137
 138 DRAW:
 139 clear;
 140 $_->() for @{ $hook{refresh} };
 141 showstack();
 142 addstr($set{height}+1, 0, "> ");  # prompt
 143
 144 LOOP:
 145 while (1) {
 146         addstr($set{height}+1, 2, showval($val{i}, $set{base}));
 147         for my $cmd (@{ $hook{showentry} }) {
 148                 addstr($_) if $_ = $cmd->();
 149         } # showentry functions
 150         addstr($val{alpha}) if exists $val{alpha};
 151         clrtoeol;
 152         refresh;
 153
 154         my $key = ReadKey;
 155         if ($key eq chr 27) {
 156                 $key .= $_ while defined ($_ = ReadKey(-1));  # read additional keys
 157         } # escape sequence
 158         $_ = $alias{$key} || $key; #if exists $alias{$key};  # command shortkeys
 159         $_ = delete $val{alpha} if $_ eq "enter" and exists $val{alpha};  # use manual command
 160
 161         for my $cmd (@{ $hook{precmd} }) {
 162                 next LOOP if $cmd->();
 163         } # precmd functions
 164
 165         last if $_ eq 'quit';
 166         goto DRAW if $_ eq 'refresh';
 167
 168         if (exists $val{alpha} or /^\033?[A-Z]$/) {
 169                 if (defined $val{i}) {
 170                         unshift @stack, $val{i};
 171                         undef %val;
 172                         showstack();
 173                 } # enter present value
 174
 175                 if ($_ eq "back") {
 176                         $val{alpha} = substr $val{alpha}, 0, -1 or delete $val{alpha};
 177                 } # backspace
 178                 elsif ($_ eq "drop") {
 179                         delete $val{alpha};
 180                 } # drop
 181                 else {
 182                         $val{alpha} .= $key =~ /^\033(.)/ ? uc $1 : lc $key;
 183                 } # add character
 184         } # manual command entry
 185
 186         elsif (/^\d$/) {
 187                 $val{i} = 0 unless defined $val{i};
 188                 $_ = -$_ if $val{i}<0;  # substract from negative value
 189                 $val{i} = ($val{frac} and $val{frac} *= 10) ? $val{i}+$_/$val{frac}
 190                         : $val{i}*10+$_;
 191         } # digit
 192         elsif ($_ eq '.') {
 193                 $val{i} = 0 unless defined $val{i};
 194                 $val{frac} = 1;
 195         } # decimal point
 196         elsif ($_ eq "eex") {
 197                 $val{i} = 1 unless defined $val{i};
 198                 #todo
 199         } # exponent
 200         elsif ($_ eq "chs" and defined $val{i}) {
 201                 $val{i} = -$val{i};
 202         } # change sign
 203         elsif ($_ eq "back" and defined $val{i}) {
 204                 $val{i} = ($val{frac} = int $val{frac}/10)
 205                         ? int($val{i}*$val{frac})/$val{frac} : int $val{i}/10
 206         } # backspace
 207
 208         elsif (exists $action{$_}) {
 209                 my ($type, $cmd) = @{ $action{$_} };
 210                 unshift @stack, $action{enter}[1]->()
 211                         if $type>0 and defined $val{i};  # auto enter
 212                 if ($type>0 and $type>@stack) {
 213                         error("insufficient stack arguments for operation");
 214                         goto DRAW;
 215                 } # insufficient arguments
 216
 217                 if ($type>=0) {
 218                         $var{undo} = [@stack]; # if $_ ne 'undo';
 219                         unshift @stack, $cmd->(splice @stack, 0, $type);
 220                         showstack();
 221                 } # stack-modifying operation
 222                 else {
 223                         $cmd->();
 224                 } # harmless
 225         } # some operation
 226
 227         else {
 228                 error("unrecognised command: ".join(' ', map ord, split //, $_));
 229                 goto DRAW; # screen messed up
 230         } # error
 231 } # input loop
 232
 233 =cut
 234 VERSION HISTORY
 235 1.01 06-18       - start (curses, some basic commands)
 236 1.02 06-20       - function keys select command/submenu from (sub)menu
 237                  - backspace to undo last digit
 238 1.03 06-25       - values displayable in arbitrary base
 239                  - can enter fractions (.) and negative values (_)
 240 1.04 08-04 14:45 - error dialog (don't mess up screen)
 241                  - manual command input using capital letters
 242                  - ^L redraws screen
 243  pre 09-09 22:00 - overhaul in stack handling
 244 1.05 09-10 19:45 - hp48-like drop (backspace but not editing value)
 245                  - error on insufficient arguments for command
 246                  - command backspacing
 247                  - some unit conversion (mostly lengths) from menu
 248                  - q for sq(rt) (formerly quit, now only ^D/quit)
 249 1.06 09-15 23:10 - menu contents in module
 250                  - new commands: a?(sin|cos|tan)h, inv, !, rand
 251                  - x and v shortkeys
 252 1.07 09-24 23:50 - numeric modifiers hardcoded instead of in action hash
 253                  - action undo: last stack alteration can be undone
 254                  - enter on no value repeats last val on stack
 255                  - new commands: sr/sr, shortkeys ( )
 256 1.08 09-26 22:10 - additional digits were not correctly applied to negative values
 257                  - negative numbers displayed correctly in different bases
 258                  - second undo redoes
 259                  - fixed %
 260                  - stack command (cursor up) cycles through values in stack
 261 1.09 09-27 00:57 - all key aliases moved to module DCT::Bindings
 262      09-29 12:15 - number of menu items depends on screen width
 263      10-11 21:30 - hooks allowing for extra code at reload, showentry, and precmd
 264            21:50 - all menu related functions moved to menu.pm
 265            22:05 - unit conversion out of main program (entirely into unitconv.pm)
 266      10-12 01:50 - backspace becomes "back" (soft drop, like old "drop")
 267                  - normal drop command (alt+bs) removes input/stack value at once
 268            02:13 - $val{frac} default undefined instead of 0
 269 =cut