use Data::Dumper;
use Term::ReadKey;
-our $VERSION = "1.10.6";
+our $VERSION = "1.11.2";
-use vars qw(@stack %val %var %set %alias %action %hook);
+use vars qw(@stack %val %set %alias %action %hook);
+my $redraw = 2; # set flag to refresh whole screen
%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
+# numb => 0, # fixed scientific engineering
+# coord => 0, # cartesian polar spherical
+# complex => 0, # real complex
height => 4, # stack depth (lines of stack plus one)
width => 42, # limit value precision, stetch menu
"swap" => [ 2, sub { reverse @_ }], # swap x<->y
"stack" => [-2, sub {
- $var{stackpos} = 0 unless $var{stackpos}; # initialize
- $var{stackpos} %= @stack; # cycle
- $val{i} = $stack[$var{stackpos}++];
+ my $stackpos if 0;
+ $stackpos = 0 unless $stackpos; # initialize
+ $stackpos %= @stack; # cycle
+ $val{i} = $stack[$stackpos++];
}], # stack
- "sto" => [ 1, sub { $var{a} = $_[0] }], # copy
- '?' => [ 1, sub { $var{a} = $_[0] }], # assign
-
"version" => [-2, sub {
error("Desktop Calculator Thingy $VERSION by Shiar"); ()
}], # version
); # %action
+sub redraw($) {
+ # queue a redraw of level $_[0]
+ $redraw = $_[0] if $_[0]>$redraw;
+} # redraw
+
sub error($) {
$_->($_[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 @{$hook{showstack}};
-} # showstack
-
-my %modules;
+our %modules;
for my $module (sort glob "*.pm") {
- next unless $module =~ /^\d{2}_(\w+)\.pm$/; # filename 00_name.pm
- next if defined $modules{$1}; # such module already loaded
- defined ($_ = do $module)
- ? (ref $_ and $modules{$1} = $_) # return value means no errors
+ next unless $module =~ /^\d{2}_([a-z0-9-]+)(?:_(\w+))?\.pm$/; # filename 00_class_name.pm
+ next if defined $modules{$1}; # no such module already loaded
+# next if $1 eq "disp" and $2 eq "curses";
+ 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
-printf STDERR "DCT %s by Shiar (%s)\n", $VERSION,
- join "; ", map {"$_ $modules{$_}{version}"} keys %modules;
+printf STDERR "DCT %s by Shiar (%s)\n", $VERSION, join "; ",
+ map join(" ", grep $_, $_, $modules{$_}{name}, $modules{$_}{version}), keys %modules;
ReadMode 3; # cbreak mode
END { ReadMode 0; } # restore terminal on quit
$_->() for @{$hook{init}};
-my $redraw = 1;
LOOP: while (1) {
if ($redraw) {
- $_->() for @{$hook{refresh}};
- showstack();
+ if ($redraw>1) {
+ $_->() for @{$hook{refresh}};
+ }
+ $_->() for @{$hook{showstack}};
$redraw = 0;
} # refresh
{
- my $entry = showval($val{i}, $set{base});
- $entry .= $_ for map $_->(), @{$hook{postentry}};
+ 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
- my $key = ReadKey;
+ my $key = ReadKey; # wait for user input
if ($key eq chr 27) {
$key .= $_ while defined ($_ = ReadKey(-1)); # read additional keys
} # escape sequence
- $_ = $alias{$key} || $key; #if exists $alias{$key}; # command shortkeys
+ $_ = exists $alias{$key} ? $alias{$key} : $key; # command (alias maps keys to commands)
$_ = delete $val{alpha} if $_ eq "enter" and exists $val{alpha}; # use manual command
for my $cmd (@{$hook{precmd}}) {
- next LOOP if $cmd->();
+ $cmd->() and next LOOP; # command was handled by function if returns true
} # precmd functions
- last if $_ eq 'quit';
+ last if $_ eq 'quit'; # break out of loop
if ($_ eq 'refresh') {
- $redraw++;
+ redraw(2);
} # refresh
elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
if (defined $val{i}) {
unshift @stack, $val{i};
undef %val;
- showstack();
+ redraw(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
} # digit
elsif ($_ eq '.') {
} # decimal point
elsif ($_ eq "eex") {
$val{i} = 1 unless defined $val{i};
- #todo
+ $val{ex} = 0;
} # exponent
elsif ($_ eq "chs" and defined $val{i}) {
$val{i} = -$val{i};
} # backspace
elsif (exists $action{$_}) {
- my ($type, $cmd) = @{$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");
- $redraw++;
next;
} # insufficient arguments
- $_->($type) for @{$hook{preaction}};
-
+ $_->($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}};
- showstack() if $type>=-1;
+ redraw(1) if $type>=-1; # redraw stack
} # some operation
else {
"unrecognised command: " # show string or character codes
. (m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_)
);
- $redraw++; # screen messed up
} # error
} # input loop
-=cut
-VERSION HISTORY
-1.01 040618 - start (curses, some basic commands)
-1.02 040620 - function keys select command/submenu from (sub)menu
- - backspace to undo last digit
-1.03 040625 - values displayable in arbitrary base
- - can enter fractions (.) and negative values (_)
-1.04 0408041445 - error dialog (don't mess up screen)
- - manual command input using capital letters
- - ^L redraws screen
- 0409092200 - overhaul in stack handling
-1.05 0409101945 - 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 0409152310 - menu contents in module
- - new commands: a?(sin|cos|tan)h, inv, !, rand
- - x and v shortkeys
-1.07 0409242350 - 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 0409262210 - 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
-1.09 0409270057 - all key aliases moved to module DCT::Bindings
- 0409291215 - number of menu items depends on screen width
- 0410112130 - hooks allowing for extra code at reload, showentry, and precmd
- 2150 - all menu related functions moved to menu.pm
- 2205 - unit conversion out of main program (entirely into unitconv.pm)
- 0410120150 - backspace becomes "back" (soft drop, like old "drop")
- - normal drop command (alt+bs) removes input/stack value at once
- 0213 - $val{frac} default undefined instead of 0
-1.10 0410120245 - fixed backspace with undef fraction
- 0410130020 - altered stack not redrawn after undo
- 0410132200 - digits added/removed to/from integer part in correct number base
- 0410142145 - allow modules to not load but without error
- - display welcome at startup, also showing version and modules
- 0410150000 - preaction hook; undo functionality moved to module
- - only first module run of multiple with the same name
- 0015 - invalid commands shown as strings instead of character codes
-=cut
git.shiar.nl / descalc.git / blobdiff