# DCT - desktop calculator thingy
-# reverse polish notition calculator using curses
+# simple modular reverse polish notition calculator
# by Shiar <shiar.org>
-# 1.01 06-18 - start (curses, some basic commands)
-# 1.02 06-20 - function keys select command/submenu from (sub)menu
-# - backspace to undo last digit
-# 1.03 06-25 - values displayable in arbitrary base
-# - can enter fractions (.) and negative values (_)
-# 1.04 08-04 14:45 - error dialog (don't mess up screen)
-# - manual command input using capital letters
-# - ^L redraws screen
-# pre 09-09 22:00 - overhaul in stack handling
-# 1.05 09-10 19:45 - hp48-like drop (backspace but not editing value)
-# - error on insufficient arguments for command
-# - command backspacing
-# - some unit conversion (mostly lengths) from menu
-# - q for sq(rt) (formerly quit, now only ^D/quit)
-# 1.06 09-15 23:10 - menu contents in module
-# - new commands: a?(sin|cos|tan)h, inv, !, rand
-# - x and v shortkeys
-# 1.07 09-24 23:50 - numeric modifiers hardcoded instead of in action hash
-# - action undo: last stack alteration can be undone
-# - enter on no value repeats last val on stack
-# - new commands: sr/sr, shortkeys ( )
-# 1.08 09-26 22:10 - additional digits were not correctly applied to negative values
-# - negative numbers displayed correctly in different bases
-# - second undo redoes
-# - fixed %
-# - stack command (cursor up) cycles through values in stack
-# 09-27 00:57 - all key aliases moved to module DCT::Bindings
-our $VERSION = 1.008;
-
use strict;
use warnings;
use utf8;
-use Term::ReadKey;
-use Curses;
-use DCT::Menu 1.006;
-use DCT::Bindings 1.008;
+use Data::Dumper;
-initscr;
-ReadMode 3; # cbreak mode
-END {
- ReadMode 0;
- endwin;
-} # restore terminal on quit
+our $VERSION = "1.12.1";
-my %val = qw(i 0 frac 0); # i, frac
-my @stack;
-my %var;
+use vars qw(@stack %val %set %alias %action %hook);
-my %set = (
+%set = (
base => 10, # decimal; set using commands bin/oct/dec/hex/base
- numb => 0, # fixed scientific engineering
- card => 1, # degrees radians grades
- coord => 0, # cartesian polar spherical
- complex => 0, # real complex
-
- height => $LINES<3 ? 4 : $LINES-3, # stack depth (lines of stack plus one)
- width => $COLS || 42, # limit value precision, stetch menu
- menushow => 12, # menu items to show simultaneously
+# numb => 0, # fixed scientific engineering
+
+ height => 4, # stack depth (lines of stack plus one)
+ width => 42, # limit value precision, stetch menu
); # %set
-#%alias = (' '=>'enter', "\004"=>'quit', 'q'=>'quit') unless %alias; # rudimentary defaults
+%alias = (' '=>"enter", "\004"=>"quit"); # rudimentary default key bindings
-my @menu = @{$menus[0]};
-my $menumin = 0;
+%action = (
+ "enter" => [ 0, sub {
+ local $_ = defined $val{i} ? $val{i} : $stack[0];
+ undef %val;
+ return defined $_ ? $_ : ();
+ }], # duplication
-my %action = (
- 'more' => [-1, sub {
- $menumin += $set{menushow};
- $menumin = 0 if $menumin>=$#menu;
- showmenu();
- }], # tab
- 'chs' => [0, sub {$stack[0] = -$stack[0]}], # negative
+ "chs" => [ 1, sub { -$_[0] }], # negative
- 'drop' => [0, sub {shift @stack}], # backspace
- 'clear'=> [0, sub {@stack = (); %val = (i=>undef, frac=>0) }], # clear all #todo: if (val{i}) delete char after cursor
+ "drop" => [ 1, sub { defined $val{i} ? '' : () }], # drop
+ "back" => [ 1, sub { () }], # drop essentially
+ "clear" => [ 0, sub { @stack = (); undef %val; () }], # clear all
- 'enter'=> [0, sub {
- unshift @stack, defined $val{i} ? $val{i} : $stack[0];
- %val = (i=>undef, frac=>0);
- }], # duplication
-
-# 'undo' => [0, sub {@stack = @{ $var{undo} }}], # undo
- 'undo' => [0, sub {($var{undo}, @stack) = ([@stack], @{ $var{undo} }) }], # undo
- 'swap' => [1, sub {@stack[0, 1] = @stack[1, 0]}], # swap x<->y
- 'stack'=> [0, sub {
- $var{stackpos} = 0 unless $var{stackpos}; # initialize
- $var{stackpos} %= @stack; # cycle
- $val{i} = $stack[$var{stackpos}++];
+ "swap" => [ 2, sub { reverse @_ }], # swap x<->y
+ "stack" => [-2, sub {
+ my $stackpos if 0;
+ $stackpos = 0 unless $stackpos; # initialize
+ $stackpos %= @stack; # cycle
+ $val{i} = $stack[$stackpos++];
}], # stack
- 'version' => [0, sub{error("Desktop Calculator Thingy $VERSION by Shiar")}], # version
-
- '=' => [1, sub {$var{a} = $stack[0]}], # copy
- '?' => [1, sub {$var{a} = shift @stack}], # assign
-
- '+' => [2, sub {$stack[1] += shift @stack}], # addition
- '-' => [2, sub {$stack[1] -= shift @stack}], # substraction
- '*' => [2, sub {$stack[1] *= shift @stack}], # multiplication
- '/' => [2, sub {$stack[1] /= shift @stack}], # division
- 'mod' => [2, sub {$stack[1] %= shift @stack}], # modulo
-
- 'inv' => [1, sub {$stack[0] = 1 / $stack[0]}], # 1/x
- 'sqrt' => [1, sub {$stack[0] = sqrt $stack[0]}], # square root
- 'sq' => [1, sub {$stack[0] *= $stack[0]}], # squared
- '^' => [2, sub {$stack[1] **= shift @stack}], # exponentiation
- 'xroot'=> [2, sub {$stack[1] **= 1 / shift @stack}], # x-root of y
-
- 'log' => [1, sub {$stack[0] = log($stack[0]) / log(10)}], # logarithm
- 'alog' => [1, sub {$stack[0] = 10 ** $stack[0]}], # 10^x
- 'ln' => [1, sub {$stack[0] = log $stack[0]}], # natural logaritm
- 'lnp1' => [1, sub {$stack[0] = log($stack[0]+1)}], # ln(x+1)
- 'exp' => [1, sub {$stack[0] = exp($stack[0])}], # e^x
- 'expm' => [1, sub {$stack[0] = exp($stack[0])-1}], # exp(x)-1
-
- 'sin' => [1, sub {$stack[0] = sin $stack[0]}], # sine
- 'asin' => [1, sub {$stack[0] = atan2($stack[0], sqrt(1 - $stack[0]*$stack[0]))}], # inverse sine
- 'cos' => [1, sub {$stack[0] = cos $stack[0]}], # cosine
- 'acos' => [1, sub {$stack[0] = atan2(sqrt(1 - $stack[0]*$stack[0]), $stack[0])}], # inverse cosine
- 'tan' => [1, sub {$stack[0] = sin($stack[0]) / cos($stack[0])}], # tangent
-# 'atan' => [1, sub {}], # arctangent
-
- 'sinh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/2}], # hyperbolic sine
- 'cosh' => [1, sub {$stack[0] = ( exp($stack[0]) + exp(-$stack[0]) )/2}], # hyperbolic cosine
- 'tanh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/( exp($stack[0]) + exp(-$stack[0]) )}], # hyperbolic tangent (sinh/cosh)
- 'asinh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2+1)+$stack[0] )}], # inverse hyperbolic sine
- 'acosh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2-1)+$stack[0] )}], # inverse hyperbolic cosine
- 'atanh'=> [1, sub {$stack[0] = log( (1+$stack[0]) / (1-$stack[0]) )/2}], # inverse hyperbolic tangent
-
- '%' => [2, sub {$stack[0] = shift(@stack)/$stack[0]}], # percentage
- '%ch' => [2, sub {$val{i} = 100*(shift(@stack)-$val{i})/$val{i}}], # percentage change
- '%t' => [2, sub {$val{i} = 100*$val{i}/shift(@stack)}], # percentage total
-
- 'and' => [2, sub {$stack[1] &= shift @stack}], # bitwise and
- 'or' => [2, sub {$stack[1] |= shift @stack}], # bitwise or
- 'xor' => [2, sub {$stack[1] ^= shift @stack}], # bitwise xor
- 'not' => [2, sub {$stack[0] = ~$stack[0]}], # bitwise not
- 'sl' => [1, sub {$stack[0] *= 2}], # shift left
- 'sr' => [1, sub {$stack[0] /= 2}], # shift right
-
- 'abs' => [1, sub {$stack[0] = abs $stack[0]}], # absolute #todo
- 'sign' => [1, sub {$stack[0] = $stack[0] <=> 0}], # sign
- 'ip' => [1, sub {$stack[0] = int $stack[0]}], # integer part
- 'fp' => [1, sub {$stack[0] -= int $stack[0]}], # fractional part
-
- 'rnd' => [1, sub {local $_ = 10**shift @stack; $val{i} = int(($val{i}+.5)*$_)/$_}], # round
- 'trnc' => [1, sub {local $_ = 10**shift @stack; $val{i} = int($val{i}*$_)/$_}], # truncate
- 'floor'=> [1, sub {$stack[0] = int $stack[0]}], # floor
- 'ceil' => [1, sub {$stack[0] = int $stack[0]+.9999}], # ceil
-
- 'min' => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_<$stack[0] }], # minimum
- 'max' => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_>$stack[0] }], # maximum
-
- 'dec' => [0, sub {$set{base} = 10}], # decimal
- 'bin' => [0, sub {$set{base} = 2}], # binary
- 'oct' => [0, sub {$set{base} = 8}], # octal
- 'hex' => [0, sub {$set{base} = 16}], # hexadecimal
- 'base' => [1, sub {$set{base} = shift @stack}], # alphanumerical
-
- '!' => [1, sub {local $_ = $stack[0]; $stack[0] *= $_ while --$_>1}], # factor
- 'rand' => [0, sub {unshift @stack, rand}], # random value <1
+ "version" => [-2, sub {
+ error("Desktop Calculator Thingy $VERSION by Shiar"); ()
+ }], # version
); # %action
-my %unit;
-{
-my $i = 0;
-$unit{$_->[0]} = { name=>$_->[0], type=>$i, val=>$_->[1] } for map {$i++; @$_} (
- [
- ['m', 1],
- ['cm', .01],
- ['mm', .001],
- ['km', 1000],
- ['ft', .3048],
- ['in', .0254],
- ['yd', .9144],
- ['mile', 1609.344],
- ['nmile', 1852],
- ['lyr', 9.46052840488e+15],
- ['mil', 2.54e-5],
- # _m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
- # _nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
- ], # lengths
- [
- ['m^3', 1],
- ['cm^3', 1e-6],
- ['ft^3', .028316846592],
- ['in^3', 1.6387064e-5],
- ], # volume
-);
-} # create unit table
+my $redraw = 2; # set flag to refresh whole screen
+
+sub redraw($) {
+ # queue a redraw of level $_[0]
+ $redraw = $_[0] if $_[0]>$redraw;
+} # redraw
sub error($) {
- attron(A_REVERSE);
- addstr(0, 0, shift);
- attroff(A_REVERSE);
- clrtoeol;
- refresh;
-
- ReadKey; # wait for confirm
- 1 while defined (ReadKey -1); # clear key buffer
+ $_->($_[0]) for @{$hook{showerror}};
+ redraw(2);
} # error
-sub showval($$);
-sub showval($$) {
- my ($val, $base) = @_;
+sub showval;
+sub showval {
+ my ($val, $base, $baseexp) = @_;
return '' unless defined $val;
return $val if $base==10;
- my $sign = $val<0;
- $val = abs $val;
- my $int = int $val;
- my $frac = $val-$int;
- my $exp = 0;
-
my $txt = '';
+ my $sign = $val<0 and $val = abs $val;
+ my $int = int $val;
+
+ my $exp = $val{ex} || 0;
while ($int>$base**10) {
$int /= $base;
$exp++;
} # exponent part
+
+ my $frac = $val-$int;
while ($int>=1) {
my $char = $int%$base;
- $txt = ($char<10 ? $char : chr($char+55)).$txt;
+ $txt = ($char<10 ? $char : chr($char+55)) . $txt;
$int /= $base;
} # integer part
-
$txt .= '.' if $frac>0;
for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
$frac *= $base;
return $txt;
} # showval
-sub showstack() {
- for (0..@stack-1) {
- addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base}));
- clrtoeol;
- } # show stack
- clrtoeol($set{height}-$#stack-1, 1);
-} # showstack
-
-sub showmenu() {
- clrtoeol($set{height}+2, 1);
- my $nr = 0;
- for (grep exists $menu[$_], $menumin+1..$menumin+$set{menushow}) {
- my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
- addstr($set{height}+2, $set{width}/$set{menushow}*($nr++), $_);
- attron(A_REVERSE);
- addstr($s);
- attroff(A_REVERSE);
- addch('>') if $sub;
- } # display menu txts
-} # showmenu
-
-
-DRAW:
-clear;
-showmenu();
-showstack();
-addstr($set{height}+1, 0, "> "); # prompt
-
-while (1) {
- addstr($set{height}+1, 2, showval($val{i}, $set{base}));
- addstr('_'.$val{unit}{name}) if exists $val{unit};
- addstr($val{bla}) if exists $val{bla};
- clrtoeol;
- refresh;
-
- $_ = ReadKey;
- if ($_ eq chr 27) {
- while (defined (my $key = ReadKey -1)) {
- $_ .= $key;
- } # read additional keys
- } # escape sequence
-
- exists $alias{$_} and $_ = $alias{$_}; # command shortkeys
- if (exists $falias{$_}) {
- unless ($_ = $menu[$falias{$_}]) {
- error("* no such menu entry *");
- goto DRAW;
- }
- } # function key
-
- $_ = delete $val{bla} if exists $val{bla} and $_ eq 'enter';
- if ($_ eq 'quit') {
- last;
- } # quit
- elsif ($_ eq 'refresh') {
- goto DRAW;
+sub draw {
+ if ($redraw) {
+ if ($redraw>1) {
+ $_->() for @{$hook{refresh}};
+ }
+ $_->() for @{$hook{showstack}};
+ $redraw = 0;
+ } # do necessary redrawing
+
+ {
+ my $entry = showval($val{i}, $set{base}, $val{ex});
+ $entry .= $_->() for @{$hook{postentry}};
+ $entry .= $val{alpha} if exists $val{alpha};
+ $_->($entry) for @{$hook{showentry}};
+ } # show entry
+} # draw
+
+sub onkey($) {
+ my $key = shift;
+ $_ = exists $alias{$key} ? $alias{$key} : $key; # command (alias maps keys to commands)
+ $_ eq "enter" and exists $val{alpha} and $_ = delete $val{alpha}; # use manual command
+
+ for my $cmd (@{$hook{precmd}}) {
+ $cmd->() and return; # command was handled by function if returns true
+ } # precmd functions
+
+ exit if $_ eq "quit"; # break out of loop
+
+ if ($_ eq "refresh") {
+ redraw(2);
} # refresh
- elsif (exists $val{bla} or /^[A-Z]$/) {
+ elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
if (defined $val{i}) {
unshift @stack, $val{i};
- %val = (i=>undef, frac=>0);
- showstack();
+ undef %val;
+ redraw(1);
} # enter present value
- if ($_ eq "drop") {
- $val{bla} = substr $val{bla}, 0, -1 or delete $val{bla};
+
+ if ($_ eq "back") {
+ $val{alpha} = substr $val{alpha}, 0, -1 or delete $val{alpha};
} # backspace
+ elsif ($_ eq "drop") {
+ delete $val{alpha};
+ } # drop
else {
- $val{bla} .= lc $_;
+ $val{alpha} .= $key =~ /^\033(.)/ ? uc $1 : lc $key;
} # add character
- } # manual command
+ } # manual command entry
- elsif (/^\d$/) {
+ elsif (/^[\da-f]$/) {
+ m/^[a-z]$/ and $_ = ord($_)-87; # digit>9
$val{i} = 0 unless defined $val{i};
- $_ = -$_ if $val{i}<0;
- $val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_;
- }
+ $_ = -$_ if $val{i}<0; # substract from negative value
+ $val{i} = ($val{frac} and $val{frac} *= 10)
+ ? $val{i}+$_/$val{frac} # add digit to fraction
+ : defined $val{ex} ? $val{ex} = $val{ex}*$set{base}+$_ # digit to exponent
+ : $val{i}*$set{base}+$_; # add digit to integer part
+ } # digit
elsif ($_ eq '.') {
$val{i} = 0 unless defined $val{i};
$val{frac} = 1;
} # decimal point
- elsif ($_ eq 'eex') {
+ elsif ($_ eq "eex") {
$val{i} = 1 unless defined $val{i};
- #todo
+ $val{ex} = 0;
} # exponent
- elsif ($_ eq 'chs' and defined $val{i}) {
+ elsif ($_ eq "chs" and defined $val{i}) {
$val{i} = -$val{i};
} # change sign
- elsif ($_ eq 'drop' and defined $val{i}) {
- $val{i} = ($val{frac} = int $val{frac}/10)
- ? int($val{i}*$val{frac})/$val{frac} : int $val{i}/10
+ elsif ($_ eq "back" and defined $val{i}) {
+ $val{i} = ($val{frac} and $val{frac} = int $val{frac}/10)
+ ? int($val{i}*$val{frac})/$val{frac} # backspace fraction digit
+ : int $val{i}/$set{base} # backspace digit in integer part
} # backspace
- elsif (exists $action{$_} or /^\d$/) {
- my ($type, $cmd) = @{ $action{$_} };
- if ($type>0 and defined $val{i}) {
- unshift @stack, $val{i};
- %val = (i=>undef, frac=>0);
- } # auto enter
+ elsif (exists $action{$_}) {
+ my ($action, $type, $cmd) = ($_, @{$action{$_}});
+ unshift @stack, $action{enter}[1]->() if $type>0 and defined $val{i}; # auto enter
+
if ($type>0 and $type>@stack) {
- error("* insufficient stack arguments for operation *");
- goto DRAW;
+ error("insufficient stack arguments for operation");
+ next;
} # insufficient arguments
- $var{undo} = [@stack] if $type>=0 and $_ ne 'undo';
- $cmd->();
- showstack() if $type>=0;
- } # some operation
- elsif (/>(\d+)$/) {
- @menu = @{ $menus[$1] };
- $menumin = 0;
- showmenu();
- } # submenu
-
- elsif ($_ =~ /^_/) {{
- $_ = $unit{substr $_, 1} or next;
- if (exists $val{unit} and $val{unit}{type}==$_->{type}) {
- unshift @stack, $val{i} if defined $val{i};
- $stack[0] *= delete($val{unit})->{val} / $_->{val};
- showstack();
- %val = (i=>undef, frac=>0);
- } # convert
- else {
- $val{unit} = $_;
- } # set source unit
- }} # conversion
+ $_->($type, $action) for @{$hook{preaction}};
+ # put return value(s) of stack-modifying operations (type>=0) at stack
+ $type<0 ? $cmd->() : unshift @stack, $cmd->(splice @stack, 0, $type);
+ $_->($type, $action) for @{$hook{postaction}};
+
+ redraw(1) if $type>=-1; # redraw stack
+ } # some operation
else {
- error("* unrecognised command: ".join(' ', map ord, split //, $_)." *");
- goto DRAW; # screen messed up
+ error(
+ "unrecognised command: " # show string or character codes
+ . (m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_)
+ );
} # error
-} # input loop
+} # onkey
+
+
+our %modules;
+{
+ my %modskip;
+ $modskip{substr $_, 1}++ for grep /^-/, @ARGV;
+ opendir my $moddir, ".";
+ for my $module (sort readdir $moddir) { # glob "*.pm"
+ $module =~ /^\d{2}_([a-z0-9-]+)(?:_(\w+))?\.pm$/ or next;
+ # files named 00_class_name.pm; ($1, $2) = (class, name)
+ next if exists $modskip{$1} or $2 && exists $modskip{$2};
+ next if defined $modules{$1}; # no such module already loaded
+ defined ($_ = do $module) # return value means no errors
+ ? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
+ : print STDERR $@, "error loading $module\n\n";
+ } # load modules
+ closedir $moddir;
+} # find external modules
+
+printf STDERR "DCT %s by Shiar (%s)\n", $VERSION, join "; ",
+ map join(" ", grep $_, $_, $modules{$_}{name}, $modules{$_}{version}),
+ keys %modules;
+
+
+$_->() for @{$hook{init}};
+
+$hook{main}->();
git.shiar.nl / descalc.git / blobdiff