dct.pl

   1 #!/usr/bin/perl
   2
   3 # DCT - desktop calculator thingy
   4
   5 # simple modular reverse polish notition calculator
   6 # by Shiar <shiar.org>
   7
   8 use strict;
   9 use warnings;
  10 use utf8;
  11
  12 use Data::Dumper;
  13 use Term::ReadKey;
  14
  15 our $VERSION = "1.10.6";
  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");  # rudimentary default key bindings
  31
  32 %action = (
  33         "enter" => [ 0, sub {
  34                 local $_ = defined $val{i} ? $val{i} : $stack[0];
  35                 undef %val;
  36                 return defined $_ ? $_ : ();
  37         }], # duplication
  38
  39         "chs"   => [ 1, sub { -$_[0] }], # negative
  40
  41         "drop"  => [ 1, sub { defined $val{i} ? '' : () }], # drop
  42         "back"  => [ 1, sub { () }], # drop essentially
  43         "clear" => [ 0, sub { @stack = (); undef %val; () }], # clear all
  44
  45         "swap"  => [ 2, sub { reverse @_ }], # swap x<->y
  46         "stack" => [-2, sub {
  47                 $var{stackpos} = 0 unless $var{stackpos};  # initialize
  48                 $var{stackpos} %= @stack;  # cycle
  49                 $val{i} = $stack[$var{stackpos}++];
  50         }], # stack
  51
  52         "sto"   => [ 1, sub { $var{a} = $_[0] }], # copy
  53         '?'     => [ 1, sub { $var{a} = $_[0] }], # assign
  54
  55         "version" => [-2, sub {
  56                 error("Desktop Calculator Thingy $VERSION by Shiar"); ()
  57         }], # version
  58 ); # %action
  59
  60
  61 sub error($) {
  62         $_->($_[0]) for @{$hook{showerror}};
  63 } # error
  64
  65 sub showval($$);
  66 sub showval($$) {
  67         my ($val, $base) = @_;
  68         return '' unless defined $val;
  69         return $val if $base==10;
  70
  71         my $sign = $val<0;
  72         $val = abs $val;
  73         my $int = int $val;
  74         my $frac = $val-$int;
  75         my $exp = 0;
  76
  77         my $txt = '';
  78
  79         while ($int>$base**10) {
  80                 $int /= $base;
  81                 $exp++;
  82         } # exponent part
  83
  84         while ($int>=1) {
  85                 my $char = $int%$base;
  86                 $txt = ($char<10 ? $char : chr($char+55)).$txt;
  87                 $int /= $base;
  88         } # integer part
  89
  90         $txt .= '.' if $frac>0;
  91         for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
  92                 $frac *= $base;
  93                 my $char = int $frac;
  94                 $frac -= $char;
  95                 $txt .= $char<10 ? $char : chr($char+55);
  96         } # fraction part
  97
  98         $txt = "-".$txt if $sign;
  99         $txt .= 'e'.showval($exp, $base) if $exp;
 100
 101         return $txt;
 102 } # showval
 103
 104 sub showstack() {
 105         $_->() for @{$hook{showstack}};
 106 } # showstack
 107
 108
 109 my %modules;
 110 for my $module (sort glob "*.pm") {
 111         next unless $module =~ /^\d{2}_(\w+)\.pm$/;  # filename 00_name.pm
 112         next if defined $modules{$1};  # such module already loaded
 113         defined ($_ = do $module)
 114         ? (ref $_ and $modules{$1} = $_)  # return value means no errors
 115         : print STDERR $@, "error loading $module\n\n";
 116 } # load modules
 117
 118 printf STDERR "DCT %s by Shiar (%s)\n", $VERSION,
 119         join "; ", map {"$_ $modules{$_}{version}"} keys %modules;
 120
 121 ReadMode 3;  # cbreak mode
 122 END { ReadMode 0; } # restore terminal on quit
 123
 124 $_->() for @{$hook{init}};
 125 my $redraw = 1;
 126
 127 LOOP: while (1) {
 128         if ($redraw) {
 129                 $_->() for @{$hook{refresh}};
 130                 showstack();
 131                 $redraw = 0;
 132         } # refresh
 133
 134         {
 135                 my $entry = showval($val{i}, $set{base});
 136                 $entry .= $_ for map $_->(), @{$hook{postentry}};
 137                 $entry .= $val{alpha} if exists $val{alpha};
 138                 $_->($entry) for @{$hook{showentry}};
 139         } # show entry
 140
 141         my $key = ReadKey;
 142         if ($key eq chr 27) {
 143                 $key .= $_ while defined ($_ = ReadKey(-1));  # read additional keys
 144         } # escape sequence
 145         $_ = $alias{$key} || $key; #if exists $alias{$key};  # command shortkeys
 146         $_ = delete $val{alpha} if $_ eq "enter" and exists $val{alpha};  # use manual command
 147
 148         for my $cmd (@{$hook{precmd}}) {
 149                 next LOOP if $cmd->();
 150         } # precmd functions
 151
 152         last if $_ eq 'quit';
 153
 154         if ($_ eq 'refresh') {
 155                 $redraw++;
 156         } # refresh
 157
 158         elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
 159                 if (defined $val{i}) {
 160                         unshift @stack, $val{i};
 161                         undef %val;
 162                         showstack();
 163                 } # enter present value
 164
 165                 if ($_ eq "back") {
 166                         $val{alpha} = substr $val{alpha}, 0, -1 or delete $val{alpha};
 167                 } # backspace
 168                 elsif ($_ eq "drop") {
 169                         delete $val{alpha};
 170                 } # drop
 171                 else {
 172                         $val{alpha} .= $key =~ /^\033(.)/ ? uc $1 : lc $key;
 173                 } # add character
 174         } # manual command entry
 175
 176         elsif (/^[\da-f]$/) {
 177                 m/^[a-z]$/ and $_ = ord($_)-87;  # digit>9
 178                 $val{i} = 0 unless defined $val{i};
 179                 $_ = -$_ if $val{i}<0;  # substract from negative value
 180                 $val{i} = ($val{frac} and $val{frac} *= 10)
 181                         ? $val{i}+$_/$val{frac}  # add digit to fraction
 182                         : $val{i}*$set{base}+$_;  # add digit to integer part
 183         } # digit
 184         elsif ($_ eq '.') {
 185                 $val{i} = 0 unless defined $val{i};
 186                 $val{frac} = 1;
 187         } # decimal point
 188         elsif ($_ eq "eex") {
 189                 $val{i} = 1 unless defined $val{i};
 190                 #todo
 191         } # exponent
 192         elsif ($_ eq "chs" and defined $val{i}) {
 193                 $val{i} = -$val{i};
 194         } # change sign
 195         elsif ($_ eq "back" and defined $val{i}) {
 196                 $val{i} = ($val{frac} and $val{frac} = int $val{frac}/10)
 197                         ? int($val{i}*$val{frac})/$val{frac}  # backspace fraction digit
 198                         : int $val{i}/$set{base}  # backspace digit in integer part
 199         } # backspace
 200
 201         elsif (exists $action{$_}) {
 202                 my ($type, $cmd) = @{$action{$_}};
 203                 unshift @stack, $action{enter}[1]->() if $type>0 and defined $val{i};  # auto enter
 204
 205                 if ($type>0 and $type>@stack) {
 206                         error("insufficient stack arguments for operation");
 207                         $redraw++;
 208                         next;
 209                 } # insufficient arguments
 210
 211                 $_->($type) for @{$hook{preaction}};
 212
 213                 # put return value(s) of stack-modifying operations (type>=0) at stack
 214                 $type<0 ? $cmd->() : unshift @stack, $cmd->(splice @stack, 0, $type);
 215
 216                 showstack() if $type>=-1;
 217         } # some operation
 218
 219         else {
 220                 error(
 221                         "unrecognised command: "  # show string or character codes
 222                         . (m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_)
 223                 );
 224                 $redraw++;  # screen messed up
 225         } # error
 226 } # input loop
 227
 228 =cut
 229 VERSION HISTORY
 230 1.01 040618     - start (curses, some basic commands)
 231 1.02 040620     - function keys select command/submenu from (sub)menu
 232                 - backspace to undo last digit
 233 1.03 040625     - values displayable in arbitrary base
 234                 - can enter fractions (.) and negative values (_)
 235 1.04 0408041445 - error dialog (don't mess up screen)
 236                 - manual command input using capital letters
 237                 - ^L redraws screen
 238      0409092200 - overhaul in stack handling
 239 1.05 0409101945 - hp48-like drop (backspace but not editing value)
 240                 - error on insufficient arguments for command
 241                 - command backspacing
 242                 - some unit conversion (mostly lengths) from menu
 243                 - q for sq(rt) (formerly quit, now only ^D/quit)
 244 1.06 0409152310 - menu contents in module
 245                 - new commands: a?(sin|cos|tan)h, inv, !, rand
 246                 - x and v shortkeys
 247 1.07 0409242350 - numeric modifiers hardcoded instead of in action hash
 248                 - action undo: last stack alteration can be undone
 249                 - enter on no value repeats last val on stack
 250                 - new commands: sr/sr, shortkeys ( )
 251 1.08 0409262210 - additional digits were not correctly applied to negative values
 252                 - negative numbers displayed correctly in different bases
 253                 - second undo redoes
 254                 - fixed %
 255                 - stack command (cursor up) cycles through values in stack
 256 1.09 0409270057 - all key aliases moved to module DCT::Bindings
 257      0409291215 - number of menu items depends on screen width
 258      0410112130 - hooks allowing for extra code at reload, showentry, and precmd
 259            2150 - all menu related functions moved to menu.pm
 260            2205 - unit conversion out of main program (entirely into unitconv.pm)
 261      0410120150 - backspace becomes "back" (soft drop, like old "drop")
 262                 - normal drop command (alt+bs) removes input/stack value at once
 263            0213 - $val{frac} default undefined instead of 0
 264 1.10 0410120245 - fixed backspace with undef fraction
 265      0410130020 - altered stack not redrawn after undo
 266      0410132200 - digits added/removed to/from integer part in correct number base
 267      0410142145 - allow modules to not load but without error
 268                 - display welcome at startup, also showing version and modules
 269      0410150000 - preaction hook; undo functionality moved to module
 270                 - only first module run of multiple with the same name
 271            0015 - invalid commands shown as strings instead of character codes
 272 =cut