X-Git-Url: http://git.shiar.net/descalc.git/blobdiff_plain/7d9af85556b0e64c70e3641764b7b49a306723f3..4e1d9535fda6685e53ce570ca4e4cd6c260f55d3:/dct.pl diff --git a/dct.pl b/dct.pl index b11ca57..d871555 100755 --- a/dct.pl +++ b/dct.pl @@ -10,18 +10,14 @@ use warnings; use utf8; use Data::Dumper; -use Term::ReadKey; -our $VERSION = "1.10.6"; +our $VERSION = "1.12.1"; -use vars qw(@stack %val %var %set %alias %action %hook); +use vars qw(@stack %val %set %alias %action %hook); %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 height => 4, # stack depth (lines of stack plus one) width => 42, # limit value precision, stetch menu @@ -44,49 +40,53 @@ use vars qw(@stack %val %var %set %alias %action %hook); "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 +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($) { $_->($_[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; @@ -101,65 +101,44 @@ sub showval($$) { return $txt; } # showval -sub showstack() { - $_->() for @{$hook{showstack}}; -} # showstack - - -my %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 - : print STDERR $@, "error loading $module\n\n"; -} # load modules -printf STDERR "DCT %s by Shiar (%s)\n", $VERSION, - join "; ", map {"$_ $modules{$_}{version}"} keys %modules; - -ReadMode 3; # cbreak mode -END { ReadMode 0; } # restore terminal on quit - -$_->() for @{$hook{init}}; -my $redraw = 1; - -LOOP: while (1) { +sub draw { if ($redraw) { - $_->() for @{$hook{refresh}}; - showstack(); + if ($redraw>1) { + $_->() for @{$hook{refresh}}; + } + $_->() for @{$hook{showstack}}; $redraw = 0; - } # refresh + } # do necessary redrawing { - 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 +} # draw - my $key = ReadKey; - if ($key eq chr 27) { - $key .= $_ while defined ($_ = ReadKey(-1)); # read additional keys - } # escape sequence - $_ = $alias{$key} || $key; #if exists $alias{$key}; # command shortkeys - $_ = delete $val{alpha} if $_ eq "enter" and exists $val{alpha}; # use manual command +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}}) { - next LOOP if $cmd->(); + $cmd->() and return; # command was handled by function if returns true } # precmd functions - last if $_ eq 'quit'; + exit if $_ eq "quit"; # break out of loop - if ($_ eq 'refresh') { - $redraw++; + if ($_ eq "refresh") { + 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") { @@ -179,6 +158,7 @@ LOOP: while (1) { $_ = -$_ 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 '.') { @@ -187,7 +167,7 @@ LOOP: while (1) { } # 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}; @@ -199,21 +179,20 @@ LOOP: while (1) { } # 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 { @@ -221,52 +200,33 @@ LOOP: while (1) { "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 +} # 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}->(); +