3 # DCT - desktop calculator thingy
5 # simple modular reverse polish notition calculator
15 our $VERSION = "1.11.2";
17 use vars qw(@stack %val %set %alias %action %hook);
18 my $redraw = 2; # set flag to refresh whole screen
21 base => 10, # decimal; set using commands bin/oct/dec/hex/base
22 # numb => 0, # fixed scientific engineering
23 # coord => 0, # cartesian polar spherical
24 # complex => 0, # real complex
26 height => 4, # stack depth (lines of stack plus one)
27 width => 42, # limit value precision, stetch menu
30 %alias = (' '=>"enter", "\004"=>"quit"); # rudimentary default key bindings
34 local $_ = defined $val{i} ? $val{i} : $stack[0];
36 return defined $_ ? $_ : ();
39 "chs" => [ 1, sub { -$_[0] }], # negative
41 "drop" => [ 1, sub { defined $val{i} ? '' : () }], # drop
42 "back" => [ 1, sub { () }], # drop essentially
43 "clear" => [ 0, sub { @stack = (); undef %val; () }], # clear all
45 "swap" => [ 2, sub { reverse @_ }], # swap x<->y
48 $stackpos = 0 unless $stackpos; # initialize
49 $stackpos %= @stack; # cycle
50 $val{i} = $stack[$stackpos++];
53 "version" => [-2, sub {
54 error("Desktop Calculator Thingy $VERSION by Shiar"); ()
60 # queue a redraw of level $_[0]
61 $redraw = $_[0] if $_[0]>$redraw;
65 $_->($_[0]) for @{$hook{showerror}};
71 my ($val, $base, $baseexp) = @_;
72 return '' unless defined $val;
73 return $val if $base==10;
77 my $sign = $val<0 and $val = abs $val;
80 my $exp = $val{ex} || 0;
81 while ($int>$base**10) {
88 my $char = $int%$base;
89 $txt = ($char<10 ? $char : chr($char+55)) . $txt;
92 $txt .= '.' if $frac>0;
93 for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
97 $txt .= $char<10 ? $char : chr($char+55);
100 $txt = "-".$txt if $sign;
101 $txt .= 'e'.showval($exp, $base) if $exp;
108 for my $module (sort glob "*.pm") {
109 next unless $module =~ /^\d{2}_([a-z0-9-]+)(?:_(\w+))?\.pm$/; # filename 00_class_name.pm
110 next if defined $modules{$1}; # no such module already loaded
111 # next if $1 eq "disp" and $2 eq "curses";
112 defined ($_ = do $module) # return value means no errors
113 ? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
114 : print STDERR $@, "error loading $module\n\n";
117 printf STDERR "DCT %s by Shiar (%s)\n", $VERSION, join "; ",
118 map join(" ", grep $_, $_, $modules{$_}{name}, $modules{$_}{version}), keys %modules;
120 ReadMode 3; # cbreak mode
121 END { ReadMode 0; } # restore terminal on quit
123 $_->() for @{$hook{init}};
128 $_->() for @{$hook{refresh}};
130 $_->() for @{$hook{showstack}};
135 my $entry = showval($val{i}, $set{base}, $val{ex});
136 $entry .= $_->() for @{$hook{postentry}};
137 $entry .= $val{alpha} if exists $val{alpha};
138 $_->($entry) for @{$hook{showentry}};
141 my $key = ReadKey; # wait for user input
142 if ($key eq chr 27) {
143 $key .= $_ while defined ($_ = ReadKey(-1)); # read additional keys
145 $_ = exists $alias{$key} ? $alias{$key} : $key; # command (alias maps keys to commands)
146 $_ = delete $val{alpha} if $_ eq "enter" and exists $val{alpha}; # use manual command
148 for my $cmd (@{$hook{precmd}}) {
149 $cmd->() and next LOOP; # command was handled by function if returns true
152 last if $_ eq 'quit'; # break out of loop
154 if ($_ eq 'refresh') {
158 elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
159 if (defined $val{i}) {
160 unshift @stack, $val{i};
163 } # enter present value
166 $val{alpha} = substr $val{alpha}, 0, -1 or delete $val{alpha};
168 elsif ($_ eq "drop") {
172 $val{alpha} .= $key =~ /^\033(.)/ ? uc $1 : lc $key;
174 } # manual command entry
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 : defined $val{ex} ? $val{ex} = $val{ex}*$set{base}+$_ # digit to exponent
183 : $val{i}*$set{base}+$_; # add digit to integer part
186 $val{i} = 0 unless defined $val{i};
189 elsif ($_ eq "eex") {
190 $val{i} = 1 unless defined $val{i};
193 elsif ($_ eq "chs" and defined $val{i}) {
196 elsif ($_ eq "back" and defined $val{i}) {
197 $val{i} = ($val{frac} and $val{frac} = int $val{frac}/10)
198 ? int($val{i}*$val{frac})/$val{frac} # backspace fraction digit
199 : int $val{i}/$set{base} # backspace digit in integer part
202 elsif (exists $action{$_}) {
203 my ($action, $type, $cmd) = ($_, @{$action{$_}});
204 unshift @stack, $action{enter}[1]->() if $type>0 and defined $val{i}; # auto enter
206 if ($type>0 and $type>@stack) {
207 error("insufficient stack arguments for operation");
209 } # insufficient arguments
211 $_->($type, $action) for @{$hook{preaction}};
212 # put return value(s) of stack-modifying operations (type>=0) at stack
213 $type<0 ? $cmd->() : unshift @stack, $cmd->(splice @stack, 0, $type);
214 $_->($type, $action) for @{$hook{postaction}};
216 redraw(1) if $type>=-1; # redraw stack
221 "unrecognised command: " # show string or character codes
222 . (m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_)