X-Git-Url: http://git.shiar.net/descalc.git/blobdiff_plain/7d9af85556b0e64c70e3641764b7b49a306723f3..7db84757c6ba80836bc8c2cc9de326f16862a2cd:/dct.pl diff --git a/dct.pl b/dct.pl index b11ca57..d2e411c 100755 --- a/dct.pl +++ b/dct.pl @@ -12,16 +12,16 @@ use utf8; 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 @@ -44,49 +44,51 @@ 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 +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 +103,63 @@ sub showval($$) { 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") { @@ -179,6 +179,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 +188,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 +200,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 +221,6 @@ 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