3 # descalc - desktop calculator
5 # simple modular reverse polish notition calculator
14 our $VERSION = "1.14";
17 use vars qw(@stack %val %set %alias %action %hook @menu);
20 base => 10, # decimal; set using commands bin/oct/dec/hex/base
21 # numb => 0, # fixed scientific engineering
23 height => 4, # stack depth (lines of stack plus one)
24 width => 42, # limit value precision, stetch menu
27 %alias = (' '=>"enter", "\004"=>"quit"); # rudimentary default key bindings
31 local $_ = defined $val{i} ? $val{i} : $stack[0];
33 return defined $_ ? $_ : ();
36 "chs" => [ 1, sub { -$_[0] }], # negative
38 "drop" => [ 1, sub { defined $val{i} ? '' : () }], # drop
39 "back" => [ 1, sub { () }], # drop essentially
40 "clear" => [ 0, sub { @stack = (); undef %val; () }], # clear all
42 "version" => [-2, sub {
43 error("Desktop Calculator Thingy $VERSION by Shiar"); ()
47 %hook = map {$_=>[]} qw(
48 showerror showall showmenu showstack showentry
49 postentry precmd postcmd preaction postaction init
52 my %redraw = (all=>1); # set flag to refresh whole screen
55 main => [qw(0 prog> mode>mode)], # main
56 mode => [qw(0 number_format angle_measure coord_system)], #1 mode
59 @menu = ($menus{main}); # current menu tree
64 while (my ($obj, $level) = each %obj) {
65 $redraw{$obj} = $level;# if $level>$redraw{$obj};
66 } # queue redraw of given objects
70 $_->($_[0]) for @{$hook{showerror}};
75 my ($parent, $menuname) = (shift, shift);
76 $menus{$menuname} = [0]; # create new menu
77 push @{$menus{$parent}}, "$menuname>$menuname"; # link from parent
78 ref $_ ? addmenu($menuname, @$_) : push @{$menus{$menuname}}, $_
79 for @_; # add menu items (which can be sub-submenus)
85 my ($val, $base, $baseexp) = @_;
86 return '' unless defined $val;
87 return $val if $base==10; # perl can do the decimal values (much faster)
89 $_ = ''; # string to output
91 my $sign = $val<0 and $val = abs $val;
94 my $exp = $val{ex} || 0;
95 while ($int>$base**10) {
100 my $frac = $val-$int;
102 my $char = $int%$base;
103 $_ = ($char<10 ? $char : chr($char+55)) . $_; # add digit [0-9A-Z]
106 $_ .= '.' if $frac>0;
107 for (my $i = 0; length $_<$set{width}-2 && $frac>0; $i++) {
109 my $char = int $frac;
111 $_ .= $char<10 ? $char : chr($char+55);
114 $_ = '-'.$_ if $sign;
115 $_ .= 'e'.showval($exp, $base) if $exp;
123 my @obj = qw(all menu stack); # all possible redraw hooks
124 @obj = grep $redraw{$_}, @obj # keep stuff specified in %redraw
125 unless $redraw{all}; # all keeps everything
126 $_->() for map @{$hook{"show$_"}}, @obj; # call show$obj hooks
128 } # do necessary redrawing (queued by &redraw)
131 my $entry = showval($val{i}, $set{base}, $val{ex});
132 $entry .= $_->() for @{$hook{postentry}}; # additional text after val
133 $entry .= $val{alpha} if exists $val{alpha}; # manual command
134 $_->($entry) for @{$hook{showentry}};
139 my $key = shift; # key pressed
140 # command to run into $_ (alias maps keys to commands)
141 $_ = exists $alias{$key} ? $alias{$key} : $key;
142 # manual command entered - make that the new command
143 $_ eq "enter" and exists $val{alpha} and $_ = delete $val{alpha};
145 for my $cmd (@{$hook{precmd}}) {
146 $cmd->() and return; # command was handled by function if returns true
149 exit if $_ eq "quit"; # break out of loop
151 if ($_ eq "refresh") {
155 elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
156 if (defined $val{i}) {
157 unshift @stack, $val{i};
160 } # enter present value
163 $val{alpha} = substr $val{alpha}, 0, -1 or delete $val{alpha};
165 elsif ($_ eq "drop") {
169 $val{alpha} .= $key =~ /^\033(.)/ ? uc $1 : lc $key;
171 } # manual command entry
173 elsif (/^[\da-f]$/) {
174 m/^[a-z]$/ and $_ = ord($_)-87; # digit>9
175 $val{i} = 0 unless defined $val{i};
176 $_ = -$_ if $val{i}<0; # substract from negative value
177 $val{i} = ($val{frac} and $val{frac} *= 10)
178 ? $val{i}+$_/$val{frac} # add digit to fraction
180 ? $val{ex} = $val{ex}*$set{base}+$_ # digit to exponent
181 : $val{i}*$set{base}+$_; # add digit to integer part
184 $val{i} = 0 unless defined $val{i};
187 elsif ($_ eq "eex") {
188 $val{i} = 1 unless defined $val{i};
191 elsif ($_ eq "chs" and defined $val{i}) {
194 elsif ($_ eq "back" and defined $val{i}) {
195 $val{i} = ($val{frac} and $val{frac} = int $val{frac}/10)
196 ? int($val{i}*$val{frac})/$val{frac} # backspace fraction digit
197 : int $val{i}/$set{base} # backspace digit in integer part
200 elsif (/>([\w ]+)$/) {
201 unshift @menu, $menus{$1}; # go to submenu
205 elsif (exists $action{$_}) {
206 my ($action, $type, $cmd) = ($_, @{$action{$_}});
207 unshift @stack, $action{enter}[1]->()
208 if $type>0 and defined $val{i}; # auto enter
210 if ($type>0 and $type>@stack) {
211 error("insufficient stack arguments for operation");
213 } # insufficient arguments
215 $_->($type, $action) for @{$hook{preaction}};
216 # put return value(s) of stack-modifying operations (type>=0) at stack
217 $type<0 ? $cmd->() : unshift @stack, $cmd->(splice @stack, 0, $type);
218 $_->($type, $action) for @{$hook{postaction}};
220 redraw(stack=>1) if $type>=-1; # redraw stack
224 $_ = m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_;
225 error("unrecognised command: $_"); # show string or character codes
230 our %modules; # loaded modules
233 $modskip{substr $_, 1}++ for grep /^-/, @ARGV;
236 our $path = Cwd::abs_path($0); # resolve symlinks first
237 $path = substr($path, 0, rindex($path, '/')+1) || './';
238 # or just use FindBin
239 opendir my($moddir), $path;
240 for my $module (sort readdir $moddir) { # glob "*.pm"
241 $module =~ /^\d{2}_([a-z0-9-]+)(?:_(\w+))?\.pm$/ or next;
242 # files named 00_class_name.pm; ($1, $2) = (class, name)
243 next if exists $modskip{$1} or $2 && exists $modskip{$2};
244 next if defined $modules{$1}; # no such module already loaded
246 # defined ($_ = do $module) # return value means no errors
247 # ? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
248 # : print STDERR $@, "error loading $module\n\n";
249 defined($_ = eval {do $path.$module}) # return value means no errors
250 ? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
251 : print STDERR $@, "error loading $path$module\n";
254 } # find external modules
256 printf STDERR "descalc %s by Shiar (%s)\n", $VERSION, join "; ",
257 map join(" ", grep $_, $_, $modules{$_}{name}, $modules{$_}{version}),
261 $_->() for @{$hook{init}};
262 $menus{main}[10] = "quit";
264 $hook{main}->(); #todo: error if nothing loaded