X-Git-Url: http://git.shiar.net/descalc.git/blobdiff_plain/ce0d29d8a852b8bf7dcad717390a4ad8efb59263..7d9af85556b0e64c70e3641764b7b49a306723f3:/dct.pl

diff --git a/dct.pl b/dct.pl
index f3cdcc9..b11ca57 100755
--- a/dct.pl
+++ b/dct.pl
@@ -2,210 +2,64 @@
 
 # DCT - desktop calculator thingy
 
-# reverse polish notition calculator using curses
+# simple modular reverse polish notition calculator
 # by Shiar <shiar.org>
 
-# 1.01 06-18       - start (curses, some basic commands)
-# 1.02 06-20       - function keys select command/submenu from (sub)menu
-#                  - backspace to undo last digit
-# 1.03 06-25       - values displayable in arbitrary base
-#                  - can enter fractions (.) and negative values (_)
-# 1.04 08-04 14:45 - error dialog (don't mess up screen)
-#                  - manual command input using capital letters
-#                  - ^L redraws screen
-#  pre 09-09 22:00 - overhaul in stack handling
-# 1.05 09-10 19:45 - 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 09-15 23:10 - menu contents in module
-#                  - new commands: a?(sin|cos|tan)h, inv, !, rand
-#                  - x and v shortkeys
-# 1.07 09-24 23:50 - 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 09-26 22:10 - 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
-#      09-27 00:57 - all key aliases moved to module DCT::Bindings
-our $VERSION = 1.008;
-
 use strict;
 use warnings;
 use utf8;
 
+use Data::Dumper;
 use Term::ReadKey;
-use Curses;
-use DCT::Menu 1.006;
-use DCT::Bindings 1.008;
 
-initscr;
-ReadMode 3;  # cbreak mode
-END {
-	ReadMode 0;
-	endwin;
-} # restore terminal on quit
+our $VERSION = "1.10.6";
 
-my %val = qw(i 0  frac 0);  # i, frac
-my @stack;
-my %var;
+use vars qw(@stack %val %var %set %alias %action %hook);
 
-my %set = (
+%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
 
-	height   => $LINES<3 ? 4 : $LINES-3,  # stack depth (lines of stack plus one)
-	width    => $COLS || 42,  # limit value precision, stetch menu
-	menushow => 12,  # menu items to show simultaneously
+	height   =>  4,  # stack depth (lines of stack plus one)
+	width    => 42,  # limit value precision, stetch menu
 ); # %set
 
-#%alias = (' '=>'enter', "\004"=>'quit', 'q'=>'quit') unless %alias;  # rudimentary defaults
+%alias = (' '=>"enter", "\004"=>"quit");  # rudimentary default key bindings
 
-my @menu = @{$menus[0]};
-my $menumin = 0;
+%action = (
+	"enter" => [ 0, sub {
+		local $_ = defined $val{i} ? $val{i} : $stack[0];
+		undef %val;
+		return defined $_ ? $_ : ();
+	}], # duplication
 
-my %action = (
-	'more' => [-1, sub {
-		$menumin += $set{menushow};
-		$menumin = 0 if $menumin>=$#menu;
-		showmenu();
-	}], # tab
-	'chs'  => [0, sub {$stack[0] = -$stack[0]}], # negative
+	"chs"   => [ 1, sub { -$_[0] }], # negative
 
-	'drop' => [0, sub {shift @stack}], # backspace
-	'clear'=> [0, sub {@stack = (); %val = (i=>undef, frac=>0) }], # clear all #todo: if (val{i}) delete char after cursor
+	"drop"  => [ 1, sub { defined $val{i} ? '' : () }], # drop
+	"back"  => [ 1, sub { () }], # drop essentially
+	"clear" => [ 0, sub { @stack = (); undef %val; () }], # clear all
 
-	'enter'=> [0, sub {
-		unshift @stack, defined $val{i} ? $val{i} : $stack[0];
-		%val = (i=>undef, frac=>0);
-	}], # duplication
-
-#	'undo' => [0, sub {@stack = @{ $var{undo} }}], # undo
-	'undo' => [0, sub {($var{undo}, @stack) = ([@stack], @{ $var{undo} }) }], # undo
-	'swap' => [1, sub {@stack[0, 1] = @stack[1, 0]}], # swap x<->y
-	'stack'=> [0, sub {
+	"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}++];
 	}], # stack
 
-	'version' => [0, sub{error("Desktop Calculator Thingy $VERSION by Shiar")}], # version
-
-	'='    => [1, sub {$var{a} = $stack[0]}], # copy
-	'?'    => [1, sub {$var{a} = shift @stack}], # assign
-
-	'+'    => [2, sub {$stack[1] += shift @stack}], # addition
-	'-'    => [2, sub {$stack[1] -= shift @stack}], # substraction
-	'*'    => [2, sub {$stack[1] *= shift @stack}], # multiplication
-	'/'    => [2, sub {$stack[1] /= shift @stack}], # division
-	'mod'  => [2, sub {$stack[1] %= shift @stack}], # modulo
-
-	'inv'  => [1, sub {$stack[0] = 1 / $stack[0]}], # 1/x
-	'sqrt' => [1, sub {$stack[0] = sqrt $stack[0]}], # square root
-	'sq'   => [1, sub {$stack[0] *= $stack[0]}], # squared
-	'^'    => [2, sub {$stack[1] **= shift @stack}], # exponentiation
-	'xroot'=> [2, sub {$stack[1] **= 1 / shift @stack}], # x-root of y
-
-	'log'  => [1, sub {$stack[0] = log($stack[0]) / log(10)}], # logarithm
-	'alog' => [1, sub {$stack[0] = 10 ** $stack[0]}], # 10^x
-	'ln'   => [1, sub {$stack[0] = log $stack[0]}], # natural logaritm
-	'lnp1' => [1, sub {$stack[0] = log($stack[0]+1)}], # ln(x+1)
-	'exp'  => [1, sub {$stack[0] = exp($stack[0])}], # e^x
-	'expm' => [1, sub {$stack[0] = exp($stack[0])-1}], # exp(x)-1
-
-	'sin'  => [1, sub {$stack[0] = sin $stack[0]}], # sine
-	'asin' => [1, sub {$stack[0] = atan2($stack[0], sqrt(1 - $stack[0]*$stack[0]))}], # inverse sine
-	'cos'  => [1, sub {$stack[0] = cos $stack[0]}], # cosine
-	'acos' => [1, sub {$stack[0] = atan2(sqrt(1 - $stack[0]*$stack[0]), $stack[0])}], # inverse cosine
-	'tan'  => [1, sub {$stack[0] = sin($stack[0]) / cos($stack[0])}], # tangent
-#	'atan' => [1, sub {}], # arctangent
-
-	'sinh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/2}], # hyperbolic sine
-	'cosh' => [1, sub {$stack[0] = ( exp($stack[0]) + exp(-$stack[0]) )/2}], # hyperbolic cosine
-	'tanh' => [1, sub {$stack[0] = ( exp($stack[0]) - exp(-$stack[0]) )/( exp($stack[0]) + exp(-$stack[0]) )}], # hyperbolic tangent (sinh/cosh)
-	'asinh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2+1)+$stack[0] )}], # inverse hyperbolic sine
-	'acosh'=> [1, sub {$stack[0] = log( sqrt($stack[0]**2-1)+$stack[0] )}], # inverse hyperbolic cosine
-	'atanh'=> [1, sub {$stack[0] = log( (1+$stack[0]) / (1-$stack[0]) )/2}], # inverse hyperbolic tangent
-
-	'%'    => [2, sub {$stack[0] = shift(@stack)/$stack[0]}], # percentage
-	'%ch'  => [2, sub {$val{i} = 100*(shift(@stack)-$val{i})/$val{i}}], # percentage change
-	'%t'   => [2, sub {$val{i} = 100*$val{i}/shift(@stack)}], # percentage total
-
-	'and'  => [2, sub {$stack[1] &= shift @stack}], # bitwise and
-	'or'   => [2, sub {$stack[1] |= shift @stack}], # bitwise or
-	'xor'  => [2, sub {$stack[1] ^= shift @stack}], # bitwise xor
-	'not'  => [2, sub {$stack[0] = ~$stack[0]}], # bitwise not
-	'sl'   => [1, sub {$stack[0] *= 2}], # shift left
-	'sr'   => [1, sub {$stack[0] /= 2}], # shift right
-
-	'abs'  => [1, sub {$stack[0] = abs $stack[0]}], # absolute #todo
-	'sign' => [1, sub {$stack[0] = $stack[0] <=> 0}], # sign
-	'ip'   => [1, sub {$stack[0] = int $stack[0]}], # integer part
-	'fp'   => [1, sub {$stack[0] -= int $stack[0]}], # fractional part
-
-	'rnd'  => [1, sub {local $_ = 10**shift @stack; $val{i} = int(($val{i}+.5)*$_)/$_}], # round
-	'trnc' => [1, sub {local $_ = 10**shift @stack; $val{i} = int($val{i}*$_)/$_}], # truncate
-	'floor'=> [1, sub {$stack[0] = int $stack[0]}], # floor
-	'ceil' => [1, sub {$stack[0] = int $stack[0]+.9999}], # ceil
-
-	'min'  => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_<$stack[0] }], # minimum
-	'max'  => [2, sub {local $_ = shift @stack; $stack[0] = $_ if $_>$stack[0] }], # maximum
-
-	'dec'  => [0, sub {$set{base} = 10}], # decimal
-	'bin'  => [0, sub {$set{base} = 2}], # binary
-	'oct'  => [0, sub {$set{base} = 8}], # octal
-	'hex'  => [0, sub {$set{base} = 16}], # hexadecimal
-	'base' => [1, sub {$set{base} = shift @stack}], # alphanumerical
-
-	'!'    => [1, sub {local $_ = $stack[0]; $stack[0] *= $_ while --$_>1}], # factor
-	'rand' => [0, sub {unshift @stack, rand}], # random value <1
-); # %action
+	"sto"   => [ 1, sub { $var{a} = $_[0] }], # copy
+	'?'     => [ 1, sub { $var{a} = $_[0] }], # assign
 
-my %unit;
-{
-my $i = 0;
-$unit{$_->[0]} = { name=>$_->[0], type=>$i, val=>$_->[1] } for map {$i++; @$_} (
-	[
-		['m', 1],
-		['cm', .01],
-		['mm', .001],
-		['km', 1000],
-		['ft', .3048],
-		['in', .0254],
-		['yd', .9144],
-		['mile', 1609.344],
-		['nmile', 1852],
-		['lyr', 9.46052840488e+15],
-		['mil', 2.54e-5],
-	#		_m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
-	#		_nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
-	], # lengths
-	[
-		['m^3', 1],
-		['cm^3', 1e-6],
-		['ft^3', .028316846592],
-		['in^3', 1.6387064e-5],
-	], # volume
-);
-} # create unit table
+	"version" => [-2, sub {
+		error("Desktop Calculator Thingy $VERSION by Shiar"); ()
+	}], # version
+); # %action
 
 
 sub error($) {
-	attron(A_REVERSE);
-	addstr(0, 0, shift);
-	attroff(A_REVERSE);
-	clrtoeol;
-	refresh;
-
-	ReadKey; # wait for confirm
-	1 while defined (ReadKey -1); # clear key buffer
+	$_->($_[0]) for @{$hook{showerror}};
 } # error
 
 sub showval($$);
@@ -226,6 +80,7 @@ sub showval($$) {
 		$int /= $base;
 		$exp++;
 	} # exponent part
+
 	while ($int>=1) {
 		my $char = $int%$base;
 		$txt = ($char<10 ? $char : chr($char+55)).$txt;
@@ -247,136 +102,171 @@ sub showval($$) {
 } # showval
 
 sub showstack() {
-	for (0..@stack-1) {
-		addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base}));
-		clrtoeol;
-	} # show stack
-	clrtoeol($set{height}-$#stack-1, 1);
+	$_->() for @{$hook{showstack}};
 } # showstack
 
-sub showmenu() {
-	clrtoeol($set{height}+2, 1);
-	my $nr = 0;
-	for (grep exists $menu[$_], $menumin+1..$menumin+$set{menushow}) {
-		my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
-		addstr($set{height}+2, $set{width}/$set{menushow}*($nr++), $_);
-		attron(A_REVERSE);
-		addstr($s);
-		attroff(A_REVERSE);
-		addch('>') if $sub;
-	} # display menu txts
-} # showmenu
-
-
-DRAW:
-clear;
-showmenu();
-showstack();
-addstr($set{height}+1, 0, "> ");  # prompt
-
-while (1) {
-	addstr($set{height}+1, 2, showval($val{i}, $set{base}));
-	addstr('_'.$val{unit}{name}) if exists $val{unit};
-	addstr($val{bla}) if exists $val{bla};
-	clrtoeol;
-	refresh;
-
-	$_ = ReadKey;
-	if ($_ eq chr 27) {
-		while (defined (my $key = ReadKey -1)) {
-			$_ .= $key;
-		} # read additional keys
+
+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) {
+	if ($redraw) {
+		$_->() for @{$hook{refresh}};
+		showstack();
+		$redraw = 0;
+	} # refresh
+
+	{
+		my $entry = showval($val{i}, $set{base});
+		$entry .= $_ for map $_->(), @{$hook{postentry}};
+		$entry .= $val{alpha} if exists $val{alpha};
+		$_->($entry) for @{$hook{showentry}};
+	} # show entry
+
+	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
+
+	for my $cmd (@{$hook{precmd}}) {
+		next LOOP if $cmd->();
+	} # precmd functions
 
-	exists $alias{$_}  and $_ = $alias{$_};  # command shortkeys
-	if (exists $falias{$_}) {
-		unless ($_ = $menu[$falias{$_}]) {
-			error("* no such menu entry *");
-			goto DRAW;
-		}
-	} # function key
-
-	$_ = delete $val{bla} if exists $val{bla} and $_ eq 'enter';
-
-	if ($_ eq 'quit') {
-		last;
-	} # quit
-	elsif ($_ eq 'refresh') {
-		goto DRAW;
+	last if $_ eq 'quit';
+
+	if ($_ eq 'refresh') {
+		$redraw++;
 	} # refresh
 
-	elsif (exists $val{bla} or /^[A-Z]$/) {
+	elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
 		if (defined $val{i}) {
 			unshift @stack, $val{i};
-			%val = (i=>undef, frac=>0);
+			undef %val;
 			showstack();
 		} # enter present value
-		if ($_ eq "drop") {
-			$val{bla} = substr $val{bla}, 0, -1 or delete $val{bla};
+
+		if ($_ eq "back") {
+			$val{alpha} = substr $val{alpha}, 0, -1 or delete $val{alpha};
 		} # backspace
+		elsif ($_ eq "drop") {
+			delete $val{alpha};
+		} # drop
 		else {
-			$val{bla} .= lc $_;
+			$val{alpha} .= $key =~ /^\033(.)/ ? uc $1 : lc $key;
 		} # add character
-	} # manual command
+	} # manual command entry
 
-	elsif (/^\d$/) {
+	elsif (/^[\da-f]$/) {
+		m/^[a-z]$/ and $_ = ord($_)-87;  # digit>9
 		$val{i} = 0 unless defined $val{i};
-		$_ = -$_ if $val{i}<0;
-		$val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_;
-	}
+		$_ = -$_ if $val{i}<0;  # substract from negative value
+		$val{i} = ($val{frac} and $val{frac} *= 10)
+			? $val{i}+$_/$val{frac}  # add digit to fraction
+			: $val{i}*$set{base}+$_;  # add digit to integer part
+	} # digit
 	elsif ($_ eq '.') {
 		$val{i} = 0 unless defined $val{i};
 		$val{frac} = 1;
 	} # decimal point
-	elsif ($_ eq 'eex') {
+	elsif ($_ eq "eex") {
 		$val{i} = 1 unless defined $val{i};
 		#todo
 	} # exponent
-	elsif ($_ eq 'chs' and defined $val{i}) {
+	elsif ($_ eq "chs" and defined $val{i}) {
 		$val{i} = -$val{i};
 	} # change sign
-	elsif ($_ eq 'drop' and defined $val{i}) {
-		$val{i} = ($val{frac} = int $val{frac}/10)
-			? int($val{i}*$val{frac})/$val{frac} : int $val{i}/10
+	elsif ($_ eq "back" and defined $val{i}) {
+		$val{i} = ($val{frac} and $val{frac} = int $val{frac}/10)
+			? int($val{i}*$val{frac})/$val{frac}  # backspace fraction digit
+			: int $val{i}/$set{base}  # backspace digit in integer part
 	} # backspace
 
-	elsif (exists $action{$_} or /^\d$/) {
-		my ($type, $cmd) = @{ $action{$_} };
-		if ($type>0 and defined $val{i}) {
-			unshift @stack, $val{i};
-			%val = (i=>undef, frac=>0);
-		} # auto enter
+	elsif (exists $action{$_}) {
+		my ($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 *");
-			goto DRAW;
+			error("insufficient stack arguments for operation");
+			$redraw++;
+			next;
 		} # insufficient arguments
-		$var{undo} = [@stack] if $type>=0 and $_ ne 'undo';
-		$cmd->();
-		showstack() if $type>=0;
-	} # some operation
 
-	elsif (/>(\d+)$/) {
-		@menu = @{ $menus[$1] };
-		$menumin = 0;
-		showmenu();
-	} # submenu
-
-	elsif ($_ =~ /^_/) {{
-		$_ = $unit{substr $_, 1} or next;
-		if (exists $val{unit} and $val{unit}{type}==$_->{type}) {
-			unshift @stack, $val{i} if defined $val{i};
-			$stack[0] *= delete($val{unit})->{val} / $_->{val};
-			showstack();
-			%val = (i=>undef, frac=>0);
-		} # convert
-		else {
-			$val{unit} = $_;
-		} # set source unit
-	}} # conversion
+		$_->($type) 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);
+
+		showstack() if $type>=-1;
+	} # some operation
 
 	else {
-		error("* unrecognised command: ".join(' ', map ord, split //, $_)." *");
-		goto DRAW; # screen messed up
+		error(
+			"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