#!/usr/bin/perl
-# DCT - desktop calculator thingy
+# descalc - desktop calculator
# simple modular reverse polish notition calculator
# by Shiar <shiar.org>
use Data::Dumper;
-our $VERSION = "1.12.1";
+our $VERSION = "1.14";
-use vars qw(@stack %val %set %alias %action %hook);
+
+use vars qw(@stack %val %set %alias %action %hook @menu);
%set = (
base => 10, # decimal; set using commands bin/oct/dec/hex/base
"back" => [ 1, sub { () }], # drop essentially
"clear" => [ 0, sub { @stack = (); undef %val; () }], # clear all
- "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" => [-2, sub {
error("Desktop Calculator Thingy $VERSION by Shiar"); ()
}], # version
); # %action
+%hook = map {$_=>[]} qw(
+ showerror showall showmenu showstack showentry
+ postentry precmd postcmd preaction postaction init
+);
+
+my %redraw = (all=>1); # set flag to refresh whole screen
+
+my %menus = (
+ main => [qw(0 prog> mode>mode)], # main
+ mode => [qw(0 number_format angle_measure coord_system)], #1 mode
+); # %menus
+
+@menu = ($menus{main}); # current menu tree
-my $redraw = 2; # set flag to refresh whole screen
-sub redraw($) {
- # queue a redraw of level $_[0]
- $redraw = $_[0] if $_[0]>$redraw;
+sub redraw(%) {
+ my %obj = @_;
+ while (my ($obj, $level) = each %obj) {
+ $redraw{$obj} = $level;# if $level>$redraw{$obj};
+ } # queue redraw of given objects
} # redraw
sub error($) {
$_->($_[0]) for @{$hook{showerror}};
- redraw(2);
+ redraw(all=>1);
} # error
+sub addmenu {
+ my ($parent, $menuname) = (shift, shift);
+ $menus{$menuname} = [0]; # create new menu
+ push @{$menus{$parent}}, "$menuname>$menuname"; # link from parent
+ ref $_ ? addmenu($menuname, @$_) : push @{$menus{$menuname}}, $_
+ for @_; # add menu items (which can be sub-submenus)
+ return $menuname;
+} # addmenu
+
sub showval;
sub showval {
my ($val, $base, $baseexp) = @_;
return '' unless defined $val;
- return $val if $base==10;
+ return $val if $base==10; # perl can do the decimal values (much faster)
- my $txt = '';
+ $_ = ''; # string to output
my $sign = $val<0 and $val = abs $val;
my $int = int $val;
my $frac = $val-$int;
while ($int>=1) {
my $char = $int%$base;
- $txt = ($char<10 ? $char : chr($char+55)) . $txt;
+ $_ = ($char<10 ? $char : chr($char+55)) . $_; # add digit [0-9A-Z]
$int /= $base;
} # integer part
- $txt .= '.' if $frac>0;
- for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
+ $_ .= '.' if $frac>0;
+ for (my $i = 0; length $_<$set{width}-2 && $frac>0; $i++) {
$frac *= $base;
my $char = int $frac;
$frac -= $char;
- $txt .= $char<10 ? $char : chr($char+55);
+ $_ .= $char<10 ? $char : chr($char+55);
} # fraction part
- $txt = "-".$txt if $sign;
- $txt .= 'e'.showval($exp, $base) if $exp;
+ $_ = '-'.$_ if $sign;
+ $_ .= 'e'.showval($exp, $base) if $exp;
- return $txt;
+ return $_;
} # showval
sub draw {
- if ($redraw) {
- if ($redraw>1) {
- $_->() for @{$hook{refresh}};
- }
- $_->() for @{$hook{showstack}};
- $redraw = 0;
- } # do necessary redrawing
+ if (%redraw) {
+ my @obj = qw(all menu stack); # all possible redraw hooks
+ @obj = grep $redraw{$_}, @obj # keep stuff specified in %redraw
+ unless $redraw{all}; # all keeps everything
+ $_->() for map @{$hook{"show$_"}}, @obj; # call show$obj hooks
+ %redraw = ();
+ } # do necessary redrawing (queued by &redraw)
{
my $entry = showval($val{i}, $set{base}, $val{ex});
- $entry .= $_->() for @{$hook{postentry}};
- $entry .= $val{alpha} if exists $val{alpha};
+ $entry .= $_->() for @{$hook{postentry}}; # additional text after val
+ $entry .= $val{alpha} if exists $val{alpha}; # manual command
$_->($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
+ my $key = shift; # key pressed
+ # command to run into $_ (alias maps keys to commands)
+ $_ = exists $alias{$key} ? $alias{$key} : $key;
+ # manual command entered - make that the new command
+ $_ eq "enter" and exists $val{alpha} and $_ = delete $val{alpha};
for my $cmd (@{$hook{precmd}}) {
$cmd->() and return; # command was handled by function if returns true
exit if $_ eq "quit"; # break out of loop
if ($_ eq "refresh") {
- redraw(2);
+ redraw(all=>1);
} # refresh
elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
if (defined $val{i}) {
unshift @stack, $val{i};
undef %val;
- redraw(1);
+ redraw(stack=>1);
} # enter present value
if ($_ eq "back") {
$_ = -$_ 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
+ : 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};
: int $val{i}/$set{base} # backspace digit in integer part
} # backspace
+ elsif (/>([\w ]+)$/) {
+ unshift @menu, $menus{$1}; # go to submenu
+ redraw(menu=>1);
+ } # goto submenu
+
elsif (exists $action{$_}) {
my ($action, $type, $cmd) = ($_, @{$action{$_}});
- unshift @stack, $action{enter}[1]->() if $type>0 and defined $val{i}; # auto enter
+ 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");
$type<0 ? $cmd->() : unshift @stack, $cmd->(splice @stack, 0, $type);
$_->($type, $action) for @{$hook{postaction}};
- redraw(1) if $type>=-1; # redraw stack
+ redraw(stack=>1) if $type>=-1; # redraw stack
} # some operation
else {
- error(
- "unrecognised command: " # show string or character codes
- . (m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_)
- );
+ $_ = m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_;
+ error("unrecognised command: $_"); # show string or character codes
} # error
} # onkey
-our %modules;
+our %modules; # loaded modules
{
my %modskip;
$modskip{substr $_, 1}++ for grep /^-/, @ARGV;
- opendir my $moddir, ".";
+
+ require Cwd;
+ our $path = Cwd::abs_path($0); # resolve symlinks first
+ $path = substr($path, 0, rindex($path, '/')+1) || './';
+ # or just use FindBin
+ opendir my($moddir), $path;
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
+
+# defined ($_ = do $module) # return value means no errors
+# ? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
+# : print STDERR $@, "error loading $module\n\n";
+ defined($_ = eval {do $path.$module}) # return value means no errors
? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
- : print STDERR $@, "error loading $module\n\n";
+ : print STDERR $@, "error loading $path$module\n";
} # load modules
closedir $moddir;
} # find external modules
-printf STDERR "DCT %s by Shiar (%s)\n", $VERSION, join "; ",
+printf STDERR "descalc %s by Shiar (%s)\n", $VERSION, join "; ",
map join(" ", grep $_, $_, $modules{$_}{name}, $modules{$_}{version}),
keys %modules;
$_->() for @{$hook{init}};
+$menus{main}[10] = "quit";
-$hook{main}->();
+$hook{main}->(); #todo: error if nothing loaded
git.shiar.nl / descalc.git / blobdiff